a) Пользователь загадывает число из 4 цифр, каждая из которых от 1 до 6, причем все цифры различны. Разработать алгоритм, который угадывает число по следующим правилам: выводится число и пользователь сообщает, сколько в нем "быков" и "коров", т.е. сколько цифр стоят на своих местах и сколько цифр содержатся в обоих числах, но совпадают лишь по значению. Например, пусть загадано число 1264, спрошено 1256. В этом случае 2 быка (1,2) и одна корова (6)

б) Правила игры те же, но загадывается 6-значное число с цифрами от 1 до 9, причем среди цифр допускаются одинаковые.

Примечание : Спрошенное число должно удовлетворять правилам для загадываемого; компьютеру на ход дается 1 минута .

Итак, 1-ое что приходит в голову играть по следующему правилу: называть первое попавшееся число, которое может быть задуманно, т.е. при сопоставлении любого ранее спрошенного числа с новым должно получится такое-же количество 'быков' и 'коров'. Число будем представлять в виде массива цифр.}

(Прим. вебмастера - прошу прощения за опечатки в исходниках: их составлял не я. Надеюсь, Вам не составит труда восстановить правильные программы по алгоритмам.)

const MaxSgn = 6; {Максимальное значение в числе}
Sgn = 4; {Количество цифр в числе}
type S = 1..MaxSgn;
Numb = array[1..Sgn] of S;
function cows(n1,n2:Numb):byte;
{Сравнивает два числа и возвращает результат 
сравнения в виде <количество быков>*10+<количество коров>}
var i1,i2 : 1..Sgn;
a : byte;
begin
{Необходимо сравнивать все цифры первого 
числа со всеми цифрами второго}
a:=0;
for i1:=1 to Sgn do
for i2:=1 to Sgn do
if n1[i1]=n2[i2] then
if i1=i2 then a:=a+10 {Встретился 'Бык'}
else inc(a);
cows:=a;
end;
type Step = Record {Информация об одном вопросе - ответе}
n : Numb; {Спрошенное число}
answer : byte; {Ответ}
end;
Game = array[1..32] of step;
{Информация о всех вопросах - ответах}
var Nstep : byte; {Номер текущего шага}
Info : Game;
Curnumb : Numb; i,j : integer; b : boolean;
BEGIN
clrscr;
for i:=1 to Sgn do Curnumb[i]:=i;
Nstep:=0;
while true do
{Пока не будут перебраны все числа 
или не найденно решение}
begin
{Спросить текущее число}
for i:=1 to Sgn do write(Curnumb[i]);
write(' ? ');
inc(Nstep);
Info[Nstep].n:=Curnumb;
readln(Info[Nstep].Answer);
{Пользователь должен ввести число, первая цифра 
которого 'Быки', вторая - 'Коровы'}
if (Info[Nstep].Answer div 10+Info[Nstep].Answer mod 10)>Sgn then
begin writeln('Плохая игра !'); exit; end;
{'Быков' и 'Коров' вместе не может быть больше, чем цифр}
if Info[Nstep].Answer=10*Sgn then exit;
{Далее идет генерация нового числа}
repeat
i:=Sgn;
{Увеличение числа на 1-цу}
while (i>=1) and (Curnumb[i]=MaxSgn) do
begin
Curnumb[i]:=1;
dec(i);
end;
if i<1 then
begin {Все числа перебраны, а ответ не найден}
writeln('Вы неправильно отвечали !'); exit; end;
inc(Curnumb[i]);
b:=true;
{Проверка на встречающиеся одинаковые цифры}
for i:=1 to Sgn do
for j:=i+1 to Sgn do
b:=b and (Curnumb[i]<>Curnumb[j]);
for i:=1 to Nstep 
   do b:=b and (cows(Curnumb,Info[i].n)=Info[i].Answer);
until b;
end; {while}
END. {program}

Итак, наша программа работает следующим образом: мы путем последовательного увеличения на 1 генерируем все возможные 6-значные числа, отбираем среди них те, в которых все цифры различные, и, наконец, те из них, которые удовлетворяют хранящимся в массиве Info ответам, задается пользователю в качестве вопроса. Возникает ряд резонных вопросов: сколько всего интересующих нас 4-значных цифр и какая их часть не содержит повторений.

За сколько шагов может угадать ответ самый быстрый алгоритм и насколько хороша наша стратегия?

Давайте попытаемся ответить на них. Итак сколько всего чисел? Пусть k цифр и m позиций. В первой позиции может стоять любая

Из k цифр, что нам дает k вариантов. Во второй-также любая из k цифр, т.е. k². И так далее m раз, т.е. всего k^m вариантов. Обобщим эту идею.

Определение: размещение с n повторением из k элементов по m называется m-элементный массив натуральных чисел, каждое из которых не превосходит k.

Утверждение: Число размещений с повторениями из k по m равно k^m. Доказательство проводим по индукции:

Базис индукции: При m=1 у нас ровно k вариантов.

Индуктивный переход: Пусть утверждение верно при m=n-1. Докажем, что оно верно при m=n. Зафиксируем число 1. Справа к этому числу припишем kⁿ⁼¹ размещений из k по n-1. Аналогично поступим с 1,2,3...k. Получим k^n-1*k=kⁿ вариантов.

Таким образом, число 4-значных чисел с цифрами от 1 до 6 равно 6⁴=1296. Теперь посмотрим, сколько из них не содержит повторяющихся цифр.

Определения: размещением из k элементов по m называется m-элементный массив каждая компонента которого не превосходит k и среди них не встречаются одинаковые. Очевидно, что множество размещений не пусто лишь при m<=k.

Число размещений из k по m принято обозначать A.

Утверждение A=k*(k-1)*...(k-m+1)=k!/(k-m+1)!

Доказательство проводим по индукции:

Базис индукции: При m=1 у нас ровно k вариантов.

Индуктивный переход: Пусть утверждение верно при m=n-1. Выберем любое из k!/(k-n+1)! размещений из k по n-1. Чисел, которые в нем не участвуют-(k-n+1). Приписывая их поочередно справа к выбранному размещению мы получим (k-n+1) вариантов. Перебирая все размещения:

Таким образом,число 4-значных чисел с цифрами от 1 до 6 без повторений равно A46=6*5*4*3=360, т.е. в 3 раза меньше, чем число вариантов, которые мы перебирали. Итак мы нашли один способ для оптимизации нашей программы: генерировать не все числа, а лишь те, которые не содержат повторяющихся цифр. Возьмем это на заметку, а сейчас попробуем оценить максимальное число шагов, за которое отгадывает лучший игрок. Вариантов ответа у нас:

Пусть угадано 4 цифры. Среди них могут быть 2,1,0 "быков". Пусть угаданы 3 цифры. Среди них могут быть 3,2,1,0 "быков". И так далее: получаем 3+4+2+1=10 вариантов.

Таким образом за каждый вопрос количество допустимых чисел уменьшается, если мы рассматриваем худший случай, не более чем в 10 раз. Число шагов, за которое угадывает лучший игрок, не менее чем [log₁₀ 360]+1=3

Ну а теперь попытаемся повысить эффективность работы программы. Как уже было отмечено выше, нам достаточно перебрать не 1096 комбинаций, а всего лишь 360. Это не отразится на быстроте угадывания, т.е. числе шагов, так как не изменим стратегии "первый попавшийся из подходящих", но уменьшит время обдумывания хода.

Генерировать числа будем следующим образом: для начала выберем множество цифр, которое в него входит, ну а затем будем переставлять элементы этого множества между собой. Множество цифр удобно, для наших целей, представить в виде массива длины 4, элементы которого расположены в порядке возрастания. Будем генерировать эти массивы в лексикографическом порядке, т.е. сначала сравниваются первые цифры, если они равны - вторые, и так далее. То есть:

Значит, мы должны увеличить самую правую цифру, какую это возможно, и уменьшить затем те цифры, какие стоят за ней. Заметив, что номер цифры, которую нужно увеличивать, уменьшается на 1, а как только последний элемент массива можно будет увеличить, скачкообразно становится равной длине массива, приходим к следующему алгоритму:

{n-число цифр}
{A-массив который содержит текущие комбинации}
Var
p:integer;
{номер элемента ,который увеличивается в данный момент}
Var
i:integer;
for i:=1 to n do
a[i]:=i;{Начальное значение}
p:=n;{увеличивается крайняя правая цифра}
while p>=1 do
begin
{Write(A)}-{Последовательность готова};
for i:=k downto p do
A[i]:=A[p]+i-p+1;
if a[k]=n then dec(p);
else p:=k;
end;

{B - массив элементов перестановки}
{Direc - массив направлений, i-й элемент равен TRUE,
 если тело i движется вправо}
{Posit - массив положения i-го элемента
 в перестановке n-i элементов}
for i:=1 to n do
begin
B[i]:=i;
Posit[i]:=1;
Direc[i]:=TRUE;
end;
Posit[n]:=0;

{В-массив элементов перестановки}
{Direc-массив направлений. i-й элемент равен true, 
если число i движений вправо}
{Posit- массив положения i-го элемента в перестановке
n-i элементов}
For i:=1 to n do
begin
b[i]:=i;
posit[i]:=1;
direc[i]:=true;
end;
posit[n]:=0;
i:=1;
while i<n do
begin
direct[i]:=not direct[i];
posit[i]:=1;
if direct[i] then inc(x);
inc(i)
end;
if i<n then
begin
if pirof[i] then k:=c[i]+x
else k:=n-i+1-c[i]+x;
b[k]<->b[k+1];
inc(posit[i])
end
end;

Const MaxSgn=6;
Sgn=4;
Type s=1..MaxSgn; {цифра}
Numb=array[1..Sgn] of s;
function cows(n1,n2:Numb):byte;
{Сравнивает два числа и возвращает результат сравнения 
в виде <количество быков>*10+<количество коров>}
var i1,i2 : 1..Sgn;
a : byte;
begin
{Необходимо сравнивать все цифры первого числа 
со всеми цифрами второго}
a:=0;
for i1:=1 to Sgn do
for i2:=1 to Sgn do
if n1[i1]=n2[i2] then
if i1=i2 then a:=a+10 {Встретился 'Бык'}
else inc(a);
cows:=a;
end;
type Step = Record {Информация об одном вопросе - ответе}
n : Numb; {Спрошенное число}
answer : byte; {Ответ}
end;
Game = array[1..32] of step;
{Информация о всех вопросах - ответах}
var NStep:byte;
Info:game;
Procedure testnumber;
{процедура проверяет, удовлетворяет ли входное число 
ранним ответам, и, если да, то задает его в качестве вопроса.
 В случае, если число угадано, заканчивает игру}
Var i:byte;
begin
for i:=1 to nstep do
if cows(n,info[i].n)<>info[i].answer then Exit;
inc(Nstep);
info[nstep].n:=n;
for i:=1 to sgn do write(n[i]);
write(' ? ');
readln(info[nstep].answer);
if info[nstep].answer=sgn*10 then
halt;
{игра окончена}
end; {test number}
Var tset{текущее n-элементное подмножество}
,tn:number;
i,j,k,l:byte;
direc:array[1..sgn] of boolean; posin:array[1..sgn] of byte;
begin
{инициализация}
nstep:=0;
for i:=1 to sgn do tset[i]:=i; i:=sgn;
while i>=1 do
begin
tn:=tset;
for j:=1 to sgn do begin
posit[i]:=1;
direct[i]:=true;
end;
posit[sgn]:=0;
j:=1;
testnumber(tn);
while j<sgn do
begin
j:=1;
k:=0;
while posit[j]=sgn-j+1 do
begin
posit[j]:=1;
direct[j]:=not direct[j];
if direct[j] then inc(x);
inc(j);
end;
if j<sgn then
begin
if direct[j] then l:=posit[j]+n;
else l:=sgn-j+1+posit[j]+k;
inc[posit[j];
end;
end;
writeln('Плохая игра');end.