var
s,s1:string[4]; {s - число, задуманное компьютером, s1 - наше предположение}
m,n:byte; {m - кол-во угаданных чисел; n - кол-во цифр, стоящих на своих позициях}
a:set of char;
procedure answer (s1:string ); var k,p:byte; {k - кол-во угаданных чисел; p - кол-во цифр, стоящих на своих позициях}
var
j,i: integer;
l:string;
begin
l:=s;
  for i:=1 to 4 do if s1[i] in a then
    begin
    inc(k);
    j:=0;
    repeat
     inc(j)
    until l[j]=s1[i];
    l[j]:='X'; {Убираем число, т.к. мы его угадали}
    a:=[l[1],l[2],l[3],l[4]];
    end;
  for i:=1 to 4 do if s1[i] = s[i] then inc(p);
end;

begin
randomize; {инициализируем генератор случайных чисел}
str(1000 + random(9000),s);  {Случайное число из диапазона 1000..9999 }
repeat
a:=[s[1],s[2],s[3],s[4]]; {множество цифр, задуманных компьютером}
m:=0;n:=0;
writeln('Отгадай число');
readln(s1);
answer(s1);m:=n;
if s = s1 then writeln ('Поздравляю, вы отгадали число!') else
  writeln('Вы отгадали ',m,' цифр и ',n,' из них стоят на своей позиции.');
until s = s1;
end.

procedure answer (s1:string; var k:byte; var p:byte);

var
 s,s1:string[4]; {s - число, задуманное компьютером, s1 - наше предположение}
 m,n:byte; {m - кол-во угаданных чисел; n - кол-во цифр, стоящих на своих позициях}
 a:set of char;

procedure answer (sa:string; var k:byte; var p:byte); {k - кол-во угаданных чисел; p - кол-во цифр, стоящих на своих позициях}
var
 j,i: integer;
 l:string;
begin
 l:=s;
 k:=0;
 p:=0;
 for i:=1 to 4 do
  if sa[i] in a then
   begin
    inc(k);
    j:=0;
    repeat
     inc(j)
    until l[j]=sa[i];
    l[j]:='X'; {Убираем число, т.к. мы его угадали}
    a:=[l[1],l[2],l[3],l[4]];
   end;
 for i:=1 to 4 do
  if sa[i] = s[i] then inc(p);
end;

begin
 randomize; {инициализируем генератор случайных чисел}
 str(1000 + random(9000),s);  {Случайное число из диапазона 1000..9999 }
 {Writeln(s); Readln;} {Это вывод задуманного числа для отладки}
 repeat
  a:=[s[1],s[2],s[3],s[4]]; {множество цифр, задуманных компьютером}
  Repeat
   writeln('Введите четырехзначное число (0000 - выход)');
   readln(s1);
   If s1='0000' then Halt;
  Until Length(s1)=4;
  answer(s1,m,n);
  if s = s1 then
   begin
    writeln ('Поздравляю, вы отгадали число!');
    readln;
   end
   else
    writeln('Вы отгадали ',m,' цифр и ',n,' из них стоят на своей позиции.');
 until s = s1;
end.