Autor |
Beitrag |
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Di 05.08.14 17:20
Das Programm löst das N-Damenproblem: de.wikipedia.org/wiki/Damenproblem
Die rekursive Lösung von Wirth habe ich iterativ umgeschrieben und dann in Assembler implementiert.
Delphi-Quelltext 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:
| procedure TNDamen.Iterativ; var X,Y,Xplus1:Byte; begin X:=NAnzahl.Value;Xplus1:=X+1;Y:=Xplus1; repeat repeat repeat dec(Y); until (Y=0) or ((Horizontal[Y]=0) and (Fallend[X+Y]=0) and (Steigend[Y-X+Xplus1]=0)); if Y>0 then begin Horizontal[Y]:=Y; Spalte[X]:=Y;Fallend[X+Y]:=Y; Steigend[Y-X+Xplus1]:=Y;dec(X);Y:=Xplus1 end until (X=0) or (Y=0); if Y>0 then inc(Anzahl); inc(X); if X<Xplus1 then begin Y:=Spalte[X];Horizontal[Y]:=0;Fallend[X+Y]:=0; Steigend[Y-X+Xplus1]:=0 end until X=Xplus1; end; |
In Assembler:
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:
| procedure TNDamen.Setzen; ASM PushAD // alle Register auf den Stapel Mov EBP, Offset Steigend // Startadresse von Steigend Mov ESI, Offset Fallend // Startadresse von Fallend Mov ECX, Offset Spalte // Startadresse von Spalte Mov EDI, Offset Horizontal // Startadresse von Horizontal Dec EBP // Startadresse-1 Dec ESI // Startadresse-1 Dec ECX // Startadresse-1 Dec EDI // Startadresse-1 Mov AL,M // AL:=M Y konstant Mov AH,N // AH:=N X konstant Mov BL,AH // BL:=N X variabel Mov BH,AL // BH:=M Y variabel Xor EDX,EDX // EDX:=0 @Start: Dec BH // Y:=Y-1 Jz @Unten // Y=0 ==> springe zu Label Unten Mov DL,BH // DL:=BH, Indexregister Cmp [EDI+EDX],DH // HO[Y]>0? Jg @Start // falls ja, zu Label Start Add DL,BL // X+Y Cmp[ESI+EDX],DH // FA[X+Y]>0? Jg @start // falls ja, zu Label Start Mov DL,AL // DL:=M Add DL,BH // DL:=M+Y Sub DL,BL // DL:=M+Y-X Cmp [EBP+EDX],DH // ST[M+Y-X]>0? Jg @Start // falls ja, zu Label Start Mov [EBP+EDX],BH // ST[M+Y-X]:=Y Mov DL,BL // DL:=X Mov [ECX+EDX],BH // SP[X]:=Y Mov DL,BH // DL:=Y Mov [EDI+EDX],BH // HO[Y]:=Y Add DL,BL // DL:=DL+X Mov [ESI+EDX],BH // FA[X+Y]:=Y Mov BH,AL // Y:=M Dec BL // X:=X-1 Jg @Start // falls X>0, zu Label Start Inc DWord Ptr[Anzahl] // Anzahl:=Anzahl+1 @Unten: Inc BL // X:=X+1 Cmp BL,AH // X>N Jg @Ende // falls ja, zu Label Ende Mov DL,BL // DL:=X Mov BH,[ECX+EDX] // Y:=SP[X] Mov DL,BH // DL:=Y Mov [EDI+EDX],DH // HO[Y]:=0 Add DL,BL // DL:=DL+X Mov [ESI+EDX],DH // FA[X+Y]:=0 Mov DL,AL // DL:=M Add DL,BH // DL:=M+Y Sub DL,BL // DL:=M+Y-X Mov [EBP+EDX],DH // ST[M+Y-X]:=0 Jmp @Start // springe zu Label Start @Ende: PopAD // alle Register vom Stapel end; |
Ein PAP ist in der ZIP-Datei enthalten.
Viel Spaß beim Testen
Fiete
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
Für diesen Beitrag haben gedankt: Mathematiker
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Di 05.08.14 19:42
Hallo Fiete,
und auch das 2.Programm ist sehr interessant. Insbesondere finde ich die Assemblerumsetzung gut. Die werde ich mir genauer ansehen.
Die Berechnung der möglichen Lösungen ist schnell. n = 15 in knapp 12 s ist ziemlich flott. Sehr schön.
Allerdings wird man wohl den von Dir vorgesehenen Maximalwert n = 20 kaum testen können. Als Ergebnis müssten 39029188884 Lösungen gefunden werden. Rechne ich das hoch, würde mein PC gute 56 Stunden im Dauerbetrieb sein.
Dennoch wäre es reizvoll, den Wert für evtl. n = 26 irgendwann zu ermitteln. Dieser liegt im Bereich von 9,4 Billiarden und ist (meines Wissens nach) noch nicht exakt berechnet worden. Mein PC würde "nur" etwa 1500 Jahre benötigen. Wird also wohl nichts werden.
Beste Grüße
Mathematiker
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mi 06.08.14 09:43
Hallo,
sooo schnell ist das dann aber nicht.
Ich habe rekursiv n= 15 in 5,6 s ( i 4330 - 3.5 Ghz) statt 9,61/10,44 s in der angegebenen Assembler/Delphi-Version.
www.entwickler-ecke....p=440863&view=df braucht bei mir
Quelltext 1: 2:
| 14 365596 00:00:00.889 15 2279184 00:00:05.632 |
Das liegt an der Suche des freien Wertes Y, den ich ja durch Tauschung kenne.
Aber dies liegt immer noch exorbitant weit vorn, dort geht n= 20 wohl heute in unter 1 Stunde.
www.ic-net.or.jp/home/takaken/e/queen/ daraus:
Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20:
| Version 3.2 (2-core) <------ N-Queens Solutions -----> <---- time ----> N: Total Unique days hh:mm:ss.-- 5: 10 2 0.00 6: 4 1 0.00 7: 40 6 0.00 8: 92 12 0.00 9: 352 46 0.00 10: 724 92 0.00 11: 2680 341 0.00 12: 14200 1787 0.00 13: 73712 9233 0.02 14: 365596 45752 0.05 15: 2279184 285053 0.22 16: 14772512 1846955 1.47 17: 95815104 11977939 9.42 18: 666090624 83263591 1:11.21 19: 4968057848 621012754 8:32.54 20: 39029188884 4878666808 1:10:55.48 21: 314666222712 39333324973 9:24:40.50 |
n=15 in 0,22 Sekunden (AMD Athlon(tm) Dual Core Processor 5050e 2.60 GHz) aber mit Bitmasken, vielleicht auch mehrere Threads und Ausnutzung von Symmetrien etc pp.
Man sieht immer noch die Verlängerung der Laufzeit um etwas weniger n/2 bei dem Schritt von n auf n+1. Somit ist sie faktoriell = exponentiell.( (1/2)*(2/2)*(3/2).. = n!/2^n
Gruß Horst
Für diesen Beitrag haben gedankt: Fiete, Mathematiker
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Mi 06.08.14 16:08
Hallo,
Horst_H hat folgendes geschrieben : | sooo schnell ist das dann aber nicht. |
Schneller als meine eigene Lösung ist/war es aber, denn ...
hatte ich noch nicht gesehen.
Mit Deiner Idee, Symmetrien auszunutzen, bin ich bei meiner eigenen Lösung jetzt bei 7,6 s. Ich muss also noch etwas arbeiten.
Ich denke, wenn Fiete ebenfalls versucht gewisse Symmetrien zu berücksichtigen, dürfte es auch einiges schneller werden.
Beste Grüße
Mathematiker
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mi 06.08.14 17:20
Hallo,
man sollte sich am besten orientieren und 0,22 Sekunden ist phänomenal.
Bitmasken sind doch eine tolle Sache.
Bits als nicht kollidierend testen geht schnell. Auch die Maske für die Diagonalen lässt sich mit SHL/SHR y aus der x-Maske leicht erzeugen.
Schön wäre, dabei innerhalb von 32 Bit zu bleiben. Beschränkt aber auf n = 16.
Oder man schiebt die Diagonal-Werte in jeder neuen Zeile um eins nach links/rechts.
Vielleicht sollte man tatsächlich sich den C-Quelltext anschauen.
Gruß Horst.
EDIT: Die alte Version nur leicht abgewandelt, immer noch keine Symmetrien genutzt, dauert es immer noch 3,8 Sekunden.
Die Erkenntnis: Lieber alle Vergleiche zu einem zusammenzufassen ist hier schneller, da eine Sprungvorhersage scheinbar nicht möglich ist.
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:
| program NQueens; {$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON} {$OPTIMIZATION REGVAR} {$OPTIMIZATION PeepHole} {$OPTIMIZATION CSE} {$OPTIMIZATION ASMCSE} {$ELSE} {$Apptype console} {$ENDIF}
uses sysutils; const nmax = 16; Offset = 3*nmax; type tFreieSpalte = array[0..nmax-1] of nativeInt; var LR_diagonale: array[0..4*nmax] of char; pLR : pChar; FreieSpalte : tFreieSpalte; i, n : nativeInt; tryCnt, gblCount : integer; T0,T1 : TdateTime;
procedure SetzeDame(Zeile:nativeInt); var i,Spalte : nativeInt; begin IF Zeile <= n then begin For i := Zeile to n do begin inc(tryCnt); Spalte := FreieSpalte[i]; If (ORD(pLR[-Spalte+Offset]) AND ORD(pLR[Spalte]))<>0 then begin pLR[ Spalte] :=#0; pLR[-Spalte+Offset]:=#0; FreieSpalte[i] := FreieSpalte[Zeile]; inc(pLR); FreieSpalte[Zeile] := Spalte; SetzeDame(Zeile+1); dec(pLR); FreieSpalte[Zeile] := FreieSpalte[i]; FreieSpalte[i] := Spalte; pLR[ Spalte] :=#1; pLR[-Spalte+Offset]:=#1; end; end; end else begin inc(gblCount); end; end;
begin For i := 0 to nmax-1 do FreieSpalte[i] := i; fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(LR_Diagonale),#1); For n := 1 to 15 do begin t0 := time; pLR:=@LR_Diagonale[0]; gblCount := 0; tryCnt := 0; SetzeDame(1); t1:= time; WriteLn(n:6,gblCount:13,tryCnt:15,FormatDateTime(' hh:mm:ss.zzz',T1-t0)); end; Writeln('<ENDE>'); Readln; end. |
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Fr 08.08.14 07:33
Hallo,
ich hoffe ich habe das Verfahren von Takaken richtig erkannt ( Ok, ich habe es mir nicht nochmal angesehen, nur Bitmasken überlegr, weil das nicht gezeichnet ist )
Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12:
| BitMasken, wenn Dame X an A4 steht. BM_ver ,BM_L ,BM_R vertikal nach links nach rechts 12345678 12345678 12345678 A X A X A X B X B X B X C X C X C X D X DX D X E X E E X F X F F G X G G H X H H |
Mit jeder neuen Zeile wird in den BitMasken nur die aktuelle Spalte eingetragen und beim Übergang zur nächsten Zeile Wir die BM_links nach links geschoben und die BM_rechts nach rechts geschoben.
Damit wird die Notwendigkeit der Berechnung der Diagonalennummern ala Nikolaus Wirth hinfällig.
Also:
BM_BedrohtePos := (BM_ver OR BM_L OR BM_R);
Freies Feld Suchen:
Ein Feld das weder in vertikal,nach links noch nach rechts vorkommt.
Jetzt muss man schnell die ganzen Bits abklappern, eine freie Position finden.Dann in den drei Masken eintragen und zur nächsten Zeile übergehen.
Die Rekursion wird nicht leichter, ich glaube die Masken links/rechts muß ich abspeichern.
Mal schauen,
Gruß Horst
|
|
|