Möchte man das Einsteinrätsel mithilfe des PCs lösen braucht man zum einen dieses Programm und zum zweiten viiiiiiiiiiiiiiiiiiiiiiel zeit

[code:1]
EinsteinMatrix = array[1..5,1..5] of 0..5;
AusgabeMatrix = array[1..5,1..5] of string;
var
Form1: TForm1;
B: EinsteinMatrix;
AusgText: AusgabeMatrix;


implementation

{$R *.dfm}


function TextEig(Eigensch, Zuordn: integer):string;
begin
case Eigensch of
1: Case Zuordn of
1: TextEig:='rot';
2: TextEig:='weiß';
3: TextEig:='grün';
4: TextEig:='gelb';
5: TextEig:='blau';
end;
2: Case Zuordn of
1: TextEig:='Deutscher';
2: TextEig:='Norweger';
3: TextEig:='Däne';
4: TextEig:='Schwede';
5: TextEig:='Brite';
end;
3: Case Zuordn of
1: TextEig:='Pall Mall';
2: TextEig:='Rothmans';
3: TextEig:='Winfield';
4: TextEig:='Marlboro';
5: TextEig:='Dunhill';
end;
4: Case Zuordn of
1: TextEig:='Wasser';
2: TextEig:='Milch';
3: TextEig:='Bier';
4: TextEig:='Kaffee';
5: TextEig:='Tee';
end;
5: Case Zuordn of
1: TextEig:='Pferd';
2: TextEig:='Fisch';
3: TextEig:='Vogel';
4: TextEig:='Katze';
5: TextEig:='Hund';
end;
end;
end;


function PermTest(B: EinsteinMatrix):boolean;
var i,j,m: integer;
ok: boolean;
begin
ok:=true;
m:=0;
repeat
m:=m+1;
i:=0;
repeat
i:=i+1;
j:=i;
repeat
j:=j+1;
if B[m,i]=B[m,j] then
ok:=false;
until (j=5) or not(ok);
until (i=5) or not(ok);
until (m=5) or not(ok);
PermTest:=ok;
end;


function BriteBewohntRotHaus(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
BriteBewohntRotHaus:=false;
for HausNr:=1 to 5 do
if (B[2,HausNr]=5) and (B[1,HausNr]=1) then
BriteBewohntRotHaus:=true;
end;


function SchwedeBesitztHund(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
SchwedeBesitztHund:=false;
for HausNr:=1 to 5 do
if (B[2,HausNr]=4) and (B[5,HausNr]=5) then
SchwedeBesitztHund:=true;
end;


function DaeneTrinktTee(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
DaeneTrinktTee:=false;
for HausNr:=1 to 5 do
if (B[2,HausNr]=3) and (B[4,HausNr]=5) then
DaeneTrinktTee:=true;
end;


function ImGruenenHausKaffee(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
ImGruenenHausKaffee:=false;
for HausNr:=1 to 5 do
if (B[1,HausNr]=3) and (B[4,HausNr]=4) then
ImGruenenHausKaffee:=true;
end;


function PallMallBesitztVogel(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
PallMallBesitztVogel:=false;
for HausNr:=1 to 5 do
if (B[3,HausNr]=1) and (B[5,HausNr]=3) then
PallMallBesitztVogel:=true;
end;


function ImGelbenHausDunhill(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
ImGelbenHausDunhill:=false;
for HausNr:=1 to 5 do
if (B[1,HausNr]=4) and (B[3,HausNr]=5) then
ImGelbenHausDunhill:=true;
end;


function WinfieldTrinktBier(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
WinfieldTrinktBier:=false;
for HausNr:=1 to 5 do
if (B[3,HausNr]=3) and (B[4,HausNr]=3) then
WinfieldTrinktBier:=true;
end;


function DeutscherRauchtRothmans(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
DeutscherRauchtRothmans:=false;
for HausNr:=1 to 5 do
if (B[2,HausNr]=1) and (B[3,HausNr]=2) then
DeutscherRauchtRothmans:=true;
end;


function MittlererTrinktMilch(B:EinsteinMatrix):boolean;
begin
MittlererTrinktMilch:=false;
if (B[4,3]=2) then
MittlererTrinktMilch:=true;
end;


function ErstesHausNorweger(B:EinsteinMatrix):boolean;
begin
ErstesHausNorweger:=false;
if (B[2,1]=2) then
ErstesHausNorweger:=true;
end;


function GruenLinksVonWeiss(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
GruenLinksVonWeiss:=false;
for HausNr:=1 to 4 do
if (B[1,HausNr]=3) and (B[1,HausNr+1]=2) then
GruenLinksVonWeiss:=true;
end;


function MarlboroNebenKatze(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
MarlboroNebenKatze:=false;
for HausNr:=1 to 4 do
if ((B[3,HausNr]=4) and (B[5,HausNr+1]=4))
or ((B[5,HausNr]=4) and (B[3,HausNr+1]=4)) then
MarlboroNebenKatze:=true;
end;


function PferdNebenDunhill(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
PferdNebenDunhill:=false;
for HausNr:=1 to 4 do
if ((B[5,HausNr]=1) and (B[3,HausNr+1]=4))
or ((B[3,HausNr]=4) and (B[5,HausNr+1]=1)) then
PferdNebenDunhill:=true;
end;


function NorwegerNebenBlauemHaus(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
NorwegerNebenBlauemHaus:=false;
for HausNr:=1 to 4 do
if ((B[2,HausNr]=2) and (B[1,HausNr+1]=5))
or ((B[1,HausNr]=5) and (B[2,HausNr+1]=2)) then
NorwegerNebenBlauemHaus:=true;
end;


function MarlboroNebenWasser(B:EinsteinMatrix):boolean;
var HausNr: integer;
begin
MarlboroNebenWasser:=false;
for HausNr:=1 to 4 do
if ((B[3,HausNr]=4) and (B[4,HausNr+1]=1))
or ((B[4,HausNr]=1) and (B[3,HausNr+1]=4)) then
MarlboroNebenWasser:=true;
end;


function EinsteinTest(B:EinsteinMatrix):boolean;
begin
EinsteinTest:=false;
if PermTest(B) then
if BriteBewohntRotHaus(B) then
if SchwedeBesitztHund(B) then
if DaeneTrinktTee(B) then
if ImGruenenHausKaffee(B) then
if PallMallBesitztVogel(B) then
if ImGelbenHausDunhill(B) then
if WinfieldTrinktBier(B) then
if DeutscherRauchtRothmans(B) then
if MittlererTrinktMilch(B) then
if ErstesHausNorweger(B) then
if GruenLinksVonWeiss(B) then
if MarlboroNebenKatze(B) then
if PferdNebenDunhill(B) then
if NorwegerNebenBlauemHaus(B) then
if MarlboroNebenWasser(B) then
EinsteinTest:=true;
end;


procedure Suche(var Ausg:AusgabeMatrix);
var ok: boolean;
i,j: integer;
z,pos: real;
begin
z:=0;
pos:=0;
B[1,1]:=0; //B[Eigensch,Hausnr] //Farbe
repeat
B[1,1]:=B[1,1]+1;
B[1,2]:=0;
repeat
B[1,2]:=B[1,2]+1;
B[1,3]:=0;
repeat
B[1,3]:=B[1,3]+1;
B[1,4]:=0;
repeat
B[1,4]:=B[1,4]+1;
B[1,5]:=0;
repeat
B[1,5]:=B[1,5]+1;
B[2,1]:=0; //Nation
repeat
B[2,1]:=B[2,1]+1;
B[2,2]:=0;
repeat
B[2,2]:=B[2,2]+1;
B[2,3]:=0;
repeat
B[2,3]:=B[2,3]+1;
B[2,4]:=0;
repeat
B[2,4]:=B[2,4]+1;
B[2,5]:=0;
repeat
B[2,5]:=B[2,5]+1;
B[3,1]:=0; //Zigaretten
repeat
B[3,1]:=B[3,1]+1;
B[3,2]:=0;
repeat
B[3,2]:=B[3,2]+1;
B[3,3]:=0;
repeat
B[3,3]:=B[3,3]+1;
B[3,4]:=0;
repeat
B[3,4]:=B[3,4]+1;
B[3,5]:=0;
repeat
B[3,5]:=B[3,5]+1;
B[4,1]:=0; //Getränk
repeat
B[4,1]:=B[4,1]+1;
B[4,2]:=0;
repeat
B[4,2]:=B[4,2]+1;
B[4,3]:=0;
repeat
B[4,3]:=B[4,3]+1;
B[4,4]:=0;
repeat
B[4,4]:=B[4,4]+1;
B[4,5]:=0;
repeat
B[4,5]:=B[4,5]+1;
B[5,1]:=0; //Tier
repeat
B[5,1]:=B[5,1]+1;
B[5,2]:=0;
repeat
B[5,2]:=B[5,2]+1;
B[5,3]:=0;
repeat
B[5,3]:=B[5,3]+1;
B[5,4]:=0;
repeat
B[5,4]:=B[5,4]+1;
B[5,5]:=0;
repeat
B[5,5]:=B[5,5]+1;
z:=z+1;
pos:=pos+1;
if pos>=2E+9 then
begin
Form1.edit1.text:=floattostr(z);
showmessage('Zwischen-Stopp');
pos:=0;
end;
ok:=EinsteinTest(B);
until (B[5,5]=5) or ok;
until (B[5,4]=5) or ok;
until (B[5,3]=5) or ok;
until (B[5,2]=5) or ok;
until (B[5,1]=5) or ok;
until (B[4,5]=5) or ok;
until (B[4,4]=5) or ok;
until (B[4,3]=5) or ok;
until (B[4,2]=5) or ok;
until (B[4,1]=5) or ok;
until (B[3,5]=5) or ok;
until (B[3,4]=5) or ok;
until (B[3,3]=5) or ok;
until (B[3,2]=5) or ok;
until (B[3,1]=5) or ok;
until (B[2,5]=5) or ok;
until (B[2,4]=5) or ok;
until (B[2,3]=5) or ok;
until (B[2,2]=5) or ok;
until (B[2,1]=5) or ok;
until (B[1,5]=5) or ok;
until (B[1,4]=5) or ok;
until (B[1,3]=5) or ok;
until (B[1,2]=5) or ok;
until (B[1,1]=5) or ok;
for i:=1 to 5 do //Zuordnung der Eigenschaften
for j:=1 to 5 do
Ausg[i,j]:=TextEig(i,B[i,j]);
end;


procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
//showmessage('Punkt 1');
Suche(AusgText);
for i:=0 to 4 do
Form1.StringGrid1.cells[i,0]:=inttostr(i+1);
for i:=0 to 4 do
for j:=0 to 4 do
Form1.StringGrid1.cells[i,j]:=AusgText[j,i];
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

end.

[/code:1]