IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Быки и коровы.
сообщение
Сообщение #1


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Привет всем. На одном форуме нашёл тему, где пользователь просил написал программу, которая "играла" бы в игру Быки и коровы. Тема та уже неактуальна, но мне вот стало интересно написать программку, которая угадывала бы число за какое-то количество шагов, рекурсией. Алгоритм пришёл в голову такой - брать начальную комбинацию (1234 например) и с каждым шагом увеличивать каждую цифру. Если встречается "бык" (т.е. число, которое на своём месте), то больше эту позицию не трогаем, а если "корова" (число есть в правильном ответе, но не на своём месте), то ищем его место, пока не найдём - остальные цифры не трогаем. Вот что получилось:

{$APPTYPE CONSOLE}
uses sysutils;

const cif = 4;

type TCel = array[1..2] of byte;

var cel:string;
steps:byte=0;
yes,maybe,i:byte;
rightans:string[cif];
d:set of byte=[];

function getans(s:string):TCel;
var j:byte;
begin
result[1]:=0;result[2]:=0;
for j:=1 to cif do if s[j]=rightans[j] then inc(result[1])
else if pos(s[j],rightans)>0 then inc(result[2]);
end;

Function getpos(c:char):byte;
var j:byte;
begin
result:=0;
for j:=1 to cif do if (c=rightans[j]) and (pos(c,cel)<>j) then begin
result:=j;
break;
end;
end;

Procedure rec(s:string);
var i,j:byte;
buf:char;
begin
if (getans(s)[1]=cif) then begin
writeln('Ура, посчиталось! Число было угадано за '+inttostr(steps)+'шагов.');
readln;
halt;
end else if getans(s)[2]>0 then begin
for i:=1 to cif do begin
if (getpos(s[i])>0) then begin
buf:=s[i]; //<-
s[i]:=s[getpos(s[i])]; //<-
s[getpos(s[i])]:=buf; //<-
include(d,strtoint(s[i]));
inc(steps);
end;
end;
end else begin
for i:=1 to cif do
for j:=1 to 9 do begin
if (pos(inttostr(j),s)=0) then begin
s[i]:=inttostr(j)[1];
break;
end;
end;
inc(steps);
rec(s);
end;
end;

begin
writeln('Загадайте '+inttostr(cif)+'-значное число');
readln(rightans);
for i:=1 to cif do cel:=cel+inttostr(i);
rec(cel);
end.



Вот это вылетает с RE, там как я понял где стрелочки неправильно число переводится в символ. Вообще, как по-вашему, рекурсией это хотя бы примерно так делать надо?


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.04.2024 0:59
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name