| Autor |
Beitrag |
Mathematiker
  
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Do 28.08.14 22:35
Hallo,
zur Ablenkung habe ich mir das Langford-Problem einmal vorgenommen:
Gesucht sind alle Zahlen, die jede Ziffer von 1 bis n genau zweimal enthalten, und bei denen zwischen den beiden Einsen eine andere Ziffer steht, zwischen den beiden Zweien zwei andere Ziffern, zwischen den beiden Dreien drei Ziffern usw.
Für den Fall n=7 gibt es 26 Lösungen, ohne Berücksichtigung der Umkehrung. So weit, so gut.
Mein Versuch einer rekursiven Lösung ist bis jetzt jämmerlich gescheitert, deshalb habe ich es erst einmal mit der "brutalen" Methode versucht, d.h. 7 ineinander geschachtelte Schleifen. Ich weiß, dass dies eigentlich undiskutabel ist, aber besser geht's im Moment nicht.
Und nun kommt mein Problem. Es funktioniert nicht! Ich bekomme genau 17 Lösungen, 9 sind einfach weg.
Ganz merkwürdig wird es, dass irgendetwas mit den Schleifen nicht stimmt. Lasse ich die Schleife für die Ziffer 4 über den ganzen möglichen Bereich laufen, findet er konkret die Lösung 24723645317165 nicht. Reduziere ich auf i4=2, dann kommt die Lösung. Da n=7 ist, stehe ich vor einem Rätsel.
  Delphi-Quelltext
1:
2:
| for i4:=1 to 2*n-5 do for i4:=2 to 2 do |
Der ganze Quelltext ist im Anhang.
Ich suche seit Stunden und weiß nicht mehr weiter. Ich bin schon so weit, dass ich meinem Delphi 5 die "Schuld" geben will. Das kann aber kaum sein.
Vielleicht kann jemand von Euch mal auf den Text schauen.
Der Algorithmus ist grauenhaft, deshalb eine kurze Erklärung.
Für jede Ziffer 1 bis 7 läuft eine Schleife mit den Schleifenvariablen i1 bis i7. Bevor eine neue Position gesetzt wird, lösche ich die jeweilige Ziffer und teste, ob die neue Position und die Position+Ziffer+1 frei sind. Wenn ja, wird die Ziffer gesetzt und die nächste Schleife bearbeitet usw.
Es wäre schön, wenn mir jemand sagen könnte, wo ich dieses Mal gepfuscht habe.
Danke und beste Grüße
Mathematiker
Nachtrag:
Hat sich erledigt. Ich habe die Fehler gefunden. Anstelle von z.B.
Delphi-Quelltext
1:
| for j:=1 to 2*n do if feld[j]=4 then feld[j]:=0; | musste ich
Delphi-Quelltext
1:
| for j:=1 to 2*n do if feld[j]>=4 then feld[j]:=0; | setzen.
Doofer Denkfehler. 
Einloggen, um Attachments anzusehen!
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Fr 29.08.14 16:10
Hallo,
ich hab die ganzen pauschalen Löschungen durch spezifisches Löschen der zuvor belegten ersetzt.
Rekursiv geht es auch.
Ich habe Feld, n, ( 2*n) global gemacht, damit ich die Ausgabe bei beiden ButtonClicks benutzen konnte und mir bei der Rekursion das Kopieren des Feldes ersparen konnte.
Bei Rekursiv kann man auch mal 11 testen
Villeicht sollte man, um die Spiegelungen los zu werden 1 ab der Mitte des Feldes setzen.
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:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
| unit ulangford;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
ListBox1: TListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
tfeld = array[1..32] of integer;
const
cConv = '123456789ABCDEFG';
var
feld:tfeld;
n,n2:integer;
procedure ausgabe;
var
i:integer;
k:string;
begin
k:='';
for i:=1 to n2 do
k:=k+cConv[feld[i]];
k:=k+#9;
for i:=n2 downto 1 do
k:=k+cConv[feld[i]];
Form1.listbox1.items.add(k);
Form1.label1.caption:=inttostr(Form1.listbox1.items.count);
Form1.update;
application.processmessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure setzen(ziffer,position:integer);
var
pE : integer; begin
pE :=position+ziffer+1;
while pE <= n2 do
begin
if (feld[position]=0) and (feld[pE]=0) then
begin
feld[position]:=ziffer;
feld[pE]:=ziffer;
IF Ziffer < n then
setzen(ziffer+1,1)
else
Ausgabe;
feld[position]:=0;
feld[pE]:=0;
end;
inc(position);
inc(pE);
end;
end;
begin
listbox1.clear;
n:=strtoint(edit1.text);
n2:= 2*n;
fillchar(feld,SizeOf(Feld),#0);
setzen(1,1);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
j:integer;
i1,i2,i3,i4,i5,i6,i7:integer;
begin
listbox1.clear;
n:=strtoint(edit1.text);
n2 := 2*n;
fillchar(feld,SizeOf(Feld),#0);
for i1:=1 to n2-2 do
begin
feld[i1]:=1;
feld[i1+2]:=1;
for i2:=1 to n2-3 do
begin
if (feld[i2]=0) and (feld[i2+3]=0) then
begin
feld[i2]:=2;
feld[i2+3]:=2;
for i3:=1 to n2-4 do
begin
if (feld[i3]=0) and (feld[i3+4]=0) then
begin
feld[i3]:=3;
feld[i3+4]:=3;
for i4:=2 to n2-5 do
begin
if (feld[i4]=0) and (feld[i4+5]=0) then
begin
feld[i4]:=4;
feld[i4+5]:=4;
for i5:=1 to n2-6 do
begin
if (feld[i5]=0) and (feld[i5+6]=0) then
begin
feld[i5]:=5;feld[i5+6]:=5;
for i6:=1 to n2-7 do
begin
if (feld[i6]=0) and (feld[i6+7]=0) then
begin
feld[i6]:=6;feld[i6+7]:=6;
for i7:=1 to n2-8 do
begin
if (feld[i7]=0) and (feld[i7+8]=0) then
begin
feld[i7]:=7;
feld[i7+8]:=7;
ausgabe;
feld[i7]:=0;
feld[i7+8]:=0;
end;
end;
feld[i6]:=0;feld[i6+7]:=0;
end;
end;
feld[i5]:=0;feld[i5+6]:=0;
end;
end;
feld[i4]:=0;feld[i4+5]:=0;
end;
end;
feld[i3]:=0;feld[i3+4]:=0;
end;
end;
feld[i2]:=0;feld[i2+3]:=0;
end;
end;
feld[i1]:=0;feld[i1+2]:=0;
end;
label1.caption:=inttostr(listbox1.items.count);
end;
end. |
Gruß Horst
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: Fr 29.08.14 16:32
Hallo Horst,
wie immer ist auf Dich Verlass.
 Horst_H hat folgendes geschrieben  : | Rekursiv geht es auch.
Ich habe Feld, n, ( 2*n) global gemacht, damit ich die Ausgabe bei beiden ButtonClicks benutzen konnte und mir bei der Rekursion das Kopieren des Feldes ersparen konnte.
Bei Rekursiv kann man auch mal 11 testen |
Sehr schön. Es funktioniert perfekt und ich lasse gerade n = 15 (ohne Ausgabe, d.h. nur Zählen) laufen.
Obwohl ich es weiter versucht hatte, habe ich es trotzdem nicht hinbekommen.
| Horst_H hat folgendes geschrieben : | | Villeicht sollte man, um die Spiegelungen los zu werden 1 ab der Mitte des Feldes setzen. |
Genau das ist es. Damit bekommt man genau die Lösungen, die im Allgemeinen angegeben werden.
Vielen Dank und beste Grüße
Mathematiker
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Fr 29.08.14 18:26
Hallo,
ein wenig beschleunigt ( für AMD Phenom ):
bei n = 12 sind es 0,9 statt 1,5 Sekunden
Das meiste brachte der Vergleich:
Delphi-Quelltext
1:
| if feld[position]=feld[pE] then |
statt
Delphi-Quelltext
1:
| if (feld[position]=0) AND (feld[pE]=0) then |
Weil ein falscher Sprung wesentlich Zeit-teurer als ein zusätzlicher Zugriff auf den Level I Cache.
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:
| procedure TForm1.Button1Click(Sender: TObject);
procedure setzen(ziffer:integer);
var
position,pE : integer;
begin
IF Ziffer = 1 then
position := n
else
position :=1;
pE :=position+ziffer+1;
repeat
if feld[position]=feld[pE] then
begin
feld[position]:=ziffer;
feld[pE]:=ziffer;
IF Ziffer < n then
setzen(ziffer+1)
else
inc(gblCount); feld[position]:=0;
feld[pE]:=0;
end;
inc(pE);
inc(position);
until pE > n2;
end;
var
T1,T0: TDateTime;
begin
listbox1.clear;
n:=strtoint(edit1.text);
n2:= 2*n;
fillchar(feld,SizeOf(Feld),#0);
gblCount := 0;
IF (n+1) MOD 4 < 2 then
begin
T0 := time;
setzen(1);
T1 := time;
end;
Form1.label1.caption:= IntToStr(gblCount)+
FormatDateTime(' HH:NN:SS.ZZZ',T1-t0);
end; |
n= 15 müsste aber eine ganze Weile dauern ( ich schätze Minimum 11 min bei mir )
Gruß Horst
EDIT:
es waren 14min28.08 Sekunden für 39809640 Lösungen.
Rekursive Aufrufe:
{1}(2n-3)*
{2}(2n-4-2*2)*{2 von 1 belegte blockieren sowohl die erst als auch die zweite Stelle, nur bei Beginn und Ende des Feldes nicht}
{3}(2n-5-4*2)*{4 von 1,2 belegte blockieren sowohl die erste als auch die zweite Stelle, nur bei Beginn und Ende des Feldes nicht}
Mist, das wird zu ungenau...
Edit2:
Eigentlich muss man ja gar keine Ziffern eintragen, sondern nur Felder belegen, wenn man nur die Anzahl der Lösungen kennen will.Dann könnte man BIT-Masken arbeiten:
1= '0..0101', 2= '0..1001' etc. die man dann verschiebt.
Bei 64 Bit bis n = 32.
Ich habe mal grob überschlagen das die Programme für n= 23 desillusionierend viel schneller sind
Nun ja, in Assembler könnte man schnell das erste freie Bit finden.
EDIT3:
Hier legacy.lclark.edu/~miller/langford.html wissen sie mehr:
Es wird ganz anders gemacht, um die exponentielle Laufzeit durch simples Probieren zu umgehen.
legacy.lclark.edu/~m.../godfrey/method.html
| Zitat: | | Now, a method whose complexity in time increases roughly as 4n may not sound good, but it turns out to be a great improvement over the simple search when n is large. Remember that L(2, n) varies roughly as (4n / e^3)^n, so that searching for all the Langford sequences takes at least this long; longer, in fact, as the time taken per sequence increases with n. The new method could be expected to be faster than the classic search by a factor of at least A (n / e3)^n, where A is a relatively slowly varying function of n. |
EDIT5:
Etwas neuer und allgemeiner
www.m-hikari.com/imf...alabyIMF1-4-2014.pdf
Edit4:
Indem man eine Bitmaske von links nach rechts schiebt, wird es etwas schneller, aber immer noch langsam.
n= 15 in 5 min, nicht mal 3 mal schneller.
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:
| unit ulangford;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
ListBox1: TListBox;
Button2: TButton;
procedure ausgabe;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
tfeld = array[1..32] of integer;
tcnt = array[1..16] of Cardinal;
const
cConv = '123456789ABCDEFG';
var
feld:tfeld;
CntRek : tCnt;
Maske : tCnt;
gblCount:UInt64;
T1,T0: Tdatetime;
depth,n,n2 :integer;
n2Mask : cardinal;
procedure BitSetzen(BF : Cardinal);
var
Mask : Cardinal;
begin
Mask := Maske[depth];
repeat
IF Bf AND Mask = 0 then
begin
IF depth > 1 then
begin
dec(depth);
BitSetzen(BF OR Mask);
inc(depth);
end
else
inc(gblCount); end;
Mask := Mask shr 1;
until Mask AND LongWord(Mask-1) = 0;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i :integer;
Mask: cardinal;
begin
listbox1.clear;
n:=strtoint(edit1.text);
IF (n+1) MOD 4 < 2 then
begin
gblCount := 0;
n2:= 2*n;
n2Mask := 1 shl (n2-1);
For i := n downto 1 do
begin
Mask := n2Mask;
Maske[i] := Mask+ Mask shr (i+1);
end;
Maske[1] := Maske[1] shr (n-1);
T0 := time;
depth := n;
Bitsetzen(0);
T1 := time;
end;
label1.caption:= IntToStr(gblCount)+
FormatDateTime(' HH:NN:SS.ZZZ',T1-t0);
listbox1.items.add(Format('Anzahl Aufrufe %d',[gblCount]));
end;
end. |
Zuletzt bearbeitet von Horst_H am Fr 26.09.14 15:23, insgesamt 1-mal bearbeitet
Für diesen Beitrag haben gedankt: Mathematiker
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 02.09.14 07:55
Hallo,
eine kleine Frage beschäftigt mich noch:
Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
| Hier mal für n= 11
14175849AB573682392A6B
12172869AB475684395A3B// Wechsel bei 6
31713859AB745682492A6B// Wechsel bei 7
31713859AB765284296A4B// Wechsel bei 7
51716859AB762482394A3B// Wechsel bei 6
13185379AB548672492A6B// Wechsel bei 8
13185379AB568274296A4B// Wechsel bei 6
41815479AB583672392A6B// Wechsel bei 8
48171469AB873652392A5B// Wechsel bei 8
58171659AB876234293A4B// Wechsel bei 6
25121895AB467384936A7B// Wechsel bei 9 |
Kann man nach der Entdeckung einer Lösung in der Rekursion nicht einfach pauschal 6 (~ n/2) - Rücksprünge machen?
EDIT: Das wäre zu schön gewesen
Aber bei n= 12 kommt als erstes schon die 3er-Kombination gefolgt von ihrer Spiegelung. 
Quelltext
1:
2:
| 231213897BCA564879546BAC
312132897BCA564879546BAC |
Edit2:
Wieder i3 4330 Haswell ...
Zur Zeit lasse ich ja fallend der Größe nach die Zahlen einfügen.
Das dauert für n= 12 etwa 380 ms. Aufsteigend wären es 780ms
Mit Zufallszahken gemischt ergibt sich auf einmal
Quelltext
1:
2:
3:
| Anzahl Loesungen 108144
11-> 6, 10-> 5, 9-> 10, 8-> 9, 7-> 0, 6-> 11, 5-> 7, 4-> 8, 3-> 4, 2-> 3, 1-> 2,
Laufzeittakt 232 ms |
Das sind 40% Zeit-Ersparnis mit minimalem Aufwand.Die großen vorne mehr in die Mitte und die mittleren nach vorne.
Da sollte ein genetischer Algorithmus helfen...
Edit3:
Es ist wohl nur der Tausch der Maske[0] = 1, die nur von n..2n-2 läuft an eine vorherige Position.Maske[0] mit Maske[4] getauscht war am schnellsten.
n = 15 in 3 min 6 Sekunden ( FPC 2.6.4_ 64 Bit ) statt 4 min 13 Sekunden zuvor.( oder 14min28.08 Sekunden mit Byte Feld )
Gruß Horst
|
|
|
