unit U_MIssionaries;
{Copyright  © 2004, Gary Darby,  www.DelphiForFun.org

{
A River Crossing Puzzle

Three cannibals and three missionaries need to cross
from the left bank to the right bank of a river.  There is a
boat that will only carry a maximum of two persons at a
time.   The cannibals and the missionaries share a
comon goal of reaching the village, so any member of
the party will cooperate by piloting the boat as
necessary.

However,  if there is ever a situation where the cannibals
outnuimber the missionaries on either bank, their
natural tendencies will take over and the outnumbered
missionaries will be eaten!

Can you figure out how to get them all cross?  Click
"Who is in the boat? " box to make each move.
}

interface

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

type
TForm1 = class(TForm)
    SolveBtn: TButton;
    MoveList: TListBox;
    MoveGrp: TRadioGroup;
    SolutionsGrp: TRadioGroup;
    StaticText1: TStaticText;
    CLearMovesBtn: TButton;
    UndoBtn: TButton;
    Panel1: TPanel;
    Memo1: TMemo;
procedure SolveBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MoveGrpClick(Sender: TObject);
procedure SolutionsGrpClick(Sender: TObject);
procedure CLearMovesBtnClick(Sender: TObject);
procedure UndoBtnClick(Sender: TObject);
procedure StaticText1Click(Sender: TObject);

public
{ Public declarations }
valids:array of tPoint;
    visited:array[0..3,0..3,false..true] of boolean;
    savedsolutions:array of TStringlist;

function solvefrom(p:TPoint):boolean;
function  validmove(ix,iy:Integer;movestr:string):boolean;
procedure setlists;
end;

var  Form1: TForm1;

implementation

{$R *.DFM}

{************ FormCreate ************}
procedure TForm1.FormCreate(Sender: TObject);
var
c,m:integer;
  validcount:integer;
begin
{set up array of valid positions}
setlength(valids,50);
  validCount:=0;
for c:=0 to 3 do {for all #s of cannibals}
for m:=0 to 3 do {and all #s of missionaries}
if ((c<=m) and (3-c<=3-m)) {#of cannibals in each side must be <= # missionaries}
or (m=0) or (m=3) {unless there are 0 missionaries}
then
begin
valids[validcount].x:=c;
    valids[validcount].y:=m;
    inc(validcount);
end;
  setlength(valids,validcount);
  setlists;
end;

{************** ValidMove ************}
function  TForm1.validmove(ix,iy:Integer; movestr:string):boolean;
{validate manual move and make move if OK}
var i:integer;
      boatleft:boolean;
      C,M:integer;
      BoatmsgL, BoatmsgR:string;
begin
{boat is on left bank for odd nuimbered moves}
boatleft:=(movelist.items.count div 2) mod 2 =1;
{Reconstruct where people are by extract quasi object (an integer actually)
     from latest move line}
with movelist.items do
if boatleft then
begin
C:=integer(objects[count-1]) div 10 - ix;
      M:=integer(objects[count-1]) mod 10 - iy;
end
else
begin
C:=integer(objects[count-1]) div 10 + ix;
      M:=integer(objects[count-1]) mod 10 + iy;
end;

    result:=false;
{valid range?}
if (C<0) or (M<0) or (C>3) or (M>3)
then
begin
showmessage('You can''t make that move - not enough of those types on boat side of the river');
      exit; {no - get out}
end;

{setup boat position messages}
if boatleft then
begin
boatmsgL:='              ';
      boatmsgR:=', Boat      ';
end
else
begin
boatmsgR:='              ';
      boatmsgL:=', Boat     ';
end;
if boatleft then movestr:=movestr + '==>'
else movestr:='<==' + movestr;
{add move info to movelist}
movelist.items.add('                         '+ movestr);
{add line with status after the move}
{Note "trick" of adding # of cannibals and missionaries on left bank as
     an object by casting integer 10Px+py as an object}
movelist.items.addobject(inttostr(C)+'C, '+inttostr(M)+'M '+boatmsgL
                       +'                  '+inttostr(3-C)+'C, '
+inttostr(3-M)+'M '+boatmsgR, TObject(10*C+M) );
{is it in the valid moves list?}
for i:=0 to high(valids) do
begin
if (valids[i].x=C) and (valids[i].y=M) then
begin
result:=true;
        break;
end;
end;
if result then
begin  {we can make this move}
{If nobody on left bank, we're done!}
If 10*C+M=0 then showmessage('We have a winner!!!');
end
else
begin
showmessage('Yum, yum -- that missionary sure tasted good!  You lose!');
      setlists;
end;
end;

{************ SolveFrom ***********}
function TForm1.SolveFrom(p:TPoint):boolean;
{recursive routine to try all moves from state "p"}

function  validautomove(px,py:Integer;movestr:string):boolean;
var i:integer;
        boatleft:boolean;
        BoatmsgL, BoatmsgR:string;
begin
boatleft:=(movelist.items.count div 2) mod 2 =1;
      result:=false;
{valid range?}
if (px<0) or (py<0) or (px>3) or (py>3)
then exit; {no - get out}
{is it in the valid moves list?}
for i:=0 to high(valids) do
begin
if (valids[i].x=px) and (valids[i].y=py) then
begin
result:=true;
          break;
end;
end;
{if so, have we been here before?}
if result and visited[px,py,not boatleft] then result:=false;
if result then
begin  {we can try this move}
{setup boat position messages}
if boatleft then
begin
boatmsgL:='              ';
          boatmsgR:=', Boat      ';
end
else
begin
boatmsgR:='              ';
          boatmsgL:=', Boat     ';
end;
{add move info to movelist}
movelist.items.add('                         '+ movestr);
        movelist.items.addobject(inttostr(px)+'C, '+inttostr(py)+'M '+boatmsgL
                           +'                  '+inttostr(3-px)+'C, '
+inttostr(3-py)+'M '+boatmsgR, TObject(10*px+py) );
{mark new state as visited - boat would be on the opposite bank}
visited[px,pY,not boatleft]:=true;
        result:=solvefrom(point(px,py)); {recursive call to solve (depth first search)}
if not result then
begin   {backtracking -remove list entries and visited flag}
movelist.items.delete(movelist.items.count-1);
           movelist.items.delete(movelist.items.count-1);
           visited[px,pY, not boatleft]:=false;
end;
end;
end;


var
n:integer;
  boatleft:boolean;
begin  {solvefrom}
if (p.x=0) and (p.y=0)
then {solved!}
begin
result:=false{true}; {true will stop after 1st solution is found}
n:=length(savedsolutions);
    setlength(savedsolutions,n+1);
    savedsolutions[n]:=TStringlist.create;
    savedsolutions[n].assign(movelist.items);
end
else
begin
boatleft:=(movelist.items.count div 2) mod 2 =1;
if boatleft then
begin
{move 1 missionary right?}
result:=validautomove(p.x,p.y-1,'M==>');
{move 2 missionaries right?}
if not result then result:=validautomove(p.x,p.y-2,'MM==>');
{move 1 cannibal  right?}
if not result then result:=validautomove(p.x-1,p.y,'C==>');
{move 2 cannibals right?}
if not result then result:=validautomove(p.x-2,p.y,'CC==>');
{move 1 of each  right?}
if not result then result:=validautomove(p.x-1,p.y-1,'CM==>');
end
else
begin
{move 1 missionary left?}
result:=validautomove(p.x,p.y+1,'<==M');
{move 2 missionaries left?}
if not result then result:=validautomove(p.x,p.y+2,'<==MM');
{move 1 cannibal  left?}
if not result then result:=validautomove(p.x+1,p.y,'<==C');
{move 2 cannibals  left?}
if not result then result:=validautomove(p.x+2,p.y,'<==CC');
{move 1 of each  left?}
if not result then result:=validautomove(p.x+1,p.y+1,'<==CM');
end;
end;
end;

{*********** SetLists ************}
procedure TForm1.setlists;
{Reset the lists}
var
c,m,i:integer;
begin
for c:=0 to 3 do
for m:=0 to 3 do
begin
visited[c,m,false]:=false;
    visited[c,m,true]:=false;
end;
  visited[3,3,true]:=true;
  MoveList.items.clear;
  Movelist.items.add(' Left Bank                            Right Bank');
  Movelist.items.addobject('3C, 3M, Boat  '
+  '                      0C, 0M',TObject(33));
for i:=0 to high(savedsolutions) do savedsolutions[i].free;
  setlength(savedsolutions,0);
  solvebtn.visible:=true;
  Solutionsgrp.visible:=false;
end;

{********** SolveBtnClick ***********}
procedure TForm1.SolveBtnClick(Sender: TObject);
{search for solutions}
var i:integer;
begin
SetLists;
  Solvefrom(point(3,3));
if length(savedsolutions)>0 then
with solutionsgrp do
begin
items.clear;
for i:=1 to length(savedsolutions) do items.add('Solution '+inttostr(i));
    Solutionsgrp.visible:=true;
    solutionsgrp.itemindex:=0;
    solutionsgrpclick(sender);
end;
  solvebtn.visible:=false;
end;


{****************** MoveGrpClick ***********}
procedure TForm1.MoveGrpClick(Sender: TObject);
{Make a move in resposne to user click}
begin
if movegrp.itemindex=-1 then exit;
case Movegrp.itemindex of
0: validmove(1,0,'C');
    1: validmove(2,0,'CC');
    2: validmove(0,1,'M');
    3: validmove(0,2,'MM');
    4: validmove(1,1,'CM');
end;
  movegrp.itemindex:=-1;
end;

{*************** SolutionsGrpClick **********}
procedure TForm1.SolutionsGrpClick(Sender: TObject);
{Display a solution}
begin
Movelist.items.assign(savedsolutions[Solutionsgrp.itemindex]);
end;

{************* ClearMovesBtnClick ***********}
procedure TForm1.CLearMovesBtnClick(Sender: TObject);
begin  setlists; end;

{************ UndoBtnClick ***********}
procedure TForm1.UndoBtnClick(Sender: TObject);
{Take back the last move}
begin
if movelist.items.count>2 then
with movelist.items do
begin
delete(count-1);
    delete(count-1);
end;
end;

procedure TForm1.StaticText1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'http://www.delphiforfun.org/',
nil, nil, SW_SHOWNORMAL) ;
end;

end.