unit U_GraphTraverse;
{Todo:  Show max/min paths on grid}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids;

const
  boardsize:integer=13;

type
  TPath=array of integer;
  TBoard=array of array of integer;

  TForm1 = class(TForm)
    SolveBtn: TButton;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    AnimateBtn: TButton;
    GenerateBtn: TButton;
    Memo1: TMemo;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SolveBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AnimateBtnClick(Sender: TObject);
    procedure GenerateBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    board:TBoard;  {the array of numbers - boardsize+2 X boardsize+2 to allow room for border of 0's} 
    pathstried:integer;  
    UpdateDisplay:integer; {how often to update the display}
    starttime:TDateTime;     
    procedure getpath(p:TPoint; pathin:TPath);  {this does the work}
    procedure UpdatePathDisplay;  {show max & min path info}
    procedure resetlabels;
    procedure generateBoard;
  end;

var
  Form1: TForm1;

implementation

var
  globalmaxpath, globalminpath:TPath;

{$R *.DFM}

procedure TForm1.SolveBtnClick(Sender: TObject);
{User clicked Solve button}
var
  p:TPoint;
  i:integer;
  path:TPath;
  secs:real;
begin
  screen.cursor:=crHourglass;
  setlength(path,boardsize+1);
  ResetLabels;
  pathstried:=0;
  starttime:=now;
  for i := 0 to boardsize do
  begin
    globalmaxpath[i]:=0;
    globalminpath[i]:=999;
  end;
  for i:=0 to boardsize-1 do path[i]:=0;
  getpath(point(1, boardsize div 2 +1),path);
  screen.cursor:=crDefault;
  label1.caption:=inttostr(pathstried);
  secs:=secsPerDay*(now-starttime);
  if secs>0 then label2.caption :=inttostr(trunc(pathstried / secs));
  UpdatePathDisplay;
end;



Procedure TForm1.getpath(p:TPoint; pathin:TPath);
{recursive calls to trace all  paths through the board}
var
  i,j:integer;
  secs:real;
  pathout:TPath;
  Begin
    setlength(pathout,length(pathin));
    for i:= 0 to boardsize-1 do pathout[i]:=pathin[i];
    with p, stringgrid1 do
    Begin
      pathout[x-1]:=board[x,y];
      if animatebtn.tag>0 then  {if showing paths}
      Begin
        If y>=1 then
        Begin
          stringgrid1.tag:=1;
          cells[x-1,y-1]:=cells[x-1,y-1]; {color in the cell we're checking}
          stringgrid1.update;
          sleep(500)
        end;

        {if not at right edge,  check path northeast}
        if (x<boardsize) and (board[p.x+1,p.y-1]>0) then getpath(point(x+1,y-1),pathout);
        {check path east}
        if (x<boardsize) and (board[p.x+1,p.y]>0) then getpath(point(x+1,y),pathout);
        {check path southeast}
        if (x<boardsize) and (board[p.x+1,p.y+1]>0) then getpath(point(x+1,y+1),pathout);
        {path complete - erase current cell}
        if y>=1 then
        with stringgrid1 do
        Begin
          tag:=0;
          cells[x-1,y-1]:=cells[x-1,y-1];
          stringgrid1.update;
          sleep(500);
        end;
        application.processmessages;
      end
      else
      {***********************}
      Begin {no animations}
        if (x<boardsize) and (board[x+1,y-1]>0) then getpath(point(x+1,y-1),pathout); {recusive call NorthEast}
        if (x<boardsize) and (board[x+1,y]>0) then getpath(point(x+1,y),pathout); {recursive call East}
        if (x<boardsize) and (board[x+1,y+1]>0) then getpath(point(x+1,y+1),pathout); {recursive call SouthEast}
      end;

      if (animatebtn.tag>0) or (pathstried mod updatedisplay =0)
      {update display once in a while}
      then
      Begin
        label1.caption:=inttostr(pathstried);
        secs:=SecsPerDay*(now-starttime);
        if secs>0 then label2.caption :=inttostr(trunc(pathstried / secs));
        application.processmessages;
      End;
    end;
    If p.x=boardsize then
    {we're at the end, so calculate max and min path values}
    begin
      inc(pathstried);
      {sum path in pathout[boardsize]}
      {positions 0 and boardsize-1 are 999, so skip them}
      pathout[boardsize]:=pathout[1];
      for i:=2 to boardsize-2 do
          pathout[boardsize]:=pathout[boardsize]+pathout[i];
      if pathout[boardsize] > globalmaxpath[boardsize]
      then Begin globalmaxpath:=pathout; UpdatePathDisplay; End
      else
      if pathout[boardsize] < globalminpath[boardsize]
      then Begin globalminpath:=pathout; UpdatePathDisplay; End;
    end;
  end;

Procedure Tform1.UpdatePathDisplay;
  var
    s1,s2:string;
    i:integer;
  Begin
    s1:='';
    s2:='';
    for i:= 1 to boardsize-2 do
    Begin
      s1:=s1+' '+inttostr(Globalmaxpath[i]);
      s2:=s2+' '+inttostr(Globalminpath[i]);
    end;
    Label3.caption:=s1+', Sum='+inttostr(Globalmaxpath[boardsize]);
    Label4.caption:=s2+', Sum='+inttostr(Globalminpath[boardsize]);
    application.processmessages;
  end;

Procedure TForm1.resetlabels;
  Begin
    label1.caption:='';
    label2.caption:='';
    label3.caption:='';
    label4.caption:='';
  end;

procedure TForm1.FormCreate(Sender: TObject);
{at create time}
begin
  randomize;
  updatedisplay:=1000;
  generateboard;
end;

procedure TForm1.AnimateBtnClick(Sender: TObject);
{User clicked to start or stop showing moves}
begin
  If animatebtn.tag=0 then
  Begin
    animatebtn.tag:=1;
    Updatedisplay:=100;
    Animatebtn.caption:='Stop showing paths';
  End
  else
  Begin
    animatebtn.tag:=0;
    UpdateDisplay:=1000;
    Animatebtn.caption:='Show paths as tested';
  End;
  application.processmessages;
end;

procedure TForm1.generateBoard;
{generate a board with boardsize rows and columns}
var
  i,j,k:integer;
  start,endx:integer;
begin
  if boardsize mod 2 = 0 then inc(boardsize); {make sure size is odd}
  with stringgrid1 do
  Begin
    rowcount:=boardsize;
    colcount:=boardsize;
  end;
  setlength(Globalmaxpath,boardsize+1);
  setlength(Globalminpath,boardsize+1);
  setlength(board,boardsize+2,boardsize+2);
  for i:=0 to boardsize+1 do
  for j:= 0 to boardsize+1 do board[i,j]:=0;

  for i:= 1 to boardsize do
  Begin
    if i<=boardsize div 2 + 1 then
    Begin
      start:=(boardsize+1) div 2 - i + 1;
      endx:=start+2*i-2;
    end
    else
    Begin
      k:=boardsize+1-i;
      start:=(boardsize+1) div 2 - k +1;
      endx:=start+2*k-2;
    end;
    for j:=start to endx do board[i,j]:=random(24)+1;
  end;
  {Set 999 as flag for start & end}
  board[1,(boardsize+1) div 2]:=999;
  board[boardsize,(boardsize+1) div 2]:=999;
  {load up the stringgrid display}
  For i:= 1 to boardsize do
  For j:=1 to boardsize do
        StringGrid1.Cells[i-1,j-1]:=Format('%2.2D',[Board[i,j]]);
end;

procedure TForm1.GenerateBtnClick(Sender: TObject);
{Generate a random board}
begin
  Resetlabels;
  boardsize:=random(11)+4; {size from 4 to 13}
  GenerateBoard;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
{draw cells that have changed}
  var
    s:string;
begin
  with Sender as TDrawGrid, canvas do
  Begin
    s:=stringgrid1.cells[acol,arow];
    If tag=0 then brush.Color := clwhite {no animation}
    else brush.color:=clred; {animation}
    FillRect(Rect);
    if (s<>'00') and (s<>'999')
    then Textout(rect.left+2, rect.top+2,s)   {only draw the non-zero cells}
    else if (s='999') then  {fill in start and finish cells}
    begin
      if acol=0 then Textout(rect.left+2,rect.top+2,'S')
      else if acol=boardsize-1 then Textout(rect.left+2,rect.top+2,'F')
    end;
  end;
end;

end.