strategy.pas

来自「source code for caro game on Java」· PAS 代码 · 共 283 行

type

  TStPattern = record
                 value : Integer;
                 FormSt: String[7];
               end;

  TStPatternInfo = record
                     weight, plength, offset, v : Integer;
                   end;
const

  STPSIZE = 105;

  StPattern : array[0..STPSIZE] of TStPattern = (
    (value : $5F5E164; FormSt : '*xxxx'),     {100000100}
    (value : $5F5E164; FormSt : 'x*xxx'),
    (value : $5F5E164; FormSt : 'xx*xx'),
    (value : $186A2; FormSt : '*xxx-'),       {100002}
    (value : $186A2; FormSt : '*x-xx'),
    (value : $186A2; FormSt : '*xx-x'),
    (value : $15F90; FormSt : '*-xxx'),       {90000}
    (value : $186A2; FormSt : 'x*-xx'),
    (value : $186A2; FormSt : 'x*x-x'),
    (value : $186A2; FormSt : 'x*xx-'),
    (value : $15F92; FormSt : '-*xxx'),       {90002}
    (value : $186A2; FormSt : '-x*xx'),
    (value : $186A2; FormSt : 'x-*xx'),
    (value : 1002; FormSt : '*x-x-'),
    (value : 1002; FormSt : '*x--x'),
    (value : 1502; FormSt : '*xx--'),
    (value : 1000; FormSt : '*-x-x'),
    (value : 1000; FormSt : '*--xx'),
    (value : 1000; FormSt : '*-xx-'),
    (value : 1002; FormSt : 'x*--x'),
    (value : 1002; FormSt : 'x*-x-'),
    (value : 1002; FormSt : 'x*x--'),
    (value : 1000; FormSt : '-*x-x'),
    (value : 1502; FormSt : '-*xx-'),
    (value : 1000; FormSt : '-*-xx'),
    (value : 1000; FormSt : 'x-*-x'),
    (value : 1002; FormSt : '-x*-x'),
    (value : 1002; FormSt : '-x*x-'),
    (value : 1502; FormSt : '--*xx'),
    (value : 1; FormSt : '*--x-'),
    (value : 1; FormSt : '*---x'),
    (value : 53; FormSt : '*x---'),
    (value : 50; FormSt : '*-x--'),
    (value : 1; FormSt : '-*--x'),
    (value : 50; FormSt : '-*-x-'),
    (value : 53; FormSt : '-*x--'),
    (value : 53; FormSt : 'x*---'),
    (value : 53; FormSt : '--*x-'),
    (value : 50; FormSt : '--*-x'),
    (value : 1; FormSt : '*--o-'),
    (value : 1; FormSt : '*---o'),
    (value : 53; FormSt : '*o---'),
    (value : 50; FormSt : '*-o--'),
    (value : 1; FormSt : '-*--o'),
    (value : 50; FormSt : '-*-o-'),
    (value : 53; FormSt : '-*o--'),
    (value : 53; FormSt : 'o*---'),
    (value : 53; FormSt : '--*o-'),
    (value : 50; FormSt : '--*-o'),
    (value : $5F5E100; FormSt : 'oo*oo'),       {100000000}
    (value : $5F5E100; FormSt : 'o*ooo'),
    (value : $5F5E100; FormSt : '*oooo'),
    (value : $186A2; FormSt : '*ooo-'),         {100002}
    (value : $186A2; FormSt : '*o-oo'),
    (value : $186A2; FormSt : '*oo-o'),
    (value : $15F90; FormSt : '*-ooo'),         {90000}
    (value : $186A2; FormSt : 'o*-oo'),
    (value : $186A2; FormSt : 'o*o-o'),
    (value : $186A2; FormSt : 'o*oo-'),
    (value : $15F92; FormSt : '-*ooo'),         {90002}
    (value : $186A2; FormSt : '-o*oo'),
    (value : $186A2; FormSt : 'o-*oo'),
    (value : 1002; FormSt : '*o--o'),
    (value : 1000; FormSt : '*-o-o'),
    (value : 1000; FormSt : '*--oo'),
    (value : 1000; FormSt : '*-oo-'),
    (value : 1502; FormSt : '*oo--'),
    (value : 1002; FormSt : '*o-o-'),
    (value : 1002; FormSt : 'o*--o'),
    (value : 1002; FormSt : 'o*-o-'),
    (value : 1002; FormSt : 'o*o--'),
    (value : 1000; FormSt : '-*o-o'),
    (value : 1000; FormSt : '-*-oo'),
    (value : 1502; FormSt : '-*oo-'),
    (value : 1000; FormSt : 'o-*-o'),
    (value : 1002; FormSt : '-o*-o'),
    (value : 1502; FormSt : 'oo*--'),
    (value : 1002; FormSt : '-o*o-'),
    (value : 20000; FormSt : '-*-oo-'),
    (value : 20000; FormSt : '-*o-o-'),
    (value : $1876A; FormSt : '-*oo--'),       {100202}
    (value : $1876A; FormSt : '--*oo-'),
    (value : 20002; FormSt : '-o*-o-'),
    (value : $186A2; FormSt : '-o*o--'),       {100002}
    (value : $1876A; FormSt : '--xx*-'),
    (value : 20000; FormSt : '-x-x*-'),
    (value : 20000; FormSt : '-xx-*-'),
    (value : $186A2; FormSt : '--x*x-'),
    (value : $1876A; FormSt : '-xx*--'),
    (value : 20002; FormSt : '-x-*x-'),
    (value : $2DC6C0; FormSt : '-*xxx-'),      {3000000}
    (value : $2DC6C0; FormSt : '-x*xx-'),
    (value : $2DC6C0; FormSt : '-*ooo-'),
    (value : $2DC6C0; FormSt : '-o*oo-'),
    (value : 1000; FormSt : '-*x---'),
    (value : 1000; FormSt : '-*-x--'),
    (value : 1; FormSt : '-*--x-'),
    (value : 1000; FormSt : '-x*---'),
    (value : 1002; FormSt : '--*x--'),
    (value : 1000; FormSt : '--*-x-'),
    (value : 1000; FormSt : '-*o---'),
    (value : 1000; FormSt : '-*-o--'),
    (value : 1; FormSt : '-*--o-'),
    (value : 1000; FormSt : '-o*---'),
    (value : 1002; FormSt : '--*o--'),
    (value : 1000; FormSt : '--*-o-'));

    dirX : array[0..7] of Integer = (-1, 0, 1, 1, 0,-1,-1, 1);
    dirY : array[0..7] of Integer = ( 1, 1, 1, 0,-1,-1, 0,-1);

var
  HashIndex5 : array[0..243] of Integer;
  HashIndex6 : array[0..729] of Integer;
  Weights    : array[1..SIZE_Y,1..SIZE_X] of Integer;
  PInfo      : array[0..STPSIZE] of TStPatternInfo;

{---------------------------------------------------------}
function POSX(x,dir,ofs:Integer):Integer;
begin
  Result:=x+ofs*dirX[dir];
end;
{---------------------------------------------------------}
function POSY(y,dir,ofs:Integer):Integer;
begin
  Result:=y+ofs*dirY[dir];
end;
{---------------------------------------------------------}
function ComputeIndex5(x,y,dir:Integer):Integer;
var
  tt,l,temp : Integer;
begin
  tt:=1;
  temp:=0;
  for l:=0 to 4 do
    begin
      Inc(temp,(1-Piece[POSY(y,dir,l),POSX(x,dir,l)])*tt);
      tt:=tt*3;
    end;
  Result:=temp;
end;
{---------------------------------------------------------}
function ComputeIndex6(x,y,dir,temp:Integer):Integer;
begin
  Result:=temp+(1-Piece[POSY(y,dir,5),POSX(x,dir,5)])*243;
end;
{---------------------------------------------------------}
procedure SetPInfo(stt:Integer);
var
  i,j : Integer;
begin
  with PInfo[stt] do
    begin
      weight:=StPattern[stt].value;
      plength:=Length(StPattern[stt].FormSt);
      offset:=0;
      v:=0;
      i:=1;
      for j:=1 to plength do
        begin
          case StPattern[stt].FormSt[j] of
            'x' : Inc(v,i*2);
            '*' : begin
                    Inc(v,i);
                    offset:=j-1;
                  end;
            '-' : Inc(v,i);
          end;
          i:=i*3;
        end;
    end;
end;
{---------------------------------------------------------}
procedure InitShashinPattern;
var
  i,k : Integer;
begin
  FillChar(HashIndex5,SizeOf(HashIndex5),0);
  FillChar(HashIndex6,SizeOf(HashIndex6),0);
  for i:=0 to STPSIZE do SetPInfo(i);
  for i:=0 to STPSIZE do
    begin
      k:=PInfo[i].v;
      if PInfo[i].plength=5 then
        begin
          if HashIndex5[k]=0 then HashIndex5[k]:=i+1
            else HashIndex5[k]:=150*HashIndex5[k]+i+1;
        end
      else if PInfo[i].plength=6 then
        begin
          if HashIndex6[k]=0 then HashIndex6[k]:=i+1
            else HashIndex6[k]:=150*HashIndex6[k]+i+1;
        end;
    end;
end;
{---------------------------------------------------------}
procedure ComputeWeight(x,y:Integer);
var
  i,j,k,t,temp,i3,k2 : Integer;
begin
  temp:=0;
  k:=0;
  repeat
    i:=POSX(x,k,4);
    j:=POSY(y,k,4);
    if (1<=i) and (i<=SIZE_X) and (1<=j) and (j<=SIZE_Y) then
      begin
        temp:=ComputeIndex5(x,y,k);
        t:=HashIndex5[temp];
        while t>0 do
          begin
            i3:=PInfo[t mod 150 - 1].offset;
            i:=POSX(x,k,i3);
            j:=POSY(y,k,i3);
            if Piece[j,i]=EMPTY then Inc(Weights[j,i],PInfo[t mod 150 - 1].weight);
            t:= t div 150;
          end;
      end;

    i:=POSX(x,k,5);
    j:=POSY(y,k,5);
    if (1<=i) and (i<=SIZE_X) and (1<=j) and (j<=SIZE_Y) then
      begin
        k2:=ComputeIndex6(x,y,k,temp);
        t:=HashIndex6[k2];
        while t>0 do
          begin
            i3:=PInfo[t mod 150 - 1].offset;
            i:=POSX(x,k,i3);
            j:=POSY(y,k,i3);
            if Piece[j,i]=EMPTY then Inc(Weights[j,i],PInfo[t mod 150 - 1].weight);
            t:= t div 150;
          end;
      end;

    Inc(k);
  until k>=8;
end;
{---------------------------------------------------------}
procedure Shashin(var m:Move);
var
  x,y,count,maxpoint : Integer;
  BestMove           : array[1..16] of Move;
begin
  FillChar(Weights,SizeOf(Weights),0);
  for x:=1 to SIZE_X do
    for y:=1 to SIZE_Y do ComputeWeight(x,y);
  count:=0;
  maxpoint:=-1;
  for x:=1 to SIZE_X do
    for y:=1 to SIZE_Y do
      if maxpoint<Weights[x,y] then
        begin
          count:=1;
          BestMove[1].Row:=x;
          BestMove[1].Col:=y;
          maxpoint:=Weights[x,y];
        end
      else if (maxpoint=Weights[x,y]) and (count<16) then
        begin
          Inc(count);
          BestMove[count].Row:=x;
          BestMove[count].Col:=y;
        end;

  if count>0 then m:=BestMove[Random(count)+1] else m.Row:=0;
end;