unit Unit2;
{
 DavData software
 3D boter - kaas - eieren
 data & search unit

 2 players
 red - blue - red - blue...............
 analyse button predicts game
 7 - 02 - 2014 version 1.1
 9 - 02 - 2014         1.2   no win test if node < 5

} 

interface

uses sysutils;

type TWintriple = record
                   p1,p2,p3 : byte;
                  end;
     TNode   = record
                pos : byte;
                rating : byte;
                treshold : byte;
               end;

const maxmove = 27;

var game : array[0..maxmove] of byte;  //1=O 2=X
    node : array[1..maxmove] of TNode;
    moveNr : byte;

procedure makewinlist;
procedure initgame;
procedure analyse;
function checkwin(var tr : Twintriple; player : byte) : boolean;

implementation

uses unit1;

var winlist  : array[1..50] of TWinTriple;
    wincount : byte;
    testNode : byte;
    baseNode :byte;

procedure initgame;
var i : byte;
begin
 for i := 0 to maxmove do game[i] := 0;
 for i := 1 to maxmove do
  with node[i] do
   begin
    pos := 0;
    rating := 0;
    treshold :=0;
   end;
 moveNr := 0;
end;

function checkwin(var tr : TwinTriple; player : byte) : boolean;
//check for win somewhere, return wintriple# tr
var i : byte;
begin
 i := 0;
 result := false;
 repeat
  inc(i);
  with winlist[i] do
   result := (game[p1] = player) and
             (game[p2] = player) and
             (game[p3] = player);
 until result or (i = wincount);
 if result then tr := winlist[i];
end;

procedure makewinlist;
const concode : array[1..maxmove] of byte =
                (1,2,1,3,4,3,1,2,1,5,6,5,7,0,7,5,6,5,1,2,1,3,4,3,1,2,1);
var i,j : byte;  //start..end field
begin
 wincount := 0;
 for i:= 1 to 25 do
  for j := i+2 to 27 do
   if concode[i] = concode[j] then
    begin
     inc(wincount);
     with winlist[wincount] do
      begin
       p1 := i;
       p2 := (i + j) shr 1;
       p3 := j;
      end;
    end;
end;

//-- analyze helpers

function firstmove : boolean;
//make first move of new node
//false if no move (node = 27)
//true if move done
var i,m : byte;
begin
 with node[testnode] do
  begin
   if treshold = 100 then treshold := 98; //no win
   result := rating < treshold;
   if result then
    begin
     m := 2 - (testNode and 1);
     i := 1;
     while game[i] > 0 do inc(i);
     game[i] := m;
     pos := i;
    end;//if
  end; 
end;

procedure testwin;
//test for any win in new node
//set rating = 100 if win
//report basenode wins
var i,m,p : byte;
    win : boolean;
begin
 if testNode < 5 then exit;

 m := 2 - (testNode and 1);
 if testnode = basenode then        //basenode
  begin
   for p := 1 to maxmove do
    if game[p] = 0 then
     begin
      game[p] := m;
      for i := 1 to wincount do
       begin
        win  := (game[winlist[i].p1] = m) and
                (game[winlist[i].p2] = m) and
                (game[winlist[i].p3] = m);
        if win then begin
                     analysereport(p,100);
                     node[testNode].rating := 100;
                    end;
       end;
      game[p] := 0;
     end;
  end   //basenode
  else                      //not basenode
   begin
    p := 1;
    win := false;
    repeat
     if game[p] = 0 then
      begin
       game[p] := m;
       i := 0;
       repeat
        inc(i);
        win  := (game[winlist[i].p1] = m) and
                (game[winlist[i].p2] = m) and
                (game[winlist[i].p3] = m);
       until win or (i = wincount);
       game[p] := 0;
      end;//if game[p]
     inc(p);
    until win or (p = maxmove+1);
    if win then node[testnode].rating := 100;
   end;//else
end;

function nextNode : boolean;
//open node testnr+1
//set 1st move
var x : byte;
begin
 result := testNode < 27;
 if result then
  begin
   inc(testNode);
   with node[testNode] do
    begin
     pos := 0;
     if testNode = baseNode then
      begin
       treshold := 100;
       rating := 1;
      end
     else
      begin
       x := 100 - node[testNode-1].rating;
       if x < 50 then dec(x);
       if (x > 50) then inc(x);
       if testNode >= maxmove-1 then treshold := 50
        else treshold := x;
       x := 100 - node[testNode-1].treshold;
       if x < 50 then dec(x);
       if x > 50 then inc(x);
       rating := x;
      end;
    end;//with  
  end;
end;

function previousnode : boolean;
//close node nr
//if baseNode  set score
//else set rating
var x,p : byte;
    prf : boolean;
begin
 result := false;
 prf := true;
 while prf do
  begin
   prf := false;
   p := node[testnode].pos;
   game[p] := 0;               //remove O,X
   if testNode > baseNode then
    begin
     result := true;
     x := 100 - node[testnode].rating;
     dec(testNode);
     with node[testnode] do
      begin
       if x > 50 then dec(x);
       if x < 50 then inc(x);
       if testnode = basenode then analysereport(pos,x)
        else
         if x > rating then
          begin
           rating := x;
           prf := rating >= treshold;
          end;
      end;
    end
    else result := false; //testNode = baseNode
  end;//while
end;

function nextmove : boolean;
var x : byte;
begin
 result := false;
 x := node[testNode].pos;
 game[x] := 0;//none
 while (x < maxmove) and (result = false) do
  begin
   inc(x);
   result := game[x] = 0;
  end;
 if result then
  begin
   game[x] := 2 - (testNode and 1);
   node[testnode].pos := x;
  end;
end;

//-- main call

procedure analyse;
//analyse game
var Ffirst,Fnext,Fprev : boolean;
begin
 if movenr = 27 then exit;

 testNode := moveNr;
 baseNode := moveNr + 1;

 Ffirst := true;
 while Ffirst do
  begin
   Fnext := true;
   while Fnext do
    begin
     Fnext := false;
     if nextNode then
      begin
       testwin;
       Fnext := firstMove;
      end; 
    end;  

   Fprev := true;
   while Fprev do
    if previousNode then
     begin
      if nextmove then Fprev := false;
     end
     else begin
           Ffirst := false;
           Fprev := false;
          end;

  end;//Ffirst
end;

end.