Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];

Вниз

Быки и коровы   Найти похожие ветки 

 
pavel_k   (2003-11-04 21:49) [0]

Это вроде игра такая. Может есть у кого линк на ее реализацию (на исходник)? Или кто-то хоть алгоритм знает?
Условия вроде такие: человек загадывает число (4 знака), а комп пытается отгадать. Но не просто так: он предлагает свой вариант числа, а пользователь отвечает: сколько быков (чисел, стоящих на своих местах) и коров (чисел присутствующих в загаданном числе, но не стоящих на своих местах).
Жду кто что скажет.


 
pavel_k   (2003-11-04 21:49) [0]

Это вроде игра такая. Может есть у кого линк на ее реализацию (на исходник)? Или кто-то хоть алгоритм знает?
Условия вроде такие: человек загадывает число (4 знака), а комп пытается отгадать. Но не просто так: он предлагает свой вариант числа, а пользователь отвечает: сколько быков (чисел, стоящих на своих местах) и коров (чисел присутствующих в загаданном числе, но не стоящих на своих местах).
Жду кто что скажет.


 
reticon ©   (2003-11-04 23:53) [1]

у меня вроде где-то было, если найду - вышлю.


 
reticon ©   (2003-11-04 23:53) [1]

у меня вроде где-то было, если найду - вышлю.


 
pavel_k   (2003-11-05 19:05) [2]

Пришли плиз...
Может еще у кого есть?


 
pavel_k   (2003-11-05 19:05) [2]

Пришли плиз...
Может еще у кого есть?


 
Gandalf ©   (2003-11-06 08:56) [3]

У меня нет, но сть книга Чезерелла "Этюды программирования" - там есть эта игра с описанием оптимальной стратегии. Она проста - строиться все множество комбинаций. И после каждой попытки удаляются невозможные (довольно много их). Каждый ход делается таким чтобы свести кол-во елементов к минимому. Можно еще статистику набирать по предпочтениям человека. Вообще с точки зрения компа игра совсем не итересесная - алгоритм жесткий. Игра из серии "стратегия без игры" (Есть еще книга Ж. Арсак - старье, но там она тоже разобрана)


 
Gandalf ©   (2003-11-06 08:56) [3]

У меня нет, но сть книга Чезерелла "Этюды программирования" - там есть эта игра с описанием оптимальной стратегии. Она проста - строиться все множество комбинаций. И после каждой попытки удаляются невозможные (довольно много их). Каждый ход делается таким чтобы свести кол-во елементов к минимому. Можно еще статистику набирать по предпочтениям человека. Вообще с точки зрения компа игра совсем не итересесная - алгоритм жесткий. Игра из серии "стратегия без игры" (Есть еще книга Ж. Арсак - старье, но там она тоже разобрана)


 
pavel_k   (2003-11-06 21:36) [4]

Мне бы хоть кусочек кода...
Как хранить варианты (массив, множество, ...?), как учитывать то, что ввел пользователь (без знания того, какие цифры истинные, а какие нет трудно угадывать варианты, как запоминать то, что ввел юзер и это было удобно потом использовать?). Короче, у меня ничего хорошего не вышло, может есть еще какие мысли/советы?


 
pavel_k   (2003-11-06 21:36) [4]

Мне бы хоть кусочек кода...
Как хранить варианты (массив, множество, ...?), как учитывать то, что ввел пользователь (без знания того, какие цифры истинные, а какие нет трудно угадывать варианты, как запоминать то, что ввел юзер и это было удобно потом использовать?). Короче, у меня ничего хорошего не вышло, может есть еще какие мысли/советы?


 
TButton ©   (2003-11-07 18:33) [5]

сделай наоборот. пусть число загадывает компьютер, а отгадывает человек. а вообще решение это массив из четырех записей {byte+boolean}


 
TButton ©   (2003-11-07 18:33) [5]

сделай наоборот. пусть число загадывает компьютер, а отгадывает человек. а вообще решение это массив из четырех записей {byte+boolean}


 
pavel_k   (2003-11-07 21:12) [6]

Я чувствую, что истина где-то рядом, но как и Малдер никак не могу ее постичь :).
Видно TButton предполагал, что я сам догадаюсь, что такое массив из четырех записей {byte + boolean}.

Я не догадался :) .

Это типа так:
TMyArray=array[0..3] of
record
byte_:byte;
bol:boolean;
end;

или так

TMyArray=array [0..9999] of
byte1:byte;
byte2:byte;
byte3:byte;
byte4:byte;
bol:boolean;
end;

Или как-нибудь еще...
Так же не ясно что в этот массив вносить.
Button (можно вас называть фамильярно, не как класс, а как его представителя, без T? :) ), не мог бы ты конкретизировать.
Извините, если пишу глупости...


 
pavel_k   (2003-11-07 21:12) [6]

Я чувствую, что истина где-то рядом, но как и Малдер никак не могу ее постичь :).
Видно TButton предполагал, что я сам догадаюсь, что такое массив из четырех записей {byte + boolean}.

Я не догадался :) .

Это типа так:
TMyArray=array[0..3] of
record
byte_:byte;
bol:boolean;
end;

или так

TMyArray=array [0..9999] of
byte1:byte;
byte2:byte;
byte3:byte;
byte4:byte;
bol:boolean;
end;

Или как-нибудь еще...
Так же не ясно что в этот массив вносить.
Button (можно вас называть фамильярно, не как класс, а как его представителя, без T? :) ), не мог бы ты конкретизировать.
Извините, если пишу глупости...


 
TButton ©   (2003-11-07 22:40) [7]

объясняю:

рекорд

type TMyRec=record
 guess:boolean; // true - угадали
 num:byte;      // число (если угадали - не меняем)
end;


массив

digs:array[1..4] of TMyRec;


вуаля

кусок кода

for i:=1 to 4 do
 if digs[i].guess
   then Continue
   else digs[i].dig:=Random(10);


 
TButton ©   (2003-11-07 22:40) [7]

объясняю:

рекорд

type TMyRec=record
 guess:boolean; // true - угадали
 num:byte;      // число (если угадали - не меняем)
end;


массив

digs:array[1..4] of TMyRec;


вуаля

кусок кода

for i:=1 to 4 do
 if digs[i].guess
   then Continue
   else digs[i].dig:=Random(10);


 
TButton ©   (2003-11-07 22:41) [8]

З.,Ы если как представителя, то лучше Button1... но я все-таки привык как класс...


 
TButton ©   (2003-11-07 22:41) [8]

З.,Ы если как представителя, то лучше Button1... но я все-таки привык как класс...


 
TButton ©   (2003-11-07 23:02) [9]

З.Ы, я тут подумал... можно без T, но тогда - руглишем (i.e. Батон)


 
TButton ©   (2003-11-07 23:02) [9]

З.Ы, я тут подумал... можно без T, но тогда - руглишем (i.e. Батон)


 
pavel_k   (2003-11-08 13:20) [10]

Удалено модератором


 
pavel_k   (2003-11-08 13:20) [10]

Удалено модератором


 
pavel_k   (2003-11-09 17:21) [11]

UP


 
pavel_k   (2003-11-09 17:21) [11]

UP


 
pavel_k   (2003-11-10 20:17) [12]

> Удалено модератором
За что?
>TButton
Боюсь так не запахает, мы не знаем, когда ставить quess:=true, так как пользователь не говорит нам номера правильных цифр!


 
pavel_k   (2003-11-10 20:17) [12]

> Удалено модератором
За что?
>TButton
Боюсь так не запахает, мы не знаем, когда ставить quess:=true, так как пользователь не говорит нам номера правильных цифр!


 
Gandalf ©   (2003-11-12 08:42) [13]

Пространство игры это массив вида (если 4 цифры)

Game:array [0..9,0..9,0..9,0..9] of Boolean;

Изначально все True (т.е. все варианты возможны)

Хотя можно его и развернуть в вектор.

Если есть комбинация abcd - и известно колво быков (x) и коров (y), и x<>4 то ясно что сама комбинация не подходит (жначит она становится False). Далее пересматривает пространнство вариантов. И произовим над каждой яцейкой операцию вида Game[i,j,k,n] and CanBe(); CanBe дает True если модификация abcd при известных x и y может дать ijkn и False иначе (например если у тебя 1111 - и нуля быков и коров, то комбинация хотя бы с одной единичкой даст False). Потом выбираешь новых ход из пространства Game с True, ну т.д. пока не останется одно значение.


 
Gandalf ©   (2003-11-12 08:42) [13]

Пространство игры это массив вида (если 4 цифры)

Game:array [0..9,0..9,0..9,0..9] of Boolean;

Изначально все True (т.е. все варианты возможны)

Хотя можно его и развернуть в вектор.

Если есть комбинация abcd - и известно колво быков (x) и коров (y), и x<>4 то ясно что сама комбинация не подходит (жначит она становится False). Далее пересматривает пространнство вариантов. И произовим над каждой яцейкой операцию вида Game[i,j,k,n] and CanBe(); CanBe дает True если модификация abcd при известных x и y может дать ijkn и False иначе (например если у тебя 1111 - и нуля быков и коров, то комбинация хотя бы с одной единичкой даст False). Потом выбираешь новых ход из пространства Game с True, ну т.д. пока не останется одно значение.


 
MegaVolt ©   (2003-11-12 10:15) [14]

Реализация отправлена :)


 
MegaVolt ©   (2003-11-12 10:15) [14]

Реализация отправлена :)


 
pavel_k   (2003-11-12 15:03) [15]

>Gandalf
Спасибо, я попробую!
>MegaVolt ©
Очень интересно, жаль что без исходника + в том что ты послал решается обратная задача (число загадывает комп, а мне надо, чтобы он отгадывал).
Всем спасибо за участие!!!  


 
pavel_k   (2003-11-12 15:03) [15]

>Gandalf
Спасибо, я попробую!
>MegaVolt ©
Очень интересно, жаль что без исходника + в том что ты послал решается обратная задача (число загадывает комп, а мне надо, чтобы он отгадывал).
Всем спасибо за участие!!!  


 
now_aleks   (2003-11-13 01:09) [16]

У меня было написанно примерно так, был создан массив возможных варянтов :

type
FourDigit = record
 a : 0..9;
 b : 0..9;
 c : 0..9;
 d : 0..9;
end;

const
FileName = "Data.txt";

procedure TFormMain.ButtonCreateDataFileClick(Sender: TObject);
var
Cykl : integer;
A,B,C,D : 0..9;
OutFile : TextFile;
TempArray : array [0..9999] of FourDigit;
OutRecCount : integer;
begin
 OutRecCount:=0;
 for Cykl:=0 to 9999 do
 begin
   A:=  Cykl DIV 1000;
   B:= (Cykl-(A * 1000)) DIV 100;
   C:= (Cykl-(A * 1000)-(B * 100)) DIV 10;
   D:= (Cykl-(A * 1000)-(B * 100)-(C *10));

   if NOT ((A=B) OR (A=C) OR (A=D) OR (B=C) OR (B=D) OR (C=D) ) then
   begin
     TempArray[OutRecCount].a:=A;
     TempArray[OutRecCount].b:=B;
     TempArray[OutRecCount].c:=C;
     TempArray[OutRecCount].d:=D;
     INC(OutRecCount);
   end;
 end;
 AssignFile(OutFile,FileName);
 Rewrite(OutFile);
 for Cykl:=0 to OutRecCount-1 do
 begin
   write(OutFile,TempArray[Cykl].a,TempArray[Cykl].b,TempArray[Cykl].c,TempArray[Cykl].d);
 end;
 CloseFile(OutFile);
end;


при запуске проги загружасся массив :

const
FileName = "Data.txt";
ArrayLength = 5039;

var
DataArray : array [0..ArrayLength] of FourDigit;

procedure TFormMain.FormCreate(Sender: TObject);
var
InFile : File of byte;
Cykl   : integer;
A,B,C,D : byte;
begin
 AssignFile(InFile,FileName);
 Reset(InFile);
 for Cykl:=0 to ArrayLength do
 begin
   read(InFile,A,B,C,D);
   DataArray[Cykl].A:=StrToInt(Chr(A));
   DataArray[Cykl].B:=StrToInt(Chr(B));
   DataArray[Cykl].C:=StrToInt(Chr(C));
   DataArray[Cykl].D:=StrToInt(Chr(D));
   Application.ProcessMessages;
 end;
 CloseFile(InFile);
end;


а дальше например так, из массива выбиралась запись и после ответа пользывателя (н.п. 3:2 )в новый массив переписывались только те записи, которые соответствуют ответу.
(А дальше подсчет каких цифр в массиве больше. и.т.д.)Этого должно хватить.


 
now_aleks   (2003-11-13 01:09) [16]

У меня было написанно примерно так, был создан массив возможных варянтов :

type
FourDigit = record
 a : 0..9;
 b : 0..9;
 c : 0..9;
 d : 0..9;
end;

const
FileName = "Data.txt";

procedure TFormMain.ButtonCreateDataFileClick(Sender: TObject);
var
Cykl : integer;
A,B,C,D : 0..9;
OutFile : TextFile;
TempArray : array [0..9999] of FourDigit;
OutRecCount : integer;
begin
 OutRecCount:=0;
 for Cykl:=0 to 9999 do
 begin
   A:=  Cykl DIV 1000;
   B:= (Cykl-(A * 1000)) DIV 100;
   C:= (Cykl-(A * 1000)-(B * 100)) DIV 10;
   D:= (Cykl-(A * 1000)-(B * 100)-(C *10));

   if NOT ((A=B) OR (A=C) OR (A=D) OR (B=C) OR (B=D) OR (C=D) ) then
   begin
     TempArray[OutRecCount].a:=A;
     TempArray[OutRecCount].b:=B;
     TempArray[OutRecCount].c:=C;
     TempArray[OutRecCount].d:=D;
     INC(OutRecCount);
   end;
 end;
 AssignFile(OutFile,FileName);
 Rewrite(OutFile);
 for Cykl:=0 to OutRecCount-1 do
 begin
   write(OutFile,TempArray[Cykl].a,TempArray[Cykl].b,TempArray[Cykl].c,TempArray[Cykl].d);
 end;
 CloseFile(OutFile);
end;


при запуске проги загружасся массив :

const
FileName = "Data.txt";
ArrayLength = 5039;

var
DataArray : array [0..ArrayLength] of FourDigit;

procedure TFormMain.FormCreate(Sender: TObject);
var
InFile : File of byte;
Cykl   : integer;
A,B,C,D : byte;
begin
 AssignFile(InFile,FileName);
 Reset(InFile);
 for Cykl:=0 to ArrayLength do
 begin
   read(InFile,A,B,C,D);
   DataArray[Cykl].A:=StrToInt(Chr(A));
   DataArray[Cykl].B:=StrToInt(Chr(B));
   DataArray[Cykl].C:=StrToInt(Chr(C));
   DataArray[Cykl].D:=StrToInt(Chr(D));
   Application.ProcessMessages;
 end;
 CloseFile(InFile);
end;


а дальше например так, из массива выбиралась запись и после ответа пользывателя (н.п. 3:2 )в новый массив переписывались только те записи, которые соответствуют ответу.
(А дальше подсчет каких цифр в массиве больше. и.т.д.)Этого должно хватить.


 
Arximed ©   (2003-11-13 08:36) [17]

Я новичек в делфе , но переводил эту программу с VB  и ту писал сам только у меня не человек загадывает число ,а прога если интересует вышлю.


 
Arximed ©   (2003-11-13 08:36) [17]

Я новичек в делфе , но переводил эту программу с VB  и ту писал сам только у меня не человек загадывает число ,а прога если интересует вышлю.


 
pavel_k   (2003-11-14 19:32) [18]

>Arximed
Когда загадывает комп - реализовывается намного проще. А не одного примера, когда комп отгадывает я не нашел. Пытаюсь писать сам :) .


 
pavel_k   (2003-11-14 19:32) [18]

>Arximed
Когда загадывает комп - реализовывается намного проще. А не одного примера, когда комп отгадывает я не нашел. Пытаюсь писать сам :) .


 
Cardinal ©   (2003-11-16 18:44) [19]

У меня тоже комп загадывает, только с наворотами.


 
Cardinal ©   (2003-11-16 18:44) [19]

У меня тоже комп загадывает, только с наворотами.


 
Cardinal ©   (2003-11-16 18:47) [20]

Вот: http://amis.fatal.ru/pic/rar/bk.rar


 
Cardinal ©   (2003-11-16 18:47) [20]

Вот: http://amis.fatal.ru/pic/rar/bk.rar


 
Valdas   (2003-12-18 13:35) [21]

www.algolist.manual.ru - ищите, там есть где комп отгадывает.


 
Valdas   (2003-12-18 13:35) [21]

www.algolist.manual.ru - ищите, там есть где комп отгадывает.



Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2004.04.11;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.56 MB
Время: 0.046 c
1-1082715820
zorik
2004-04-23 14:23
2004.05.09
не вигружается dll


3-1081795892
Ну вобщем это мой ник
2004-04-12 22:51
2004.05.09
Господа, Простите мою наглость, не могли ли бы вы накидать ссылок


14-1082540052
ИМХО
2004-04-21 13:34
2004.05.09
Вопрос веб-спецам


14-1081953297
MalkoLinge
2004-04-14 18:34
2004.05.09
Как Вам Вакансия ?


7-1079033075
HepB
2004-03-11 22:24
2004.05.09
Имена приводов и их буквы...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский