Игра с реккурентной функцией полного перебора Опции

[SHnur]

Вот такая простенькая игра , может каму-нибудь будет полезна функция полного перебора ...

Код

program X_game;
uses crt;
const N = 10;
     av = 3;
type bor =  array[1..N] of boolean;
var b: bor;
   level : integer;
   move , best : byte;

function finish(v:bor):boolean;
var i , cou : integer;
begin
  cou := 0;
  for i := 1 to N do begin
     if cou = av then break;
     if v[i] then inc(cou) else cou := 0;
  end;
  finish := not(cou <> av);
end;

function estimate(b:bor):shortint;
var i : integer;
   emax , e : shortint;
begin
  inc(level);
  if Finish(B) then Estimate:=1
  else begin
     emax := -2;
     for i := 1 to n do
        If not(b[i]) then begin
           b[i] := true;
           e := -Estimate(B);
           b[i] := false;
           if e>emax then begin
              emax := e;
              if level=1 then best := i;
           end;
        end;
     Estimate := emax;
  end;
  dec(level);
end;

procedure sb;
var i :integer;
begin
  for i := 1 to N do begin
     if  b[i] then write('X') else write('-');
  end;
  writeln;
end;

var ch : integer;
begin
  clrscr;
  for ch := 1 to n do b[ch] := false;
  repeat

     writeln('your move :');
     repeat
       readln(ch);
     until (ch <= N) and not(b[ch]);
     b[ch] := true;
     sb;


     Estimate(B);
     b[best] := true;
     writeln('My move !');
     sb;

  until finish(B);
end.

Сообщение отредактировано: SHnur - 12.05.2005 22:31

[volvo]

может каму-нибудь будет полезна функция полного перебора ...

А кому-нибудь может быть полезно не изобретать в тысячный раз велосипед, а воспользоваться поиском - Перебор у нас есть по крайней мере в семи местах (причем полный) ...

[SHnur]

ок , удалите , не буду больше мусорить :yes: