Entwickler-Ecke
Algorithmen, Optimierung und Assembler - 123456789 to 987654321
juleins - Di 10.07.07 00:02
Titel: 123456789 to 987654321
hey.
ich möchte alle möglichen Kombinationen von 9-Stelligen Zahlen erzeugen, in denen jede Ziffer (1 bis 9) aber nur einmal vorkommt.
eine erste idee wäre sicher:
Delphi-Quelltext
1: 2: 3:
| for i := 123456789 to 987654321 do if (keine ziffer doppelt) then speichern |
dies erscheint mir aber nicht sehr elegant und schnell, da sehr viele zahlen "umsonst" erzeugt werden. Ich bin mir sicher es gibt eine bessere Lösung, ich komme nur nicht drauf.
kann mir jmd helfen?
grüßle juleins
Moderiert von Tino: Code- durch Delphi-Tags ersetzt.
Calculon - Di 10.07.07 00:18
Aufgabe: Wieviel 9-stellige Zahlen gibt es?
Lösung: n = 9 * 10 * 10 * 10 * 10 * 10 * 10 * 10 * 10 = 9 * 10^8 = 900.000.000
Gruß
Calculon
--
Blawen - Di 10.07.07 00:29
Calculon hat folgendes geschrieben: |
Aufgabe: Wieviel 9-stellige Zahlen gibt es?
Lösung: n = 9 * 10 * 10 * 10 * 10 * 10 * 10 * 10 * 10 = 9 * 10^8 = 900.000.000 |
Da jede Ziffer aber nur einmal vorkommen darf, werden es aber schon ein paar weniger sein ;-)
juleins - Di 10.07.07 00:56
mh ja klar..
ich will aber nicht wissen wieviele es gibt.
Ich brauche die Kombinationen. ;)
Calculon - Di 10.07.07 01:11
juleins hat folgendes geschrieben: |
[..] in denen jede Ziffer (1 bis 9) aber nur einmal vorkommt. |
:oops: hab ich übersehen...
Gruß
Calculon
--
ene - Di 10.07.07 06:27
Also so etwas wie Soduko? Nicht hübsch, aber man könnte mit einer Schleife 1 bis 9 immer einen Array erzeugen und nur Zahlen verwenden, die nicht in [x..y] sind.
alzaimar - Di 10.07.07 06:39
Such mal nach 'Permutation'. Das Thema hatten wir schon öfter. Zur Anzahl:
Für die 1.Stelle gibt es 9 Möglichkeiten, für die 2. nur noch 8, für die 3. nur noch 7 (denn zwei Ziffern sind ja schon vergeben)....
Macht also 9*8*7*6*5*4*3*2 = 9! Kombinationen.
Hier ist meine Version:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15:
| Type TCharSet = Set Of Char;
Procedure TForm1.Permutation(Const aString, aResult : String; anIndex : Integer; aUsedChars : TCharSet); Var i : Integer;
Begin For i:=1 to Length (aString) Do If Not (aString[i] in aUsedChars) Then If anIndex = Length (aString) Then Memo1.lines.add(aResult+aString[i]) Else Permutation (aString, aResult + aString[i], anIndex + 1, aUsedChars + [aString[i]]); End; |
Aufruf mit
Delphi-Quellcode:
Delphi-Quelltext
1:
| Permutation ('1234567', '' ,1 , []) |
Hier wird ein Memo als Container verwendet. Das ist natürlich eine riesige Performance-Bremse.
oldmax - Di 10.07.07 12:23
Hi
Ich glaub, die Lösung ist gar nicht so schwer.
Nimm einen String '123456789'( ja, sehr unbeliebt....)
Dann zwei Schleifen
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9:
| For i:=1 to Length(ZahlenString)-1 do begin For J :=i+1 to Length(ZahlenString) do begin Merker:=ZahlenString[i]; ZahlenString[i]:=ZahlenString[J]; ZahlenString[J]:=Merker; end; end; |
und dann lass dich vom Ergebnis überraschen...
Übrigends, Zahlen können nicht doppelt ersscheinen, weil sie ja auch nur 1x im String vorkommen und nur getauscht werden. Es kommt nix hinzu und es geht auch nix weg....
Gruß oldmax
PS: ich vergaß - Entweder die erzeugten Strings in eine Listbox schreiben oder einen Zähler mitlaufen lassen.
Blawen - Di 10.07.07 12:53
oldmax hat folgendes geschrieben: |
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9:
| For i:=1 to Length(ZahlenString)-1 do begin For J :=i+1 to Length(ZahlenString) do begin Merker:=ZahlenString[i]; ZahlenString[i]:=ZahlenString[J]; ZahlenString[J]:=Merker; end; end; |
PS: ich vergaß - Entweder die erzeugten Strings in eine Listbox schreiben oder einen Zähler mitlaufen lassen. |
PS:
Den Ausgangsstring nicht vergessen mitzuzählen, bzw. auszugeben!
juleins - Di 10.07.07 16:15
hey oldmax
deine routine liefert mir nur 36 lösungen.
ich sehe aber auf den ersten blick, dass es noch mehr geben muss.
Irgendwo steckt da noch ein fehler.
grüßle juleins
JayEff - Di 10.07.07 16:36
juleins hat folgendes geschrieben: |
deine routine liefert mir nur 36 lösungen.
ich sehe aber auf den ersten blick, dass es noch mehr geben muss. |
Richtig, denn 9! ist 362880.
alzaimar - Di 10.07.07 16:51
Wieso nimmst Du nicht einfach meinen Codeschnipsel
Magst Du ihn etwa nicht? :eyes: Dabei hab ich mir soooo viel Mühe gegeben... :bawling:
:zwinker:
juleins - Di 10.07.07 17:28
hey tut mir leid alzaimar^^
ich hab gerade vorher erst wieder reingeschaut
und hab nur den von oldmax ausprobiert.
Der sah so schön einfach aus :)
jetzt versuch ichs mal mit deinem, keine sorge
danke & grüßle juleins
alzaimar - Mi 11.07.07 08:50
:dance2:
Horst_H - Mi 11.07.07 14:47
Hallo,
wie wäre es mit diesen alten Klamotten ;-)
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: 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:
| program PermuteString; {$Apptype console} uses sysutils,classes; const nmax = 9; Type TCharSet = Set Of Char;
var sl : TStringlist; PermString : string; T0,T1 : TdateTime; j : INt64; i, n : integer; Zeichen : char;
function Next(var a:string): Boolean; var k,j,r,s : integer; temp : char; procedure swap(i,j :integer); begin temp := a[i]; a[i] := a[j]; a[j] := temp; end;
begin k := n-1; while a[k] > a[k+1] do k:=k-1; if k <> 0 then begin j := n; while a[k] > a[j] do j:=j-1; swap(j,k); r:=n; s:=k+1; while r>s do begin swap(r,s); r:=r-1; s:=s+1; end; Next:= true; end else Next := false end;
Procedure Permutation(Const aString, aResult : String; anIndex : Integer; aUsedChars : TCharSet); Var i : Integer;
Begin For i:=1 to Length (aString) Do If Not (aString[i] in aUsedChars) Then If anIndex = Length (aString) Then SL.add(aResult+aString[i]) Else Permutation (aString, aResult + aString[i], anIndex + 1, aUsedChars + [aString[i]]); End;
Function NthPermutation (const aString : AnsiString; aCount : Int64) : AnsiString; Var pos, i, n : Cardinal; chTemp : char; Begin n := Length(aString); result := aString; for i := n downto 2 do begin pos := acount mod i +1; chTemp := result[i]; result[i] := result[Pos]; result[Pos] := chTemp;
acount := acount div i; End; End;
begin setlength(PermString,nmax);
For i := 1 to nmax do PermString[i] := chr(i+ord('0'));
n := nmax; j := 1; For i := 2 to n do j := i*j; writeln(PermString,j:10); readln; try sl := TStringlist.create; sl.capacity:= j;
t0 := time; Permutation (PermString, '' ,1 , []); t1:= time;
WriteLn('ALZ',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));
sl.clear; sl.capacity:= j;
t0 := time; repeat sl.add(nthpermutation(permstring,j)); dec(j); until j=0; t1:= time;
WriteLn('HOR',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));
sl.clear; sl.capacity:= j;
For i := 1 to nmax do PermString[i] := chr(i+ord('0'));
t0 := time; repeat sl.add(PermString); until NOT(Next(PermString)); t1:= time;
WriteLn('PermLex',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));
finally sl.free; end;
Readln; end. |
Eigentlich suchte ich eine Version (permlex.pas) , die direkt lexikografisch aufsteigend ist, wie die von alzaimar.
Aha, 2003 war das:
http://www.webplain.de/foren/read.php?1,5610,5704#msg-5704 (Programmer: Joe Sawada, 1997. aber der Link ist weg).
Nun denn, ich habe es jetzt eingebaut und siehe da, die Zeiten sind etwa etwa 5(ALZ):3(HOR):1(PermLex), also erheblich schneller
Gruß Horst
EDIT:
Die Anzahl der Vertauschungen (bei alzaimar Anhängen) pro Durchgang ist bei mir immer n-1, bei permlex ca. 1,54 fast unabhänigig von n und das macht die Sache sehr schnell.Ich habe mal DIV und MOD eliminiert, falls man nextpermutation haben will. Aber das ist nur doppelt so schnell, als NthPermutation.
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: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48:
| type TModZaehl = array[1..nmax] of integer; .. var ModZaehl : TModZaehl; .. function NextPermutation(const aString: AnsiString; var ModZaehl: TModZaehl): AnsiString; var pos, i, n: Cardinal; chTemp: char;
begin n := Length(aString);
result := aString;
for i := 1 to n-1 do begin pos := n-ModZaehl[i];
chTemp := result[i]; result[i] := result[Pos]; result[Pos] := chTemp; end;
i := n; pos := 1; inc(ModZaehl[pos]); while ModZaehl[pos] >= i do begin ModZaehl[pos] := 0; inc(pos); dec(i); if i < 2 then break; inc(ModZaehl[pos]); end;
end; ... t0 := time; for i := 1 to j do NextPermutation(PermString, ModZaehl); t1 := time; .. |
Lange Rede, keinen Sinn: Permlex ist zeitlich konstant*O(n!) und nthPermutation ist ~konstant*O((n+1)!) in der Lauftzeit.
(nmax=10 -> permlex 0,221 Sekunden (ohne sl.add(..) sonst 1,61 Sekunden)
Was ich noch nicht gefunden habe ist eine nextpermutation, mit jeweils nur einer Tauschung.
http://www.codeplanet.eu/modules/tutorials/article.php?storyid=7&page=0 oder
http://www.c-plusplus.de/forum/viewtopic-var-t-is-178286.html
Dort wundert mich das bei n=10 weniger als 10! permutationen berechnet werden???
Fiete - Fr 28.09.07 18:02
Titel: Re: 123456789 to 987654321
juleins hat folgendes geschrieben: |
hey.
ich möchte alle möglichen Kombinationen von 9-Stelligen Zahlen erzeugen, in denen jede Ziffer (1 bis 9) aber nur einmal vorkommt.
eine erste idee wäre sicher:
Delphi-Quelltext 1: 2: 3:
| for i := 123456789 to 987654321 do if (keine ziffer doppelt) then speichern |
dies erscheint mir aber nicht sehr elegant und schnell, da sehr viele zahlen "umsonst" erzeugt werden. Ich bin mir sicher es gibt eine bessere Lösung, ich komme nur nicht drauf.
kann mir jmd helfen?
grüßle juleins
Moderiert von Tino: Code- durch Delphi-Tags ersetzt. |
MantaBerti - Do 21.02.08 05:04
Dort werden nicht immer weniger als 10! Permutationen berechnet. Es gibt Permutationen mit und ohne Wiederholungen. Bei Permutation mit Wiederholung berechnet sich die Anzahl nicht nach n! sondern mit n! / k! * k! * kn!
Beispiel: aba
Je nach Algorithmus produziert das:
aab, aba, aba, aab, baa, baa
oder
aab, aba, baa
Dort werden verschiedene schnelle Algorithmen vorgestellt, die jeweils mit und ohne Wiederholungen rechnen, darunter ein sogenannter Countdown Algorithmus, der extrem performant arbeitet. Schneller geht es meines Wissens nicht mehr. Ich habe den C++ Algo dort in Delphi portiert. Funktioniert erste Sahne! :D
Gruß
Berti
Horst_H - Do 21.02.08 08:21
Hallo,
dann beglücke uns doch mit deiner Umsetzung nach Delphi.
Dann man ja einen kleinen Test starten.
Gruß Horst
Delphi-Laie - Mo 13.07.09 11:16
Ist zwar schon zwei Jahre her, aber trotzdem:
Horst_H hat folgendes geschrieben : |
Was ich noch nicht gefunden habe ist eine nextpermutation, mit jeweils nur einer Tauschung. |
Doch, gibt es, auch im Internet veröffentlicht (nach langer, hartnäckiger Suche gefunden), und zwar hier:
http://medwelljournals.com/fulltext/ajit/2007/956-957.pdf
Der dort beschriebene, (programmier-)sprachunabhängige Algorithmus ist zwar fürchterlicher "Spaghetticode", der eine iterative Optimierung durchaus verdient hat, aber er funktioniert und kommt tatsächlich nur mit einem Austausch (also jeweils zwei betroffene Elemente) zur Generierung einer (jeden) neuen Permutation aus. Er ist natürlich auch so optimiert, daß keine doppelten Permutationen erzeugt werden und zudem so "intelligent", daß er nach der Enumeration aller Permutationen von selbst endet (also keine Zählschleife für die Permutationsanzahl erforderlich ist). Hier eine erste (!) Delphi-Umsetzung, die sich noch voll an das Original anlehnt, mit der beispielhaften Elementeanzahl n=5:
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: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44:
| const n=5;
label 2,4,6,8;
var a:string; temp:char; c,r,m:array[1..n] of integer; i,k:byte;
begin for i:=1 to n do begin c[i]:=0; r[i]:=1; m[i]:=n-i end; a:='ABCDE';
2:i:=1;k:=1;
showmessage(a); 4:if c[i]=m[i] then goto 6; temp:=a[c[i]+k]; a[c[i]+k]:=a[c[i]+k+r[i]]; a[c[i]+k+r[i]]:=temp; inc(c[i],r[i]); goto 2;
6:if c[succ(i)]=m[succ(i)] then goto 8; temp:=a[k]; a[k]:=a[succ(n-k)]; a[succ(n-k)]:=temp; c[i]:=n-i-m[i]; inc(c[succ(i)],r[succ(i)]); goto 2;
8:r[i]:=-r[i]; m[i]:=n-i-m[i]; r[succ(i)]:=-r[succ(i)]; m[succ(i)]:=pred(n-i-m[succ(i)]); inc(i,2); inc(k); if i<n then goto 4 |
Auch werden in jenem Artikel andere, frühere, ebenfalls elementetauschbasierte Ansätze von Ives, Sedgewick und Roy erwähnt. Ob dieser Algorithmus wirklich der erste dieser Art ist, geht aus dem Artikel m.E. nicht eindeutig hervor. Ich verstehe es aber so, daß dieser neue Algorithmus zur Erzeugung
jeder neuen Permutation nur
eine Vertauschung (logischerweise (nur)) zweier Elemente benötigt und sich damit doch signifikant von den vorigen unterscheidet. Natürlich finden sich noch andere Beiträge im Internet, aber das ist zweifelsohne der schnellste und effektivste Ansatz. Auch in Donald E. Knuths Band 4 "Combinatorical algorithms" wird sich sicher etliches zu dieser Problematik bzw. Thematik finden.
Die bloßen Vertauschungen (anstatt daß jedesmal eine Ausgangsdatenmenge in eine Zieldatenmenge transformiert wird) bewirken auch einen minimalen Ressourcenbedarf hinsichtlich der zu "bewegenden" Daten und des Speicherbedarfes, analog den "in-place"-Sortieralgorithmen.
Weil die Enumeration auch in diesem Algorithmus nicht lexikographisch erfolgt und damit nicht bei der höchsten Permutation (also der mit der lexikographisch höchsten Nummer) endet, ist der als Thema plakativ genannte Wunsch "123456789 to 987654321" allerdings nicht erfüllbar, für die reine Enumeration aller Permutationen jedoch auch nicht nötig.
Edit: Der Verweis existert leider nicht mehr, deshalb hänge ich die entsprechende PDF-Datei hier an.
Edit 2: Die Datei ist nunmehr [url=
http://docsdrive.com/pdfs/medwelljournals/ajit/2007/956-957.pdf]hier[/url] verfügbar.
BenBE - Mo 13.07.09 12:27
Die GOTOs tun ja weh! Wenn es wenigstens COMEFROMs wären!
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: 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:
| procedure GetPermutations(A: String; Callback: TPermutationCallback); var temp:char; c,r,m:array of integer; i,k,n:Integer; p:Boolean; begin n := Length(A);
SetLength(c,succ(n)); SetLength(r,succ(n)); SetLength(m,succ(n));
for i:=1 to n do begin c[i]:=0; r[i]:=1; m[i]:=n-i end;
p := True; repeat if p Then begin Callback(a); i := 1; k := 1;
p := false; end;
if c[i] <> m[i] then Begin temp := a[c[i]+k]; a[c[i]+k] := a[c[i]+k+r[i]]; a[c[i]+k+r[i]] := temp; inc(c[i], r[i]);
p = true; continue; end;
if c[succ(i)] <> m[succ(i)] then begin temp := a[k]; a[k] := a[succ(n-k)]; a[succ(n-k)] := temp; c[i] := n-i-m[i]; inc(c[succ(i)],r[succ(i)]);
p = true; continue; end;
r[i] := -r[i]; m[i] := n-i-m[i]; r[succ(i)] := -r[succ(i)]; m[succ(i)] := pred(n-i-m[succ(i)]); inc(i, 2); inc(k); until not p and (i >= n);
end; |
Auf den Rest der Kommentare verzichte ich, wie der Originalautor auch ;-)
Delphi-Laie - Do 24.09.09 19:59
Nachdem die eingeworfene iterative Lösung dank BenBE deutlich verbessert wurde, möchte ich noch einmal auf die ursprüngliche Aussage:
Horst_H hat folgendes geschrieben : |
Was ich noch nicht gefunden habe ist eine nextpermutation, mit jeweils nur einer Tauschung. |
zurückkommen.
Anscheinend gibt es eine
rekursive Lösung schon wesentlich länger: In [url=
http://www.cs.princeton.edu/~rs/talks/perms.pdf]dieser PDF-Datei[/url] scheint die Methode 4 "Heap's Algorithm" genau das zu erfüllen:
- Ein Elementetausch (logischerweise nur zweier Elemente) zur Erzeugung einer jeden neuen Permutation
- jede Permutation wird genau einmal erzeugt, also eine - wenn auch nicht lexikographische) Enumeration
während Methode 1 "Backtracking" jeweils zwei Vertauschungen vornimmt und nach meiner Recherche Methode 2 "Plain changes" nicht sauber enumeriert: Es gibt Dopplungen, so daß andererseits, weil die Anzahl der Erzeugungen (n!) stimmt, Permustionen entfallen müssen. Heaps Algorithmus gibt es seit 1963! Spartanischer Pascal-Code dafür, in dem der beispielhafte Vektor a[1..n] (könnte genausogut z.B. ein String sein) erschöpfend permutiert wird, dazu:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19:
| procedure generate(n:word); var c,t:byte;
begin
if n=1 then begin end;
for c:=1 to n do begin if odd(n) then begin t:=a[c];a[c]:=a[n];a[n]:=t end else begin t:=a[1];a[1]:=a[n];a[n]:=t end end
end; |
, aufzurufen über die Anzahl der zu permutierenden Elemente: generate(Elementeanzahl), bei einem Vektor (Array) also generate(succ(high(a))), bei einem String generate(length(a)).
Fiete - Sa 26.09.09 16:45
Moin an alle,
zwei Bemerkungen seien gestattet:
Das Permutationsproblem ist äquivalent zum Turmproblem, dieses wiederum kann aus dem [url=
http://de.wikipedia.org/wiki/Damenproblem]Damenproblem [/url] abgeleitet werden.
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: 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:
| unit NDamen2009;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin, Grids, ExtCtrls, DBCtrls;
type TBrett=Array of Integer; TNDamen = class(TForm) Anzahl: TSpinEdit; StaticText1: TStaticText; Start: TButton; StellungsAusgabe: TListBox; Zeigen: TCheckBox; StaticTextN: TStaticText; LabelN: TLabel; StaticTextTime: TStaticText; FeldAusgabe: TStringGrid; LabelZeit: TLabel; procedure StartClick(Sender: TObject); procedure StellungsAusgabeClick(Sender: TObject); private Brett:TBrett; BrettGroesse:Integer; Stellungen:Integer; function TimeSekunden:extended; procedure Ausgabe(NR:Integer;Brett:TBrett); function Erlaubt(x:Integer):Boolean; procedure Setz(x:Integer); procedure Fuellen(Nr:Integer); public end;
var NDamen: TNDamen;
implementation
{$R *.DFM} {$R+,Q+}
function TNDamen.TimeSekunden:extended; var H,M,S,MS:Word; begin DecodeTime(Now,H,M,S,MS); TimeSekunden:=3600.0*H+60.0*M+S+MS/1000 end;
procedure TNDamen.Ausgabe(NR:Integer;Brett:TBrett); var x,y:Integer; Zeile:String; begin IF NDamen.Zeigen.Checked then begin Zeile:=''; StellungsAusgabe.Items.Add(IntToStr(Nr)+'-te Stellung'); for x:=1 to BrettGroesse do for y:=1 to BrettGroesse do IF Brett[x]=y then Zeile:=Zeile+char(x+64)+IntToStr(y)+' '; StellungsAusgabe.Items.Add(Zeile); StellungsAusgabe.Items.Add(''); end end;
function TNDamen.Erlaubt(x:Integer):Boolean; var K:Integer; begin Erlaubt:=True; for K:=1 to x-1 do if Brett[x]=Brett[K] then begin Erlaubt:=False;exit end; [b] for K:=1 to x-1 do if Abs(Brett[x]-Brett[K])=x-K then begin Erlaubt:=False;exit end; end;
procedure TNDamen.Setz(x:Integer); var y:Integer; begin for y:=1 to BrettGroesse do begin Brett[x]:=y; if Erlaubt(x) then if x<BrettGroesse then Setz(x+1) else begin Inc(Stellungen);Ausgabe(Stellungen,Brett) end; end end;
procedure TNDamen.Fuellen(nr:Integer); var x,y:Integer; Teil,Zeile:String; begin for x:=1 to BrettGroesse do FeldAusgabe.Cells[x,0]:=char(64+x); for y:=1 to BrettGroesse do FeldAusgabe.Cells[0,BrettGroesse+1-y]:=IntToStr(y); for y:=1 to BrettGroesse do for x:=1 to BrettGroesse do FeldAusgabe.Cells[x,y]:=' '; Zeile:=StellungsAusgabe.Items[Nr];x:=0; while Zeile<>'' do begin Teil:=Copy(Zeile,1,Pos(' ',Zeile)-1);Inc(x); y:=StrToInt(Copy(Teil,2,Length(Teil)-1)); FeldAusgabe.Cells[x,BrettGroesse+1-y]:='D'; Delete(Zeile,1,Pos(' ',Zeile)); end; end;
procedure TNDamen.StartClick(Sender: TObject); var x,y:Integer; TSek:Extended; begin BrettGroesse:=StrToInt(Anzahl.Text); SetLength(Brett,BrettGroesse+1); StellungsAusgabe.Clear; StellungsAusgabe.Width:=160; FeldAusgabe.Width:=25*(BrettGroesse+1); FeldAusgabe.Height:=25*(BrettGroesse+1); FeldAusgabe.ColCount:=BrettGroesse+1; FeldAusgabe.RowCount:=BrettGroesse+1; FeldAusgabe.Visible:=False; if BrettGroesse>4 then StellungsAusgabe.Width:=120+(BrettGroesse-4)*30; if BrettGroesse>11 then Zeigen.Checked:=False; if Not Zeigen.Checked then begin StellungsAusgabe.Visible:=False; FeldAusgabe.Visible:=False end else begin StellungsAusgabe.Visible:=True; FeldAusgabe.Visible:=True; end; Stellungen:=0; Screen.Cursor:=crHourGlass; TSek:=TimeSekunden;Setz(1);TSek:=TimeSekunden-TSek; Screen.Cursor:=crDefault; LabelZeit.Caption:=Format('%0.2f',[TSek])+' sek.'; LabelN.Caption:=IntToStr(Stellungen); for x:=1 to BrettGroesse do FeldAusgabe.Cells[x,0]:=char(64+x); for y:=1 to BrettGroesse do FeldAusgabe.Cells[0,BrettGroesse+1-y]:=IntToStr(y); for y:=1 to BrettGroesse do for x:=1 to BrettGroesse do FeldAusgabe.Cells[y,BrettGroesse+1-x]:=' '; end;
procedure TNDamen.StellungsAusgabeClick(Sender: TObject); var Nr:Integer; begin Nr:=StellungsAusgabe.ItemIndex; if (NR+2)mod 3=0 then Fuellen(Nr); end;
end. |
Ein neuer Algorithmus ist ein Rotationsalgorithmus, Beispiel für N=4
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: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37:
| 1 2 3 4 2 3 4 1 3 4 1 2 4 1 2 3 1 2 3 4 T[4]=L, also dec(L) 2 3 1 4 es werden nur die ersten drei rotiert 3 1 4 2 1 4 2 3 4 2 3 1 2 3 1 4 T[4]=L, also dec(L) 3 1 2 4 es werden nur die ersten drei rotiert 1 2 4 3 2 4 3 1 4 3 1 2 3 1 2 4 T[4]=L, also dec(L) 1 2 3 4 es werden nur die ersten drei rotiert T[3]=L, also dec(L) 2 1 3 4 es werden nur die ersten zwei rotiert 1 3 4 2 3 4 2 1 4 2 1 3 2 1 3 4 T[4]=L, also dec(L) 1 3 2 4 es werden nur die ersten drei rotiert 3 2 4 1 2 4 1 3 4 1 3 2 1 3 2 4 T[4]=L, also dec(L) 3 2 1 4 es werden nur die ersten drei rotiert 2 1 4 3 1 4 3 2 4 3 2 1 3 2 1 4 T[4]=L, also dec(L) es werden nur die ersten drei rotiert 2 1 3 4 T[3]=L, also dec(L) es werden nur die ersten zwei rotiert 1 2 3 4 T[2]=L, also dec(L) L hat den Wert 1 ==> Schluß |
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: 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:
| unit Perm;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin;
type TPermutationen = class(TForm) SpinEditN: TSpinEdit; LabelN: TLabel; ButtonWeiter: TButton; ButtonAlle: TButton; Ausgabe: TMemo; ButtonStart: TButton; procedure ButtonWeiterClick(Sender: TObject); procedure ButtonStartClick(Sender: TObject); procedure ButtonAlleClick(Sender: TObject); private Perm:Array[1..10]of Byte; N,Index:Byte; Anzahl:Integer;
procedure Anzeigen; public end;
var Permutationen: TPermutationen;
implementation
{$R *.dfm}
procedure TPermutationen.ButtonWeiterClick(Sender: TObject); var Tausch,K:Byte; begin if Index>1 then begin Tausch:=Perm[1]; for K:=2 to Index do Perm[K-1]:=Perm[K]; Perm[Index]:=Tausch; if Perm[Index]=Index then dec(Index) else Anzeigen end else begin Ausgabe.Lines.Add('Anzahl der Permutationen: '+IntToStr(Anzahl)); ButtonWeiter.Enabled:=False; ButtonAlle.Enabled:=False; end; end;
procedure TPermutationen.ButtonStartClick(Sender: TObject); var K:Byte; begin N:=SpinEditN.Value;Ausgabe.Clear; for K:=1 to N do Perm[K]:=K; Anzahl:=0;Anzeigen; ButtonWeiter.Enabled:=True; ButtonAlle.Enabled:=True; end;
procedure TPermutationen.Anzeigen; var K:Byte; Zeile:String; begin Zeile:=''; for K:=1 to N do Zeile:=Zeile+Char(ord('@')+Perm[K])+' ';; Ausgabe.Lines.Add(Zeile); inc(Anzahl);Index:=N; end;
procedure TPermutationen.ButtonAlleClick(Sender: TObject); var Tausch,K:Byte; begin N:=SpinEditN.Value; if N>8 then if MessageDlg('Bist du dir sicher',mtConfirmation,[mbYes,mbNo],0)=mrNo then exit; Ausgabe.Clear; for K:=1 to N do Perm[K]:=K; Anzahl:=0;Anzeigen; while Index>1 do begin Tausch:=Perm[1]; for K:=2 to Index do Perm[K-1]:=Perm[K]; Perm[Index]:=Tausch; if Perm[Index]=Index then dec(Index) else begin Index:=N;Anzeigen end; end; Ausgabe.Lines.Add('Anzahl der Permutationen: '+IntToStr(Anzahl)); ButtonWeiter.Enabled:=False; ButtonAlle.Enabled:=False; end;
end. |
Gruß an alle Tüftler
Fiete
Horst_H - So 27.09.09 15:31
Hallo,
Delphi-Laie :
Deine rekursive procedure generate(n:word); ist ohne Rekursion.
Kein generate (n-1) oder ähnliches drin.
Fiete :
Dieser Rotationsalgorithmus schiebt ja gewaltige Datenmengen
Delphi-Quelltext
1: 2: 3:
| Tausch:=Perm[1]; for K:=2 to Index do Perm[K-1]:=Perm[K]; Perm[Index]:=Tausch; |
Ob das so performant ist?
Bei N-Damen habe ich die Permutionsrekursion und Stellungsprüfung kombiniert.
Ich brauche ja nicht alle Permutation von DameInZeileKommtInSpalte[1,3,2....] testen, wenn 1,3,2 schon zu einem Fehler führt. Ich hoffe ich habe da nicht übersehen...
Gruß Horst
Fiete - Fr 09.10.09 12:42
Moin Horst_H,
im Anhang ist eine Testversion mit Zeitmessung.
Ich habe nichts besseres gefunden oder entwickelt.
Gruß
Fiete
Horst_H - Sa 10.10.09 09:23
Hallo,
Deine Version ist erheblich schneller, wenn man statt des normalen kopierens in einer Schleife den move-Befehl nimmt. Sonst etwa gleichschnell.
permlex habe ich angepasst, sodass kein RangeCheck Error auftritt und ein paar Variablen eingespart.
Ich habe mal spasseshalber statt byte integer benutzt.
Das beschleunigt um 10%, außer die Version mit move welche langsamer wird, die aber immer noch schneller als die anderen Versionen bleibt.
Gruß Horst
P.S.
Meine Lösung für das 8-Damen Problem von 2002 finde ich nicht mehr :-(
Ich meine, die hätte nur 1536 statt 8! = 40320 Durchläufe gehabt um alle 92 Lösungen zu finden.
Alles gelogen ;-) es sind 5508 Test's von 40320
http://www.delphi-forum.de/viewtopic.php?p=440863
EDIT:
Eine neue Version von permlex mit Zeigern.Etwas schneller. ~22 CpuTakte pro Permutation.
Delphi-Laie - Sa 17.10.09 17:16
Horst_H hat folgendes geschrieben : |
Hallo,
Delphi-Laie :
Deine rekursive procedure generate(n:word); ist ohne Rekursion.
Kein generate (n-1) oder ähnliches drin. |
Hast Du recht, Horst. Weiß auch nicht, wie die abhanden kommen konnte. Asche auf mein Haupt.
Das Original von Herrn Sedgewick habe ich ohnehin verlinkt, und das ist allemal aussagekräftiger.
Allerdings war ich zu euphorisch, was ich erst nach dem Posten richtig bemerkte (ja, ich war voreilig!): Ältere Permutationsalgorithmen, ob rekursiv oder iterativ, kommen anscheinend doch nicht mit der Minimalanzahl von einer Vertauschung (logischerweise zweier Elemente) zur Generation jeder nächsten Permutation aus der / einer / ihrer Vorgängerpermutation (oder lexikographisch mit jeweils kompletter Neugeneration?!) aus (und sind damit in bezug auf deren Laufzeit tendenziell unterlegen), was ich zunächst so an- und wahrnahm. Das scheint wohl doch nur der sehr neue Algortihmus des Herren (?) Viktorov von der Ammaner Universität von 2007 zu bieten. Er äußerte sich ja auch in dahingehend.
Genial wäre es nun noch, einen Algoritmus mit jeweils nur einer Vertauschung pro Generationsschritt zu entwerfen, der die Inversionsanzahl der Permutation(en) immer nur um 1 ändert - aber das ist schon theoretische bzw. "höhere" Informatik.
Delphi-Laie - Do 09.05.13 20:53
Nach Jahren möchte ich diese Diskussion noch einmal aufwärmen; zunächst geht es nochmal um diese Bemerkung:
Horst_H hat folgendes geschrieben : |
Was ich noch nicht gefunden habe ist eine nextpermutation, mit jeweils nur einer Tauschung. |
sowie ein Eigenzitat aus dem Beitrage zuvor:
Delphi-Laie hat folgendes geschrieben : |
Ältere Permutationsalgorithmen, ob rekursiv oder iterativ, kommen anscheinend doch nicht mit der Minimalanzahl von einer Vertauschung (logischerweise zweier Elemente) zur Generation jeder nächsten Permutation aus der / einer / ihrer Vorgängerpermutation (oder lexikographisch mit jeweils kompletter Neugeneration?!) aus (und sind damit in bezug auf deren Laufzeit tendenziell unterlegen), was ich zunächst so an- und wahrnahm. Das scheint wohl doch nur der sehr neue Algortihmus des Herren (?) Viktorov von der Ammaner Universität von 2007 zu bieten. Er äußerte sich ja auch in dahingehend.
Genial wäre es nun noch, einen Algoritmus mit jeweils nur einer Vertauschung pro Generationsschritt zu entwerfen, der die Inversionsanzahl der Permutation(en) immer nur um 1 ändert - aber das ist schon theoretische bzw. "höhere" Informatik. |
Natürlich gibt es einen solchen Algorithmus schon längst (seit den 60ern), er heißt Steinhaus-Johnson-Trotter-Algorithmus. Er wird in
http://www.math.uiowa.edu/~goodman/22m150.dir/2007/Permutation%20Generation%20Methods.pdf beschrieben. Ich hatte die Datei schon länger, überlas das jedoch beim Kampfe durch das Angelsächsisch. Letztlich zum Ziele führte mich jedoch
http://www.textarchiv.alojado.de/text/permutationen_erzeugen-ap1070.html. Jedenfalls fand ich zu diesem Algorithmus nichts auf Deutsch, geschweige denn, in Pascal.
Im Anhang ist ein auf die Schnelle zusammengewerkeltes Beispielprojekt. Bei der Eingabe der zu permutierenden Elementemenge am besten nur voneinander verschiedene Elemente in aufsteigender Reihenfolge, also z.B. "123" oder "ABCDE" o.ä. eingeben. Anhand der Inversionsanzahlen und der Differenz zur Anzahl der Inversionen zur Vorgängerpermutation kann man erkennen, daß immer nur benachbarte Elemente getauscht werden. Wiederum hat der Quelltext mehr Labels als Schleifen. Daß BenBE nochmal als Helfer in der gar nicht vorhandenen Not einspringt, diese Labels zu eliminieren, wage ich nicht zu hoffen. Mir gelang es bisher nicht.
Horst_H - Fr 10.05.13 08:31
Hallo,
die Goto's habe ich mit einer Dummy-Repeat Schleife und Abfrage der Abbruchbedingung eliminiert.
Es ist schneller als nextPermLex und permMove. Bei n= 12 4.1 s statt 4.3 s/4.6 s
Diese first wird doch eigentlich nur gebraucht, um die letzte Ausgabe zu machen.
Die Initialisierung wird wirklich nur einmal aufgerufen.Die Felder habe ich nicht dynamisch erzeugt. Das macht freepascal langsam und N= 19 will niemand abwarten ;-)
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: 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:
| Program PermSteinJohnsTrott; {$IFDEF FPC} {$MODE DELPHI} {$Optimization ON} {$Optimization RegVar} {$Optimization PEEPHOLE} {$Optimization CSE} {$Optimization ASMCSE} {$Else} {$APPTYPE console} {$Endif}
uses sysutils,classes; type tFeld= array[0..19] of Integer; var T1,T0: TDateTime; sl : TStringlist; zaehler:cardinal;
procedure GetPermutations(x:string); var p,d : tFeld; Nr : longint;
i, k,l,n:integer; first:boolean;
h:char; {$IFDEF AUSGABE} InvCnt_alt,InvCnt_neu, sAusgabe : String; function InvCnt:word; var k,l:word; begin result:=0; for k:=1 to pred(length(x)) do for l:=k to length(x) do if x[k]>x[l] then inc(result); end; {$ENDIF} function Init(j: integer): boolean; begin writeln('Init '); for j := j downto 2 do Begin p[j]:=0; d[j]:=1 end; result :=false end;
begin {$IFDEF AUSGABE} InvCnt_alt:=1; Nr := 1; For i := n downto 2 do Nr := Nr*i; sl.capacity := Nr; {$EndIF} n := length(x); zaehler:=0; Nr := 0;
first:= true; IF first then first := Init(length(x));
repeat n:=length(x); For i := n-1 downto 0 do Begin k:=0; repeat l:=p[n]+d[n]; inc(zaehler); p[n]:=l; if l=n then begin d[n]:=-1; if n>2 then begin dec(n); continue end else break; end; if l<>0 then break; d[n]:=1; inc(k);
if n>2 then dec(n); until false;
IF L= n then begin l:=1; first:=true; end;
inc(Nr); {$IFDEF AUSGABE} InvCnt_neu:=InvCnt; sAusgabe := Format('%s %5d InvZahl %3d DiffInvZahl %3d',[x,Nr,InvCnt_neu,InvCnt_neu-InvCnt_alt])); sl.add(sAusgabe); InvCnt_alt:=InvCnt_neu; {$ENDIF}
l:=l+k; h:=x[l]; x[l]:=x[succ(l)]; x[succ(l)]:=h; end; until first; Writeln(Nr); end;
procedure FormCreate(s : string);
begin T0 := now; GetPermutations(s); T1 := now; end;
var i : integer; s : String; Begin formcreate( '123456789'); {$IFNDEF AUSGABE} s := '123456789ABC'; FormCreate(s); {$ELSE} s := '12345'; sl := TStringlist.create; FormCreate(s); i:= sl.count; writeln(i); sl.sorted := true; sl.sorted := false; sl.add(''); sl.add('Anzahl Permutationnen '+IntToStr(i)); sl.add(''); sl.add('Aufrufe zur Bestimmung der Tauschstelle '+InttoStr(Zaehler)); sl.add(''); sl.add(Format('Relation %5.3f',[Zaehler/i])); writeln(sl.text); sl.free; {$ENDIF} writeln(FormatdateTime('HH:NN:SS.zzz',T1-T0)); end. |
Gruß Horst
Delphi-Laie - Fr 10.05.13 17:27
Hallo Horst, vielen Dank für Deine Reaktion und Dein Interesse!
Dir gelang es, die Labels / gotos zu eliminieren, auch dafür ein ganz dickes Dankeschön und ein genausodickes Lob! Ich muß mich nochmal damit beschäftigen, ganz schlau bin ich daraus noch nicht geworden.
Tatsächlich ist es möglich, das p- und d-Array nur einmal zu initialisieren, bzw. es ist nur ein einmaliges Initialisieren nötig, also ist es in der großen repeat-Schleife deplaciert.
Doch ein klein wenig Redundanz ist Dir dabei doch passiert:
Delphi-Quelltext
1: 2: 3:
| first:= true; IF first then first := Init(length(x)); |
Erst setzt Du first auf true, fragst es danach ab (die Bedingung ist dann immer erfüllt) und setzt es dann in der Init-Funktion auf false. Es ist mithin einfacher, vor der großen repeat-Schleife einfach ein
Delphi-Quelltext
1: 2: 3: 4: 5: 6:
| for j:=2 to length(x) do begin p[j]:=0; d[j]:=1 end; first:=false; |
zu setzen.
Neu ist mir, daß der Zugriff auf dynamische Arrays (konkret deren Elemente) bei FPC-Compilaten langsamer als bei statischen sein soll. Trifft das für den lesenden und/oder schreibenden Zugriff zu? Außerdem hoffe ich, daß das nicht auch für die Delphi-Pendants zutrifft - oder doch?
Mithin liegen jetzt in dieser Diskussion zwei Permutationsenumerationsalgorithmen (welch ein monströses Wort!) auf der Basis nur einer Vertauschung (logischerweise zweier Elemente) zur Generierung der jeweils nächsten Permutation (was aufwandsminimiert ist) vor - ein sehenswertes Ergebnis!
Horst_H - Fr 10.05.13 18:34
Hallo,
dass Init habe ich erst rausgeschoben, um zu testen, ob man das so überhaupt mehrfach braucht und dass es nicht in der Hauptschleife Platz frisst.Kleine Schleife meistschnelle Schleife.
Aber dann war ich mir sicher, dass bei first = true die Schleife garantiert verlassen wird.
Das ist dann nur als Gag so geblieben.Das ist so kryptisch wie die Anordnung der Goto.
[offtopic]
Ich glaube, dass Delphi bei dynamischen Array wesentlich schneller war, was ich nicht mehr auf Richtigkeit testen kann. Aber ich bin mehr sicher, da freepascal wesentlich schneller geworden ist.
Vor Jahren hatte ich bei 4 gewinnt 3 Schleifen geschachtelt und im Assemblerlisting belegte der äußere Schleifenindex hartnäckig ein Register und der innere Schleifenindex griff ständig auf seine Speicheradresse zu, grauselig.Deshalb habe ich möglichst kleine Proceduren genutzt, um die Register frei zu bekommen.
Gruß Horst
IhopeonlyReader - Fr 10.05.13 19:33
mhh.. eine Sache.. die "Art" die am Anfang geschrieben wurde
For C:=123456789 to 987654321 do
if keineZiffer doppelt
//blabla
liefert auch Ergebnisse wie
1234567890 !
bei der Permutation werden solche Ergebnisse vernachlässigt, da die 0 keine im ersten String vorkommende Zahl ist !!!
Entweder geht es darum alle Zahlen zwischen 123456789 (und da wäre die erste eigentlich 012345678) und 987654321 herauszufinden, die keine Ziffer doppelt hat, oder jede "vertauschungsmöglichkeit", die dann entweder doppelte zulässt oder nicht..
was willst du?
Mit 0, dann gibt es 10*9*8*7*6*5*4*3*2 Möglichkeiten (3.628.800)
sonst nur 9*8*7*6*5*4*3*2 (*1) Möglichkeiten (362.880)
Delphi-Laie - Sa 11.05.13 10:32
IhopeonlyReader, ich verstehe das Anliegen Deines vorigen Beitrage nicht recht.
"123456789" ist ein aus 9 Elementen bestehender String. Wie soll dort eine zusätzliche "0" hineingeraten?
Auch im Eröffnungsbeitrage war von einer "0" in der zu permutierenden Elementemenge nie die Rede. Das stellst auch Du richtig fest. Warum erwähnst Du dann das offenslichtliche überhaupt? Im Eröffnungsbeitrage und im Diskussionsverlauf war ja auch bisher nicht von Wellensittichen die Rede, also unterließ ich es bisher, sie zu erwähnen.
Zudem ist 1234567890 > 987654321. Doch 987654321 war als Obergrenze festgelegt. Also kann die For-Schleife nicht bis zu 1234567890 gelangen.
Wie man die Anzahl der Permutationen für 9 bzw. 10 Elemente berechnet, mußt Du nun wirklich nicht noch mal erläutern.
Abgesehen davon, daß nicht klar ist, wen Du meinst, mache ich daraus nun eine Retourkutsche: Was wolltest Du mit Deinem letzten Beitrage bezwecken?
IhopeonlyReader - Sa 11.05.13 12:09
hätte er die Methode mit der Schleife gewählt, wäre auch die Zahl
123456790 durchlaufen.. da hier ebenfalls keine Ziffer doppelt vorkommt, wäre es nach seiner Schleife einer Lösung, nach der Permutation aber nicht !
Die Frage, welche Methode willst du? war den Ersteller des Threads gerichtet
Delphi-Laie - Sa 11.05.13 12:29
IhopeonlyReader hat folgendes geschrieben : |
hätte er die Methode mit der Schleife gewählt, wäre auch die Zahl
123456790 durchlaufen.. |
durchlaufen
worden.
Nein, wäre eben nicht, weil 1234567890>987654321. Wann verinnerlichst Du das endlich?
Recht hast Du nur insofern, als daß bei einer for-Schleife natürlich auch Zahlen entstanden wären, die 0(en) behinhaltet hätten.
Doch die For-Schleife ist zur Enumeration von Permutationen ohnehin denkbar ungeeignet, wenn auch bei Anwendung eines geeigneten Siebes nicht untauglich.
IhopeonlyReader hat folgendes geschrieben : |
da hier ebenfalls keine Ziffer doppelt vorkommt, wäre es nach seiner Schleife einer Lösung, nach der Permutation aber nicht ! |
??
Verstehe ich leider nicht. Edit: Nach wiederholtem Lesen ahne ich, was Du meinst. Dann treffen meine Aussagen zuvor zu. Soweit war diese Diskussion schon längst.
IhopeonlyReader hat folgendes geschrieben : |
Die Frage, welche Methode willst du? war den Ersteller des Threads gerichtet |
Dem werden wir nach ein paar Jahren ohnehin wahrscheinlich nicht mehr helfen (können), aber vielleicht ist sein Anliegen auch bei ihm wieder aufwärmbar. Inzwischen geht es hier um die generelle Permutationsenumeration.
IhopeonlyReader - Sa 11.05.13 15:15
Delphi-Laie hat folgendes geschrieben : |
Nein, wäre eben nicht, weil 1234567890>987654321. Wann verinnerlichst Du das endlich? |
wann Liest du genau?
nicht 1234567890 sondern 123456790 ! (123456789+1)
somit diese zahl eine Lösung, die bei seiner Schleife enstanden wäre!
Ihr betrachtet jetzt aber nur "Vertauschungen" ! ihr lasst also 90% der lösungen außer acht !
Oder ihm geht es wirklich nur um die Vertauschung aller Ziffern und dann wäre sein "erster Einfall" falsch
jfheins - Sa 11.05.13 15:24
IhopeonlyReader hat folgendes geschrieben : |
Ihr betrachtet jetzt aber nur "Vertauschungen" ! ihr lasst also 90% der lösungen außer acht !
Oder ihm geht es wirklich nur um die Vertauschung aller Ziffern und dann wäre sein "erster Einfall" falsch |
Ja genau das hat er soch schon im Originalpost geschrieben:
Zitat: |
dies erscheint mir aber nicht sehr elegant und schnell, da sehr viele zahlen "umsonst" erzeugt werden. Ich bin mir sicher es gibt eine bessere Lösung, ich komme nur nicht drauf. |
Delphi-Laie - Sa 11.05.13 15:28
IhopeonlyReader hat folgendes geschrieben : |
nicht 1234567890 sondern 123456790 ! (123456789+1)
somit diese zahl eine Lösung, die bei seiner Schleife enstanden wäre! |
Und? Soweit war diese Diskussion doch längst! Es entstehen bei der For-Schleife auch bannig viele "Lösungen", bei denen mehr als eine Ziffer vorhanden ist - wir haben aber von jeder nur eine (außer der Null).
IhopeonlyReader hat folgendes geschrieben : |
Ihr betrachtet jetzt aber nur "Vertauschungen" ! ihr lasst also 90% der lösungen außer acht ! |
Das sind keine "Lösungen", sondern Ziffernwiederholungen und auch die Null wurden ausgeschlossen. Nur die Anzahl der verschiedenen Anordnungen (Anordnungsmöglichkeiten) einer vorgegebenen Elementemenge - und schon sind wir wieder bei den Permutationen.
Übrigens, die Anzahl der Schleifendurchläufe ("Lösungen") ins Verhältnis zur Anzahl der Permutationen gesetzt: (1+987654321-123456789)/10!=0,0041990399896223725970761362957975.... bedeutet, daß nur ca. 0,42% der Schleifendurchläufe ein gewünschtes Ergebnis, eben eine Permutation erzeugen. Also lassen "wir" sogar über 99% der "Lösungen" außer acht. Das zeigt die Ineffizienz der Schleifen-Filter-Variante deutlich.
IhopeonlyReader hat folgendes geschrieben : |
Oder ihm geht es wirklich nur um die Vertauschung aller Ziffern und dann wäre sein "erster Einfall" falsch |
Bingo alias Groschenfall.
IhopeonlyReader - Sa 11.05.13 15:28
ich hatte das so verstamdem, dass mit "umsonst erzeugt" umsonst durchlaufen/getestet werden
Mathematiker - So 12.05.13 07:33
Hallo,
da mich solche Zahlprobleme immer interessieren, habe ich es auch einmal versucht.
Allerdings erweitere ich das Problem auf:
Zitat: |
Ordnet man die k-elementigen Teilmengen einer n-elementigen Menge in beliebiger Reihenfolge an, so ergeben sich die k-Permutationen dieser Menge.
Diese entsprechen den Variationen zur k-ten Klasse. Da es (n über k) k-Teilmengen gibt, die je auf k! Arten angeordnet werden können, gibt es insgesamt (n über k) k! = n!/(n-k)! k-Permutationen. |
Und diese k-Permutationen versuche ich zu ermitteln. Ist n=k ergibt sich das ursprüngliche Problem.
Die Routine
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: 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:
| procedure TForm1.BerechnenClick(Sender: TObject); var n,k,anz,h,i,m:integer; x,y:array[1..20] of integer; t1:int64; liste:tstringlist; procedure ausgabe; var i:integer; kk:string; begin kk:=''; for i:=1 to k do kk:=kk+inttostr(x[i])+' '; liste.add(kk); application.processmessages; end; begin listbox1.clear; liste:=tstringlist.create; n:=updown1.position; k:=updown2.position; if k>n then k:=n; anz:=0; if k=n then m:=k-1 else m:=k; for i:=1 to n do x[i]:=i; for i:=1 to m do y[i]:=i;
t1:=gettickcount; i:=m; inc(anz); {$IFDEF Ausgabe} ausgabe; {$ENDIF} repeat if y[i]<n then begin inc(y[i]); h:=x[i]; x[i]:=x[y[i]]; x[y[i]]:=h; i:=m; inc(anz); {$IFDEF Ausgabe} ausgabe {$ENDIF} end else begin repeat h:=x[i]; x[i]:=x[y[i]]; x[y[i]]:=h; dec(y[i]); until y[i]<=i; dec(i); end; if anz mod 100000 = 0 then begin label3.caption:=inttostr(x[1]); application.processmessages; end; until (i=0); liste.add(inttostr(anz)); liste.add(inttostr(gettickcount-t1)+' ms'); listbox1.items:=liste; liste.free; end; |
berechnet diese k-Permutationen.
Horst_H hat folgendes geschrieben : |
Es ist schneller als nextPermLex und permMove. Bei n= 12 4.1 s statt 4.3 s/4.6 s |
Leider bin ich von diesen Geschwindigkeiten wieder meilenweit entfernt. Für n = k = 12 brauche ich (ohne Anzeige) knapp 17 Sekunden.
Aber zumindest ermittelt das kleine Programm auch die oben beschriebenen k-Permutationen.
Beste Grüße
Mathematiker
Nachtrag: Durch
Horst_H habe ich erfahren, dass es in der EE schon Hinweise zu "Permutation mit Doppelten" gibt. siehe
http://www.entwickler-ecke.de/viewtopic.php?t=95273&highlight=5aus8
Horst_H - Mi 15.05.13 07:11
Hallo,
Deine Version mit FPC auf Linux 64-Bit ( qword statt integer ) compiliert rennt doch schnell:
Quelltext
1: 2: 3: 4: 5:
| # ./Perm n=12,k=12 479001600 00:00:04.704 |
Das sind knapp über 31 CPU-Takte pro Permutation.
Jetzt fällt mir aber auf, Du hast gar keine Permutation mit Doppelten darin, wie kam ich denn darauf???
Gruß Horst
Horst_H - Do 16.05.13 14:59
Hallo,
ich habe Perm5aus8 ausgemistet.
Ich ziehe also k=5 Karten aus einem Stapel Karten, in dem es n=8 verschiedene Typen gibt.
Die Anzahl des jeweiligen Typen kann 0..k sein.
Es werden alle möglichen Anordnungen davon erzeugt.
EDIT: Das nennt sich wohl Variation.
http://de.wikipedia.org/wiki/Variation_(Kombinatorik)#Variation_mit_Wiederholung
Aber hier nicht mit zurücklegen, sondern es gibt verschiedene Elemente in unterschiedlicher Vielfachheit.
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: 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:
| program Kombination;
{$IFDEF FPC} {$mode Delphi} {$DEBUGINFO-} {$R- $V- $O-} {$Optimization ON} {$Optimization regvar} {$Optimization PEEPHOLE} {$Optimization CSE} {$Optimization ASMCSE} {$CODEALIGN proc=32} {$ASMMODE INTEL} {$ELSE} {$APPTYPE CONSOLE} {$ENDIF}
uses sysutils; type nativeinteger = longInt;const KombLaenge =3 ; KL_1 = KombLaenge-1; n = KombLaenge+2; var PermCount: Int64; T1,T0 : int64; FeldAnzahl : array[0..n-1] of LongInt; Komb : array[0..KL_1] of byte;
function GetCPU_Time: int64; type TCpu = record HiCpu, LoCpu : Dword; end; var Cput : TCpu; begin asm RDTSC; MOV Dword Ptr [CpuT.LoCpu],EAX; MOV Dword Ptr [CpuT.HiCpu],EDX end; with Cput do result := int64(HiCPU) shl 32 + LoCpu; end;
procedure VerarbeitungKomb; var I : nativeinteger; Begin INC(PermCount);
For i := Low(Komb) to High(Komb) do write(Komb[i]:2); writeln; end;
procedure VerarbeitungKombZaehl; inline;
Begin INC(PermCount); end;
procedure permute(depth:nativeinteger); var i: nativeinteger; Begin IF depth > KL_1 THEN Begin VerarbeitungKomb; EXIT; end;
i := Low(FeldAnzahl); repeat IF FeldAnzahl[i] >0 then begin dec(FeldAnzahl[i]); Komb[depth] := i; permute(depth+1); Komb[depth] := 0; inc(FeldAnzahl[i]); end; inc(i); until i > High(FeldAnzahl); end;
procedure Init; var i: integer; sum: longint; begin randomize; repeat sum := 0; For i := Low(FeldAnzahl) to High(FeldAnzahl) do Begin FeldAnzahl[i] := random(3); inc(Sum,FeldAnzahl[i]); end; until Sum >= KombLaenge;
write(' Index: '); For i := Low(FeldAnzahl) to High(FeldAnzahl) do write(i:2); writeln; write(' Anzahl: '); For i := Low(FeldAnzahl) to High(FeldAnzahl) do write(FeldAnzahl[i]:2); writeln; writeln('Weiter mit <ENTER>') ; ReadlN; end;
var Time1,Time0: TDateTime; I: nativeinteger;
Begin Init;
Time0 := Time;T0 := GetCPU_Time; permute(0); T1 := GetCPU_Time;Time1 := Time;
writeln(PermCount:12,' Anzahl der Kombinationen'); writeln((T1-T0)/PermCount:12:5,' CPU-Takte pro Durchgang'); IF Time1-Time0 > 0 then Writeln((Time1-Time0)*(86000.0*1e9)/PermCount:12:6,' ns'); writeln(FormatDateTime('HH:NN:SS.ZZZ',Time1-Time0)); end. |
Die Ausgabe:
Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18:
| Index: 0 1 2 3 4 Anzahl: 0 1 2 0 0 Weiter mit <ENTER>
1 2 2 2 1 2 2 2 1 3 Anzahl der Kombinationen oder nur Zählen mit 7 aus 10 wobei alle 7 fach vorhanden: Index: 0 1 2 3 4 5 6 7 8 9 Anzahl: 7 7 7 7 7 7 7 7 7 7 Weiter mit <ENTER>
10000000 Anzahl der Kombinationen 27.40196 CPU-Takte pro Durchgang 7.763889 ns 00:00:00.078 |
Am langsamsten ist es, bei der jeweiligen Anzahl = 1
5 aus 8 ~43 CPU-Takte und 12 aus 12 = 12!
28 Sekunden== 188 CPU-Takte, da ist auch der Aufwand inc/ dec und die Vegleiche>0 einfach zu groß.
Gruß Horst
Delphi-Laie - Fr 17.05.13 11:02
Mal wieder ein Eigenzitat:
Delphi-Laie hat folgendes geschrieben : |
Wiederum hat der Quelltext mehr Labels als Schleifen. Daß BenBE nochmal als Helfer in der gar nicht vorhandenen Not einspringt, diese Labels zu eliminieren, wage ich nicht zu hoffen. |
Mein lauter Gedankengang wurde erhöret: Der gute Benny Baumann (BenBE) half mir dankenswerterweise auch diesmal. Er benutzte dafür eine Software namens "Git", die die verpönten Labels und gotos automatisch entfernt. Herausgekommen ist eine Lösung mit zirkulärem Prozeduraufruf (Anhang). Ich halte das nicht für eine echte Verbesserung der Übersichtlichkeit und vermied deshalb so etwas bis heute. Zum Glück wußte ich aber, daß man mit der forward-Deklaration so etwas zum Compilieren und Laufen bringen kann, deshalb soll das ganze auch hier der Vollständigkeit halber veröffentlicht werden.
Auch Herrn Sedgewicks veröffentlichte 3 Algorithmen zu Steinhaus-Johnson-Trotter übersetzte ich nach Pascal (und entdeckte dabei kleine Unsauberkeiten), kann sie hier auf Wunsch hin auch veröffentlichen.
Horst_H - Fr 17.05.13 13:44
Hallo,
ich dachte die Initialisierung könnte man vor die Schleife ziehen, ala :
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: 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:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) ListBox1: TListBox; procedure FormCreate(Sender: TObject); private public end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure GetPermutations(x:string); var zaehler:cardinal; i,inversionsanzahl_alt,inversionsanzahl_neu:byte; h:char; d:array of integer; p:array of byte; j,k,l,n:byte; first:boolean;
function inversionsanzahl:word; var k,l:word; begin result:=0; for k:=1 to pred(length(x)) do for l:=k to length(x) do if x[k]>x[l] then inc(result); end; procedure Ausgabe; Begin inversionsanzahl_neu:=inversionsanzahl; Form1.ListBox1.Items.Add(inttostr(zaehler)+': '+x+', Inversionsanzahl: '+inttostr(inversionsanzahl_neu)+', Differenz: '+inttostr(inversionsanzahl_neu-inversionsanzahl_alt)); Form1.ListBox1.Refresh; Form1.ListBox1.TopIndex:=pred(Form1.ListBox1.Items.Count); inversionsanzahl_alt:=inversionsanzahl_neu; end;
procedure step1;forward;
procedure step2; begin if n>2 then begin dec(n); step1 end else begin l:=1; first:=true end end;
procedure step1; begin l:=p[n]+d[n]; p[n]:=l; if l=n then begin d[n]:=-1; step2 end else if l=0 then begin d[n]:=1; inc(k); step2 end end;
begin inversionsanzahl_alt:=1; setlength(d,succ(length(x))); setlength(p,succ(length(x))); zaehler:=0; for j:=1 to n do begin p[j]:=0; d[j]:=1 end; first:=false;
repeat n:=length(x); for i:=1 to length(x) do Begin k:=0;
step1; inc(zaehler);
Ausgabe;
l:=l+k; h:=x[l]; x[l]:=x[succ(l)]; x[succ(l)]:=h; end until first end;
procedure TForm1.FormCreate(Sender: TObject); var s:string; begin Form1.Show; s:=Inputbox('Zu permutierenden String eingeben','String?',s); GetPermutations(s) end;
end. |
Meine Goto-Freie Version
http://www.entwickler-ecke.de/viewtopic.php?t=74423&postorder=asc&start=27 braucht zumindest keine Rekursion, Step1-> Step2->Step1...
Aber muss diesen einen Vergleich machen l=n, welcher aber auch wirklich nur einmal durchlaufen wird -> Gute Sprungvorhersage.
Sollte so etwas,wie Steinhaus-Johnson-Trotter/permLex nicht mal in Delphi Library, die etwas dünn besetzt ist.
http://www.entwickler-ecke.de/forum_Algorithmen+Optimierung+und+Assembler_77.html
Permutation/Kombination/Variation
Man muss es ja nicht auf Strings beschränken, wie man am 8-Damen Problem ja sieht.
Gruß Horst
Delphi-Laie - Fr 17.05.13 14:44
Hallo Horst!
Horst_H hat folgendes geschrieben : |
ich dachte die Initialisierung könnte man vor die Schleife ziehen, ala : |
Dazu äußere ich mich jetzt nicht (keine Kraft und Lust, mich da hineinzudenken), aber hierzu:
Ja, Deine Lösung war die erstere und noch übersichtlichere. Ich kann Deinem Beitrag aber nur einmal den Dank verpassen.
Horst_H hat folgendes geschrieben : |
Aber muss diesen einen Vergleich machen l=n, welcher aber auch wirklich nur einmal durchlaufen wird -> Gute Sprungvorhersage. |
Dito, keine Äußerung dazu. Nicht jetzt.
Horst_H hat folgendes geschrieben : |
Sollte so etwas,wie Steinhaus-Johnson-Trotter/permLex nicht mal in Delphi Library, die etwas dünn besetzt ist. |
Algorithmen gibt es (abzählbar) unendlich viele, man wird also immer etwas finden, was dort fehlt. Wegen meiner gern. Ich hätte schon genug Algorithmen aus der 1. Hälfte der 90er beizusteuern (die ich allerdings abtippen müßte), überwiegend kombinatorische, alle damals selbst geschrieben, und sicher keine genialen, neuwertigen, aber funktionierende.
Horst_H hat folgendes geschrieben : |
Man muss es ja nicht auf Strings beschränken, wie man am 8-Damen Problem ja sieht. |
Strings sind eine unverselle, flexible und gleichzeitig recht simple Datenstruktur. Da sie implizit auch Arrays (of char) sind, sind damit Arrays automatisch gleich impliziert.
BenBE - Fr 17.05.13 17:05
Delphi-Laie hat folgendes geschrieben : |
Mal wieder ein Eigenzitat:
Delphi-Laie hat folgendes geschrieben : | Wiederum hat der Quelltext mehr Labels als Schleifen. Daß BenBE nochmal als Helfer in der gar nicht vorhandenen Not einspringt, diese Labels zu eliminieren, wage ich nicht zu hoffen. |
Mein lauter Gedankengang wurde erhöret: Der gute Benny Baumann (BenBE) half mir dankenswerterweise auch diesmal. |
Unmögliches macht der liebe Gott sofort, Wunder brauchen etwas länger ;-)
Delphi-Laie hat folgendes geschrieben : |
Er benutzte dafür eine Software namens "Git", die die verpönten Labels und gotos automatisch entfernt. |
DAS Feature habe ich noch nicht gefunden. Gleich mal bei Linus Torvalds beantragen :twisted:
Git ist eine Versionsverwaltung, die an der Stelle recht praktisch war, um die Vorgehensweise recht gut zu demonstrieren, da man Einzelschritte abspeichern kann. Muss nur die Patch-Serie noch etwas aufräumen, falls da Interesse besteht.
Delphi-Laie hat folgendes geschrieben : |
Herausgekommen ist eine Lösung mit zirkulärem Prozeduraufruf (Anhang). Ich halte das nicht für eine echte Verbesserung der Übersichtlichkeit und vermied deshalb so etwas bis heute. Zum Glück wußte ich aber, daß man mit der forward-Deklaration so etwas zum Compilieren und Laufen bringen kann, deshalb soll das ganze auch hier der Vollständigkeit halber veröffentlicht werden. |
Es sei angemerkt, dass der Code OHNE Compiler umgebaut wurde... Hatte grad keine Lust meinen anderen Rechne zu starten.
Horst_H - Di 21.05.13 10:34
Hallo,
ich habe mal die anderen Versionen nochmals getestet.
Fiete Version mit Move ist bei tDat = Byte am schnellsten.
permute_i bei Longint.
Eine Stringvariante, die die innersten Permutationen von 3 Positionen gespeichert hat, ist auch nicht übel.Das könnte man bei char/byte, auf 4 Positionen erweitern und einen LongInt zusammenstellen, aber das geht zu sehr in Richtung Assembler.
Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16:
| Mit tDat = Byte: Permute_i 479001600 Anzahl der Kombinationen 35.39909 CPU-Takte pro Durchgang 11.009300 ns 00:00:05.298 Permute_Move 479001600 Anzahl der Kombinationen 23.70283 CPU-Takte pro Durchgang 7.370703 ns 00:00:03.547 Permute_s 479001600 Anzahl der Kombinationen 10.78625 CPU-Takte pro Durchgang 3.353909 ns 00:00:01.614 |
Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11:
| tDat = LongInt Permute_i 479001600 Anzahl der Kombinationen 24.81255 CPU-Takte pro Durchgang 7.715653 ns 00:00:03.713 Permute_Move 479001600 Anzahl der Kombinationen 36.27229 CPU-Takte pro Durchgang 11.279441 ns 00:00:05.428 |
Damit sind diese Permutationen schneller als Steinhaus-Johnson-Trotter mit 4.1s, nun 3,5 .. 3,7 Sekunden und getrickst 1,6s
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: 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: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299:
| program Variation;
{$IFDEF FPC} {$mode Delphi} {$DEBUGINFO-} {$R- $V- $O-} {$Optimization ON} {$Optimization regvar} {$Optimization PEEPHOLE} {$Optimization CSE} {$Optimization ASMCSE} {$CODEALIGN proc=32} {$ASMMODE INTEL} {$ELSE} {$APPTYPE CONSOLE} {$ENDIF}
uses sysutils; const k =10; KL_1 = k-1; n = k+3; type tDat = Byte; tKombIndex = 0..KL_1; tKomb = array[tKombIndex] of tDat;
tCallBack = function (const Komb:tKomb;depth:longInt): boolean; tPerm = procedure (depth:nativeint); var T1,T0 : int64; PermCount: LongWord; FeldAnzahl : array[0..k-1] of LongInt; Komb : tKomb;
verarbeite: tCallBack;
s: string; sKomb: pChar; Index : tDat;
function Check(const Komb:tKomb;depth:longInt): boolean; begin result := true;end;
function Check_Ausg(const Komb:tKomb;depth:longInt): boolean; var i : integer; t: string[3]; s: string[2*k+1]; begin i:= 0; s:=''; repeat str(Komb[i]:2,T); s := s+t; inc(i); until i>depth; writeln(s);
result := false; end;
procedure PermMove; var Tausch:tDat; begin inc(PermCount); Index:=K; while Index>0 do begin Tausch:=Komb[0]; MOVE(Komb[1],Komb[0],(Index-1)*SizeOf(Komb[0])); Komb[Index-1]:=Tausch; if Tausch=Index then dec(Index) else begin inc(PermCount); Index:=K; end; end; end;
function GetCPU_Time: int64; type TCpu = record HiCpu, LoCpu : Dword; end; var Cput : TCpu; begin asm RDTSC; MOV Dword Ptr [CpuT.LoCpu],EAX; MOV Dword Ptr [CpuT.HiCpu],EDX end; with Cput do result := int64(HiCPU) shl 32 + LoCpu; end;
procedure Permute(depth:nativeint); var i: nativeint; Begin IF depth >= K THEN Begin inc(PermCOunt); EXIT; end; i := Low(FeldAnzahl); repeat IF FeldAnzahl[i] >0 then begin dec(FeldAnzahl[i]); Komb[depth] := i; permute(depth+1); inc(FeldAnzahl[i]); Komb[depth] := 0; end; inc(i); until i > High(FeldAnzahl); end;
procedure Init; var i,j: integer; sum: longint; begin
setlength(s,n); sKomb := @s[1]; For i in tKombIndex do Begin Komb[i] := i+1; sKomb[i] := chr(65+i); end;
randomize; repeat sum := 0; For i := Low(FeldAnzahl) to High(FeldAnzahl) do Begin j := random(3); FeldAnzahl[i] := j; inc(Sum,j); end; until Sum >= n;
write(' Index: '); For i := Low(FeldAnzahl) to High(FeldAnzahl) do write(i:2); writeln; write(' Anzahl: '); For i := Low(FeldAnzahl) to High(FeldAnzahl) do write(FeldAnzahl[i]:2); writeln;
PERMcount:=0; end;
procedure Permute_i(depth:nativeInt); var i: nativeInt; tmp : tDat; begin IF depth <= 0 then begin inc(PermCOunt); EXIT; end; i := depth+1; repeat dec(i); tmp:= Komb[depth]; Komb[depth]:=Komb[i]; Komb[i] := tmp; Permute_i(depth-1); Komb[i] := Komb[depth]; Komb[depth]:=tmp; until i<= 0; end;
procedure Permute_s_3; var stmp : array[0..3] of char; s : pChar; begin
s:= sKomb; stmp[0] :=s[0];stmp[1] :=s[1]; inc(PermCount); stmp[2] :=s[2]; s[0]:= sTmp[1];s[1]:= sTmp[0]; inc(PermCount); s[1]:= sTmp[2];s[2]:= sTmp[0]; inc(PermCount); s[0]:= sTmp[2];s[1]:= sTmp[1]; inc(PermCount); s[1]:= sTmp[0];s[2]:= sTmp[1]; inc(PermCount); s[0]:= sTmp[0];s[1]:= sTmp[2]; inc(PermCount); s[1]:=stmp[1];s[2]:= stmp[2]; end;
procedure Permute_s(depth:nativeint); var i: nativeInt; tmp : char; begin IF depth<3 then begin Permute_s_3; EXIT; end; i := depth; repeat tmp:= sKomb[depth]; sKomb[depth]:=sKomb[i]; sKomb[i] := tmp; Permute_s(depth-1); sKomb[i] := sKomb[depth]; sKomb[depth]:=tmp; dec(i); until i< 0; end;
procedure Testlauf(proc:tPerm;depth:nativeInt); var Time1,Time0: TDateTime; begin PermCount:= 0; Time0 := Time;T0 := GetCPU_Time; proc(depth); T1 := GetCPU_Time;Time1 := Time; writeln(PermCount:12,' Anzahl der Kombinationen'); IF PermCOunt>0 then begin writeln((T1-T0)/PermCount:12:5,' CPU-Takte pro Durchgang'); IF Time1-Time0 > 0 then Writeln((Time1-Time0)*(86000.0*1e9)/PermCount:12:6,' ns'); end; writeln(FormatDateTime('HH:NN:SS.ZZZ',Time1-Time0)); end;
var
I: nativeint; Begin Init; IF k < 11 then Testlauf(@permute,0);
For i := Low(Komb) to High(Komb) do Komb[i] := i+1; Verarbeite := @Check; writeln('Permute_i'); Testlauf(@Permute_i,k-1);
writeln('Permute_Move'); For i := Low(Komb) to High(Komb) do Komb[i] := i+1; Testlauf(@PermMove,k);
writeln('Permute_s'); Testlauf(@Permute_s,k-1); writeln('Weiter mit <ENTER>') ; ReadLn; end. |
Gruß Horst
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2024 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!