Autor |
Beitrag |
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Mi 12.06.13 11:39
Mit dem Programm können Puzzle gelöst werden, die aus Pentominos zusammengesetzt sind.
Ein Pentomino ist ein Stein, der aus 5 Einheitsquadraten besteht. Die Quadrate müssen
mindestens eine gemeinsame Seite aufweisen.
Es gibt also genau 12 verschiedene Steine, die insgesamt eine Fläche von 60 Einheitsquadraten bedecken.
Es gibt 2339 Lösungen für das Rechteck 6x10, 2 Lösungen für 3x20, 368 Lösungen für 4x15 und
1010 Lösungen für 5x12.
Es können auch größere Muster erzeugt werden, die dann offene Felder(weiss) enthalten müssen.
So wäre ein Rechteck 13*5 denkbar mit einem Loch in der Mitte, das die Form eines Pentominos hat.
Weiter gibt es die Möglichkeit mit 9 von 12 Steinen jeden der 12 Steine mathematisch ähnlich in
dreifacher Größe nachzubilden.
Dabei kann noch die Bedingung gestellt werden, daß der abzubildende Stein nicht benutzt werden darf.
s. www.mathematische-ba...ien.de/pentomino.htm
Das Programm kann mit <ESC> abgebrochen werden. Alle Lösungen werden gespeichert und können einzeln
angezeigt werden.
Viel Spaß beim Experimentieren
Gruß Fiete
Edit1: neue Version, jetzt ohne Einfrieren
Edit2: es können fertige Muster geladen werden, Dank an Mathematiker
Edit3: es können eigene Muster kreiert und gespeichert werden
der Quelltext ist optimiert worden, Dank an Horst_H
Edit4: Es wird noch geprüft ob alle leeren Felder im Restfeld zusammenhängen
die Teileliste Aktuell enthält die Werte von Waagerecht bzw. Senkrecht
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
Zuletzt bearbeitet von Fiete am Di 09.07.13 13:28, insgesamt 7-mal bearbeitet
Für diesen Beitrag haben gedankt: Anika, Hidden, Horst_H, Mathematiker
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Mi 12.06.13 18:34
Hallo Fiete,
das Programm ist wieder sehr interessant. Das automatische Suchen nach Lösungen habe ich bei Pentominos zwar versucht, aber nicht geschafft.
Leider gibt es bei mir ein Problem. Markiere ich "alle Stellungen anzeigen", so friert das Programm nach etwa 4,7 Millionen Versuchen ein und kann nur noch über den Taskmanager beendet werden.
Das geschieht bei jeder eingestellten Rechteckgröße.
Beste Grüße
Mathematiker
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Fr 14.06.13 09:53
Moin Mathematiker,
das Einfrieren konnte ich nachvollziehen.
In der IDE läuft das Programm normal, als Anwendung leider nicht
Habe getestet und rumprobiert, meine vorläufige Lösung: habe ein Delay(10); eingebaut.
Frag mich nicht wieso der Einfriereffekt jetzt nicht eintritt.
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:
| procedure TPenta.Suchen(Tiefe:Integer); var ZStart,SStart,K,L,Antwort:Integer; Liste:TPosition; begin Start(ZStart,SStart); for K:=0 to 11 do begin if not Benutzt[K] then begin for L:=1 to P[K*8+1].Anzahl do begin inc(Versuch); if Passt(K,L,ZStart,SStart,Liste) then begin Benutzt[K]:=True; Setze(Liste,K+1); if Legen.Checked then begin Ausgabe.Repaint; Antwort:=MessageDlg('Weiter anzeigen?',mtConfirmation,[mbYes,mbNo,mbAbort],0); if Antwort=mrNo then Legen.Checked:=False; if Antwort=mrAbort then begin Abbruch:=True; exit; end; end; if Tiefe=TeileAnzahl then begin inc(Count); SetLength(FeldListe,Count+1); FeldListe[Count]:=Feld; Ausgabe.Repaint; LabelVersuche.Caption:=IntToStr(Versuch)+' Versuche, '+IntToStr(Count)+'-te Variante!'; LabelVersuche.Repaint; if GetAsyncKeyState(VK_Escape)<0 then begin Abbruch:=True; exit; end; if not AlleZeigen.Checked then if MessageDlg('Weiter Suchen?',mtConfirmation,[mbyes,mbNo],0)=mrno then Abbruch:=True else begin Versuch:=0;Screen.Cursor:=crHourGlass end else Delay(10) end else Suchen(Tiefe+1); if Abbruch then exit; Benutzt[K]:=False;Entferne(Liste); end end end end; end; |
Neue Version wird hochgeladen
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
Zuletzt bearbeitet von Fiete am Fr 14.06.13 10:27, insgesamt 1-mal bearbeitet
Für diesen Beitrag haben gedankt: Mathematiker
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Fr 14.06.13 10:01
Neue Version liegt vor.
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: Mi 19.06.13 13:45
Hallo Fiete,
die neue Version ist für mich hochinteressant. Damit kann ich jetzt testen, wie viele verschiedene Lösungsmöglichkeiten es für die einzelnen Bilder gibt.
Hochachtung! Den Quelltext muss ich mir genauer ansehen, da mir noch nicht klar ist, wie man so etwas programmiert.
Beste Grüße
Mathematiker
_________________ Töten im Krieg ist nach meiner Auffassung um nichts besser als gewöhnlicher Mord. Albert Einstein
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mi 19.06.13 19:56
Hallo,
ich konnte es in Turbo-Delphi wegen fehlendem spinEdit nicht kompilieren, und mopperte über ein fehlendes Semikolon vor einem end in records, was eigentlich da nicht sein braucht.
Das Anlegen der Teile erfolgt lückenlos und möglichst weit links
Also linke Seite und obere/untere Seite liegen dicht an, dachte ich zumindest, ist aber nicht so.
Die Hauptaufgabe übernimmt Passt.
Aber witzig, dass man eigene "Fehler" bei anderen sieht
Solche umgangssprachlichen Zeilen
// Wenn AN gleich 5 ist dann Ist Passt Wahr sonst ist Passt Falsch.
Delphi-Quelltext 1: 2: 3:
| if AN=5 then Passt:=True else Passt:=False; wie wäre Passt := AN=5; |
Gruß Horst
EDIT:
Jetzt fällt mir auf, was mich bei Passt so stört.
Für jede mögliche Lage eines Pentomino Teiles , wird jedes mal die Position der belegten Koordinaten bestimmt.Bei 6x10 eben 291 Mio Mal. nur 78 oder so ähnlich, aber um 10er Potenzen weniger.
Das hätte man doch vorab einmal beim Erzeugen machen können und in P statt das Teil in seiner 5x5 Umgebung nur als seine 5 Koordinaten = Position speichern können.
Edit2:
Ich habe es geändert und es ist auch etwas schneller mit etwa 42 Sekunden für 6x10 ( 9572 Varianten/42 = 272 1/Sekunde ohne Ausgabe 27 Sekunden/ 291 Mio Versuche), 95 Sekunden für die Version mit einfrieren der Anzeige, ab Variante 532( nur einmal getestet )
Ich habe statt sleep /delay nur ein application.processmessages nach dem repaint eingebaut.
Ich gehe davon aus, das die viele Zeichnerei die Nachrichtenwarteschlange überfüllt hat, aber die Berechnung nicht stoppt.
Aber irgendwie habe ich bei den Mustern mit Fehlstellen große Probleme, da stimmt etwas nicht mit der Anzahl der Zeilen und Spalten.
Edit3:
Ich hoffe, ich habe jetzt so ziemlich alles erwischt, aber manche Muster haben bei mir keine Lösung. Ich weiß aber nicht, ob das Absicht ist.
Durch leichte Abänderung von TPenta.Passt, was nun möglichst früh die Schleife abbricht und Einbau einer Ausgabe nur alle 0.5 Mio saust das Programm bei mir in 19.xx Sekunden für ein 6x10 Feld durch.Gänzlich ohne Ausgabe und Abfrage der Tastatur während der Suche, waren es 18.4 Sekunden, dann doch lieber Anzeige.
Edit 4: Neue Version unten, ohne Ausgabe für 6x10 knapp unter 13 Sekunden
Zuletzt bearbeitet von Horst_H am Do 27.06.13 12:26, insgesamt 2-mal bearbeitet
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Do 20.06.13 13:09
Moin Horst_H,
erstmal Danke für die Hinweise.
Die Anweisung Passt := AN=5; ist eleganter, meine Version stammt wie die
Urversion des Programms noch aus TP7-Zeiten(DOS).
Zitat: | Jetzt fällt mir auf, was mich bei Passt so stört. |
Hat mich auch gestört, mußte vorher noch einen Fehler in den Puzzleteilen finden und beseitigen.
Deine Idee mit application.processmessages ist mir leider nicht gekommen
Bei den Mustern muß noch in Zeile 619 eingefüht werden:
Delphi-Quelltext 1: 2:
| BrettBreite:=StrToInt(EditBreit.text); BrettLaenge:=StrToInt(Editlang.text); |
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Mi 26.06.13 10:48
Moin Horst_H,
habe die korrigierte Version angahängt.
Fehler war hier:
Delphi-Quelltext 1: 2: 3: 4:
| with Neu do begin TeilinPositionH(PTeil,PosH); TeilinPositionV(PTeil,PosV); end; |
Viel Spaß beim Testen.
Gruß Fiete
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
Für diesen Beitrag haben gedankt: Horst_H
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Do 27.06.13 12:24
Hallo,
ich habe es etwas umgemodelt und verarbeite die Muster direkt in ein passendes Format in einer Liste und beim Musterwechsel wird dieses direkt angezeigt.
Ein Quadrat ohne Ecken dauert ja ewig mit 50 Sekunden ( ohne Ausgabe ~44 ).Es sind auch knapp 1 Milliarde Versuche.
Gruß Horst
Edit:
Eine andere etwas kryptischere Version, mehr in Richtung Lazarus optimiert. Insbesondere Passt ist so langsamer in Delphi.
Ich habe die Permutationsbildung eingeführt, statt bei jedem Aufruf erst ein freies Element zu suchen.
Das sparte nicht viel.
Ich speichere das erste freie Feld, was mit Start gesucht wird nun ab.Damit durchsuche ich nicht jedesmal ab Koordinate 1/1 , obwohl der Stein zuvor schon bei z.B. 17/2 war.
Das sparte ein wenig.
Vorher die Liste der Varianten auf eine übermäßige Zahl zu setzen sparte sehr wenig.
Jetzt ist es bei 11.3 Sekunden für 6x10 ohne Ausgabe oder 40.4 Sekunden bei 8x8 ohne Ecken (1,01e9 Versuche).
Immer noch 128 CPU-takte pro Versuch
Man sollte mal zählen, wieviele Versuche "passen", ob es sich lohnt Setze und Entferne zu optimieren indem man in Tposition statt Koordinaten dort den Zeiger aus Feld[x,y] speichert.
Zuletzt bearbeitet von Horst_H am Mi 10.07.13 13:35, insgesamt 1-mal bearbeitet
Für diesen Beitrag haben gedankt: Fiete
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Do 04.07.13 10:04
Hallo,
ich habe eine tolle Seite zur Lösung dieser Art von Puzzle gefunden:
Erst dancing links, die ich erst einmal verstehen muss, und dann diese Seite:
www.mattbusche.org/blog/article/polycube/
Was ich oben ansprach, von wegen dem Passt und 5 Koordinaten zu testen lässt sich wohl umgehen:
Zitat: | De Bruijn's algorithm takes the tack of picking holes to fill. Now I previously said that when filling a hole, that for each orientation of each piece, an attempt must be made to place each of the piece's constituent cubes in that hole; but with de Bruijn's technique, only one of the cubes must be attempted. |
So schlecht ist Fiete Ansatz aber nicht.
www.mattbusche.org/b...olycube/#performance in der Zeile P-4 mit De Bruijn
braucht 6 Sekunden und die jetzige Version knapp über 11.
Gruß Horst
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Di 09.07.13 13:26
Moin Horst_H,
habe mein Programm noch überarbeitet.
Es gibt jetzt eine neue Liste im Record
Delphi-Quelltext 1: 2: 3: 4:
| for K:=0 to 11 do for L:=1 to P[K*8+1].Anzahl do with P[K*8+L] do if BrettLaenge>BrettBreite then Aktuell:=Waagerecht else Aktuell:=Senkrecht; |
Spart eine Abfrage in der function Passt.
In dieser habe ich noch einen Lückentest eingebaut, die Anzahl der Fehlversuche reduziert sich dadurch.
Die neue Version ist hochgeladen.
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 09.07.13 14:40
Hallo,
ich habe sogar eine (Lazarus ) Variante, in der vorab schon berechnet wird, ob ein Teil an sich an einer Stelle passt, wenn es allein auf der Welt wäre.Das sind ja nur 72*60 Tests. Weiße Felder fallen ohnehin weg.
Zu jedem Feld ein Bitfeld 0..MaximaleNummerDerPentominos (1/0 Passt/passtNicht).
Für die extreme Schlange brauche ich dann 40 Versuche, 955, aber man sieht die vorab 4320 Tests ja nicht.
Aber für 6x10 ergeben sich 183Mio statt 291 Versuche aber es ist trotzdem langsamer??? ( Wehe es liegt am vielleicht nicht abgeschaltetem Debugger , nachher nur daran das Lazarus mit Bitfeldern so merkwürdig umgeht. )
Deine Variante braucht nur 121 Mio Versuche und 23 Sekunden und gibst ja alle 16 die Daten aus:
if Count and 11 = 0 then begin ist ja wie (Count and 15) = 4, was den Vorteil hat, das man schon ab der 4.ten Lösung was sieht.
Vielleicht kannst Du ja auch mal die Variante aus dem Edit oben www.entwickler-ecke....ownload.php?id=15986 bei Dir testen.
Da kann man auch beim Muster füllen anklicken und es bleibt das Muster und nicht nur ein leeres Rechteck.
Ich gebe zu es entartet etwas in Geschwindigkeitsrausch, wobei es schon extrem viel schnellere Varianten gibt
Gruß Horst
EDIT:
Die skizzierte Variante habe ich korrigiert.
Ich hatte vergessen die Abfrage, ob ein Teil grundsätzlich passt, in dem Suchlauf zu entfernen, zudem habe ich passt statt checkpasst benutzt was die Position verändert
Jedenfalls bin ich ohne Ausgabe bei 6x10 bei ~8,2 Sekunden mit TurboDelphi
nunja der Autor erreicht Mattbusche mit P4 2.5 Ghz 6 Sekunden.
Vielleicht sollte ich noch den
www.mattbusche.org/b...lycube/#volumefilter einbauen.
Aber der Autor hat auch 178.983.597 Versuche bei 6x10.Aber er schreibt das hätte 13% gebracht.
Das Floodfill zum Test auf nicht belegbare Gebiete, muß ich mir mal zu Gemüte führen.
Einloggen, um Attachments anzusehen!
|
|
Fiete
Beiträge: 601
Erhaltene Danke: 339
W7
Delphi 6 pro
|
Verfasst: Do 11.07.13 15:49
Moin Horst_H,
Deine Optimierungen haben viel gebracht, Kompliment .
Meine Floodfill-Version hat zwar zu weniger Versuchen geführt aber nicht soviel Rechenzeit eingespart wie Deine Version.
Quadrat mit 4 Löchern; 92.565.790
Quadrat ohne Ecken: 262.541.350
Fazit: es gibt nichts was man nicht noch verbessern könnte.
Gruß an den Tüftler
Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1652
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Do 11.07.13 16:37
Hallo,
wenn man jetzt noch Symmetrien ausnutzt, indem ich einfach das Teil Kreuz aka "+", welches ja nur in ein Variante vorkommt nur in einer Symmetriehälfte verwende und falls diese auch symmetrisch ist eben nochmals teile, müßte ich doch auch nur ein 4tel der Lösungen erhalten bei Rechtecken und manchen Quadraten.
Aber: Spare ich dadurch an der Anzahl der Versuche?
Ich bräuchte dazu ein Funktion die mir sagt, alle Felder in denen "+" vorkommen kann, sind belegt Und "+" wurde noch nicht verwendet-> Abbruch der Rekursion.
Da meine Permutation aber einfach permutiert ohne irgendwelche Nummer zu speichern, was ich zeitsparend fand, muß ich eine Speicherung der Verwendung wieder einführen .
Aber eine Nummer eintragen und löschen ist immer schneller als 3-fache Menge an kompletten Versuchen.
Übrigens habe ich .Passt minimal geändert, sodass Position[1]== Startfeld nicht geprüft wird, da es als Startfeld garantiert leer ist, und somit nur Positionen 2..5 mit Feld getestet werden.Das brachte im Mittel so ungefähr gar nichts
Gruß Horst
|
|
|