Привет всем. На одном форуме нашёл тему, где пользователь просил написал программу, которая "играла" бы в игру http://ru.wikipedia.org/wiki/%D0%91%D1%8B%D0%BA%D0%B8_%D0%B8_%D0%BA%D0%BE%D1%80%D0%BE%D0%B2%D1%8B Тема та уже неактуальна, но мне вот стало интересно написать программку, которая угадывала бы число за какое-то количество шагов, рекурсией. Алгоритм пришёл в голову такой - брать начальную комбинацию (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.