Autor |
Beitrag |
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Do 03.03.16 12:53
Moin,
eine Superdame(Amazone) vereinigt die Dame und den Springer in einer Figur.
Wie beim N-Damen-Problem werden N Amazonen so auf einem NxN-Schachbrett verteilt,
dass sie sich gegenseitig nicht schlagen können.
Wer nur die erste Stellung haben möchte kann dies auswählen,
ebenso können alle Stellungen gespeichert und in echte Stellungen aussortiert werden.
Bei großen Werten für die Anzahl der Damen gibt es die Möglichkeit
die Suche mit <ESC> abzubrechen.
An der Geschwindigkeit der Suchroutine läßt sich bestimmt noch einiges
verbessern, da hoffe ich auf Horst_H
Viel Spaß beim Testen
Gruß Fiete
Edit1: eine verbesserte Version liegt vor, nach Ideen von Horst_H
statt 3,78s jetzt 0,91s
eine Auswertung ist hier oprisch.net/SuperQueens/SuperQueens.html
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
Zuletzt bearbeitet von Fiete am So 19.06.16 14:36, insgesamt 2-mal bearbeitet
Für diesen Beitrag haben gedankt: Mathematiker
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: So 05.06.16 10:24
Hallo,
hab ich ja noch gar nicht gesehen....
Ich habe es mir jetzt nicht in die Tiefe gehend angesehen.Bei mir ( i3 4330 3,5 Ghz ) braucht 13-Damen 5.5 Sekunden unter wine.Vielleicht ist Memo wieder extra langsam...
Das n-Damen Problem sehr schnell zu lösen ist:
rosettacode.org/wiki..._problem#Alternative bei 13 dauert es 0.1 Sekunden für 73712 Lösungen.
Mein Gedanke. n-Damen lösen und dann nur noch auf Verstoß gegen Super-Dame testen. Das müsste doch was bringen.
Gruß Horst
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Fr 10.06.16 13:51
Moin Horst,
werde Deine Idee mal aufgreifen und testen.
Kann aber etwas dauern.(EM und Beale - Chiffre)
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Mo 13.06.16 14:51
Moin Horst,
habe Deine Idee mal getestet, Ergebnis im Anhang.
Die alte Setz-Prozedur habe ich modifiziert(Anweisungen auskommentiert):
Hier die neue
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55:
| procedure TAmazone.Setz(S:Integer); var Z,K:Integer; F:TBrett; ZNeu,SNeu:Integer; begin for Z:=1 to BG do if Brett[Z,S]=0 then begin F:=Brett; for K:=S+1 to BG do Brett[Z,K]:=Gesperrt; for K:=1 to 2 do begin ZNeu:=Z+RY[K];SNeu:=S+RX[K]; while Erlaubt(ZNeu,SNeu) do begin Brett[ZNeu,SNeu]:=Gesperrt; SNeu:=SNeu+RX[K];ZNeu:=ZNeu+RY[K]; end end; for K:=1 to 8 do begin ZNeu:=Z+WA[K];SNeu:=S+SE[K]; if Erlaubt(ZNeu,SNeu) then Brett[ZNeu,SNeu]:=Gesperrt; end; Brett[Z,S]:=SpringerDame; if S<BG then Setz(S+1) else begin inc(N); if Zeigen.Checked then begin Ausgabe(N,Brett,0); if not Vorhanden(Brett) then begin inc(SN);Ausgabe(SN,Brett,1); end; end; end; Brett:=F; if (N>0) and STerste.Checked then exit end end; |
Für N=16 erhalte ich 202.900 Lösungen in 8,11s
Die N-Damenvariante bei der jede Lösung auf Springerverträglichkeit getestet wird ist zu langsam(82,45s),
von 14.772.512 Lösungen sind nur noch 202.900 zulässig!
Gruß Fiete
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 14.06.16 16:56
Hallo,
ich bekomme Deine Zeiten mit Deinem Programm auch bei verändertem TAmazone.Setz(S:Integer) nicht hin. ( 550 Sekunden für 16 ???? mit Lazarus 1.6 für win32 )
Ich habe mein Programm mal geändert.
Wie bei n-Damen wird für jede Zeile eine freie Spalte gewählt und diesmal aber auch getestet, ob in Zeile davor eine Spalte im Abstand 2 oder zwei Zeilen davor eine Amazone in Abstand von einer Spalte steht.
Es ist etwas getrickst.nmax = 17, aber nur bis 16 gerechnet sonst ist das Ergebnis falsch! 198??? statt 202900.
Aber das in 1.12 Sekunden ist ja auch nicht schlecht
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127:
| program Amazone; {$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON} {$ELSE} {$Apptype console} {$ENDIF}
uses sysutils;const nmax = 17; type {$IFNDEF FPC} NativeInt = longInt; {$ENDIF} tLR_diagonale = array[-nmax-1..nmax-1] of char; tRL_diagonale = array[0..2*nmax-2] of char; tFreeCol = array[-2..nmax] of NativeInt; var LR_diagonale:tLR_diagonale; RL_diagonale:tRL_diagonale; pLR,pRL : pChar; FreeCol : tFreeCol; i, n : nativeInt; gblCount : nativeUInt; T0,T1 : TdateTime;
procedure Solution; var i : NativeInt; begin If gblCount AND $FFF = 0 then write(gblCount:10,#8#8#8#8#8#8#8#8#8#8); IF n < 0 then begin For i := 1 to n do write(FreeCol[i]:4); writeln; end; end;
procedure SetAmazone(Row:nativeInt); var i,Col : nativeInt; begin IF row <= n then begin For i := row to n do begin Col := FreeCol[i]; If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then IF (Abs(FreeCol[row-1]-col)<>2) AND (Abs(FreeCol[row-2]-col)<>1) then Begin pRL[ Col]:=#0; pLR[-Col]:=#0; FreeCol[i] := FreeCol[Row]; FreeCol[Row] := Col; inc(pRL); inc(pLR); SetAmazone(Row+1); dec(pLR); dec(pRL); FreeCol[Row] := FreeCol[i]; FreeCol[i] := Col; pRL[ Col]:=#1; pLR[-Col]:=#1; end; end; end else begin inc(gblCount); end; end;
begin FreeCol[-2] := High(FreeCol[0]); FreeCol[-1] := High(FreeCol[0]); FreeCol[0] := High(FreeCol[0]); For i := 1 to nmax do FreeCol[i] := i; FreeCol[nmax+1] := High(FreeCol[0]); fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1); fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1); For n := 1 to nMax-1 do begin t0 := time; pLR:=@LR_Diagonale[0]; pRL:=@RL_Diagonale[0]; gblCount := 0; SetAmazone(1); t1:= time; WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs'); end; WriteLn('Fertig'); end. |
Gruß Horst
Edit:
Leicht modifizierter Test auf Rösselsprung, indem ich 2 Spalten davor zusätzlich eingeführt habe.
Für diesen Beitrag haben gedankt: Fiete
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Sa 18.06.16 17:43
Moin Horst,
ein Lob an den Tüftler
Die Abfrage vor dem Setzen einzubauen war super anstatt erst eine Stellung zu erzeugen und dann zu testen
Das falsche Ergebnis 198??? statt 202900 lässt sich vielleicht ermitteln, setze mal die Compilerschalter {$R+,Q+}
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
|