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

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

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

 
 Ответить  Открыть новую тему 
> Быки и коровы.
Unconnected
сообщение 24.05.2010 23:01
Сообщение #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

 



- Текстовая версия 20.07.2025 2:54
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"