unit Unit1; { logigram puzzle solving note : rating goes up from 1(lowest) to 10(highest) } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, Buttons, shellapi, ExtCtrls; type TForm1 = class(TForm) BitBtn1: TBitBtn; BitBtn2: TBitBtn; StaticText1: TStaticText; StringGrid1: TStringGrid; Image1: TImage; procedure FormCreate(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure Image1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} type Tstring5 = array[0..4] of string; Tactivity = record row : byte; //place in table column : byte; end; const Spersons : Tstring5 = //contents of fields in table ('mary','william','peter','ann','rose'); Ssubjects : Tstring5 = ('language','math','geology','history','biology'); Stasks : Tstring5 = ('homework','examination','test','scription','paper'); Sscores : Tstring5 = ('3','5','6','7','9'); homework : Tactivity = (row:0; column:1); //place in table examination : Tactivity = (row:1; column:1); test : Tactivity = (row:2; column:1); scription : Tactivity = (row:3; column:1); paper : Tactivity = (row:4; column:1); language : Tactivity = (row:0; column:2); math : Tactivity = (row:1; column:2); geology : Tactivity = (row:2; column:2); history : Tactivity = (row:3; column:2); biology : Tactivity = (row:4; column:2); mary = 0; //place in column william = 1; peter = 2; ann = 3; rose = 4; var permutNr : array[1..3] of byte; //hold permutation-index of columns permuts : array[0..4,0..119] of byte; solution : byte; //nummer van de oplossing procedure makepermutations; //make all permutations in array permuts[0..4,0..119] const delers : array[0..3] of byte = (24,6,2,1); var i,j,k,rest,quot : byte; pel : array[0..4] of byte; //pel : permutation of elements 01234 begin for j := 0 to 119 do begin for i := 0 to 4 do pel[i] := i;//set permutation 0 = 01234 rest := j; for i := 0 to 3 do begin //make permutation j quot := rest div delers[i]; rest:= rest mod delers[i]; permuts[i,j] := pel[quot]; for k := quot to 3 do pel[k] := pel[k+1]; //shift elements down pel[4] := 0; end; permuts[4,j] := pel[0];//left over number end;//for j end; procedure setCells; //fill table according to permtNr[1..3] var i,j,k : byte; begin k := 0; with form1.stringgrid1 do for i := 0 to 3 do //columns begin if i <> 0 then k := permutNr[i]; for j := 0 to 4 do //rijen case i of 0 : cells[i,j] := Spersons[j]; 1 : cells[i,j] := Stasks[permuts[j,k]]; 2 : cells[i,j] := Ssubjects[permuts[j,k]]; 3 : cells[i,j] := Sscores[permuts[j,k]]; end;//case end; end; procedure setInitial; var i : byte; begin for i := 1 to 3 do permutNr[i] := 0; setCells; form1.statictext1.caption := 'initial'; solution := 0; end; function rating(n : byte) : byte; //n: 0..4 //find rating in row n var k : byte; begin k := permuts[n,permutNr[3]]; result := strtoint(Sscores[k]); end; function person(a : Tactivity) : byte; //find person of activity a var i,kolom,rij,k : byte; begin result := 0; kolom := a.column; rij := a.row; //--search row nr in column k := permutNr[kolom]; for i := 0 to 4 do if permuts[i,k] = rij then result := i end; function checkOK : boolean; //test of aan voorwaarden is voldaan begin result := (rating(person(scription)) > rating(person(math))) and //1a (rating(person(scription)) < rating(rose)) and //1b (person(math) <> rose) and //1c (person(homework) <> peter) and //2a (rating(peter) > rating(ann)) and //2b (person(examination) <> peter) and //2c (rating(peter) < rating(person(history))) and //2d (rating(peter) <> rating(person(examination)) + 6) and //2e (rating(peter) <> rating(person(examination)) + 4) and //2f (rating(person(examination)) + 6 <= 9) and //2g (rating(person(test)) > rating(mary)) and //3a (person(language) <> mary) and //3b (rating(person(test)) < rating(person(biology))) and //3c (person(test)<>william) and (person(test)<>peter) and //3d (william = person(geology)) and //4a (rating(william) > rating(person(language))) and //4b (rating(william) < rating(person(paper))) //4c end; procedure TForm1.FormCreate(Sender: TObject); begin makepermutations; SetInitial; end; function Increment : boolean; //increment counter permutNr[1..3] var carry : boolean; i : byte; begin carry := true; for i := 1 to 3 do begin if carry then inc(permutNr[i]); if permutNr[i] = 120 then permutNr[i] := 0 else carry := false; end;//for result := carry; end; procedure TForm1.BitBtn2Click(Sender: TObject); //solve begin; statictext1.caption := 'computer searching...'; repeat if checkOK then begin inc(solution); statictext1.caption := 'found solution'+' : '+inttostr(solution); setCells; increment; exit; end; until increment;//until overflow statictext1.caption := 'end'; setInitial; end; procedure TForm1.BitBtn1Click(Sender: TObject); //initialize begin setInitial; end; procedure TForm1.Image1Click(Sender: TObject); //davdata website link begin ShellExecute(0,'open','http://www.davdata.nl/math/logipuzzle.html', nil, nil, SW_SHOWNORMAL); end; end.