| Autor |
Beitrag |
Fiete
Beiträge: 601
Erhaltene Danke: 339
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: 1652
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: 1652
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: 1652
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
|
|
|
