Autor |
Beitrag |
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Do 06.11.14 14:52
QUADRATI spielt man auf neun Feldern, die entweder schwarz oder weiß sind.
Tippt man auf ein schwarzes Feld, so ändert sich nichts.
Tippt man auf ein weißes, so wird es schwarz und einige andere Felder
ändern ihre Farbe. Für den Farbwechsel gelten folgende Regeln:
Tippen auf ein weißes Eckfeld ändert die Farben des Eckfeldes, der
benachbarten Mittelfelder und des Zentrums.
Tippen auf ein weißes Mittelfeld ändert die Farben dieses Mittelfeldes
und der benachbarten Eckfelder.
Tippen auf das weiße Zentrum ändert die Farben des Zentrums und aller Mittelfelder.
Ein Zug wird rückgängig gemacht, indem Du einen RechtsClick auf die zuletzt gesetzte Position vornimmst.
Die Anfangs- und Zielstellung können per Zufall generiert oder selbst eingeben werden.
Positionen:
Ecke Mitte Ecke
Mitte Zent. Mitte
Ecke Mitte Ecke
Viel Spaß beim Knobeln.
Gruß Fiete
Edit1: Die Lösungssuche ist eingebaut.
Edit2: Die Lösungen können abgespielt werden
Einloggen, um Attachments anzusehen!
_________________ Fietes Gesetz: use your brain (THINK)
Zuletzt bearbeitet von Fiete am Di 18.11.14 20:05, insgesamt 2-mal bearbeitet
Für diesen Beitrag haben gedankt: Horst_H, jfheins, Mathematiker, Narses
|
|
Mathematiker
Beiträge: 2622
Erhaltene Danke: 1447
Win 7, 8.1, 10
Delphi 5, 7, 10.1
|
Verfasst: So 09.11.14 14:07
Hallo,
sehr schönes Spiel wieder, wenn gleich ich auch noch keine vernünftige Strategie gefunden habe, um schnell zur Lösung zu kommen.
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: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: So 09.11.14 21:58
Hallo,
wie schnell eine Lösung finden lassen
Wenn das Feld als Bits oder als eine Menge 0..8 auffasst kann man schneller damit arbeiten.
Obere linke Ecke als 0.tes Bit bis untere rechte Ecke als 9.Bit.
Umklappen der Bits geht ja mit XOR , da braucht es für jedes Feld nur eine Maske.
Links oben hätte als BitMaske [1,1,0, 1,1,0, 0,0,0]
Mitte oben hätte als BitMaske [1,1,1, 0,0,0, 0,0,0]
Mitte hätte als BitMaske [0,1,0, 1,1,1, 0,1,0] etc pp.
Dann gibt nur 2^9 = 512 mögliche Anordungen.Damit hat man schon mal eine Möglichkeit festzustellen, ob eine Anordung schon mal da war und die weitere Suche in dem Zweig damit endet, aber man kann in diese Anordung auch eintragen nach wieviel Zügen diese Stellung erreicht wurde, und wo man weitergemacht hat ( da gibt es ja nur maximal 9 Möglichkeiten, kann man ein Feld völlig weiß bekommen?Das habe ich noch nicht probiert. )
Vielleicht gibt es auch eine minimale Zugzahl X , die immer zum Ziel führt, sodass man nach X Zügen mit der weiteren Suche aufhören kann.Ich hoffe mal, das X sehr klein ist, aber es sind ja nur 512 tatsächliche Möglichkeiten vorhanden.
Mal schauen, was mir dazu einfällt.
Gruß Horst
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mo 10.11.14 17:39
Hallo,
Ich habe jetzt eine Breitensuche benutzt.
In einem Feld steht zu jeder der 512 Anordnungen die möglichen Nachfolger (weiß -> schwarz)/Vorfahren(schwarz könnte zuvor weiß gewesen sein) und noch ein Feld, indem der die Anordnung eingetragen wird, die als erstes dort anlangte.
Eine Liste verwaltet die möglichen Nachfolger.
Ich trage zu erst nur das Ausgangsfeld ein.an StartPos = EndPos= 0 ein.
Dann trage ich in diese Liste die Nachfolger EndPos+1 und folgende dort ein solange sie nicht in Anordnungsfeld als schon erreicht markiert sind.In Anordnungsfeld trage ich bei diesen Nachfolgern den Vorgänger an.
Dann rufe ich die selbe Funktion wieder auf, wobei sich Start und Endpos entsprechend angepasst haben.Abbruchbedingung ist das erreichen der Zielanordnung.
das Ausgangsbeispiel auf dem Bild oben löst mein Programm in 8 statt 12 Schritten.
Quelltext 1: 2: 3: 4: 5: 6: 7: 8:
| 1) (2 | 1) 2) (2 | 2) 3) (1 | 1) 4) (0 | 1) 5) (0 | 0) 6) (1 | 1) 7) (1 | 0) 8) (2 | 1) |
Dummerweise zeigt es mir nur die Stellungen an und nicht das Feld, das gedrücktwerden muss.Da bastel ich noch etwas.
Gruß Horst
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Mo 10.11.14 18:15
Moin Horst,
Du hast ja schon super getüftelt.
Hab mir schon gedacht dass dieses Problem für Dich eine Herausforderung sein könnte.
An eine rekursive Suche hatte ich selbst schon gedacht, konnte mich aber nicht aufraffen anzufangen.
Weiter viel Erfolg wünscht Fiete.
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mo 10.11.14 20:23
Hallo,
Jetzt habe ich mal alle Kombinationen = 511x511 = 261121 (Da ist viele Symmetrien drin ) getestet.
Maximal sind es 13 Züge ( Tiefe+1). Ein schwarzes Feld in der Ecke in das komplementäre Feld überführen.
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:
| program Quadconsole; {$IFNDEF FPC} {$APPTYPE console} {$ENDIF} uses sysutils; const cElemSide = 3; cElemCnt = 3*3; cElemHigh = cElemCnt-1;
type tElemIdx = 0..cElemHigh; tAnordnung = integer; tpAnordnung = ^tAnordnung; tNextPrev = record npAn :tAnordnung; npSw :tElemIdx; end; tpNextPrev = ^tNextPrev; trecFromTo = record ftToEnds: tAnordnung; ftPrev : tNextPrev;
ftNextPrev : array[tElemIdx] of tNextPrev; end;
tlsIdx = record lsStart, lsEnd : integer; end; const cAnOrdCnt = 1 shl cElemCnt; cColCnt = 3; cXORMaske: array[tElemIdx] of tAnordnung = (3+3 shl 3 ,7 ,6+6 shl 3, 1+1 shl 3+1 shl 6,2+7 shl 3+2 shl 6,4+4 shl 3+4 shl 6, 3 shl 3+3 shl 6, 7 shl 6, 6 shl 3+6 shl 6 );
type tarrAnOrd = array[0..cAnOrdCnt-1] of trecFromTo; tListe = array[0..cAnOrdCnt-1] of tNextPrev; tarrSum = array[0..cAnOrdCnt-1] of integer; var Anordnungen :tarrAnOrd; Liste : tListe; ListIdx : tlsIdx;
StartFeld, ZielFeld : tAnordnung;
tiefe: integer; ZielGefunden : boolean;
procedure Ausgabe(F:tAnordnung); const cAusgabe : array[boolean] of char = ('.','#'); var i : integer; Maske : tAnordnung; s: string; begin setlength(s,3); Maske := 1 SHL cElemHigh; Writeln(f:10); i := 1; repeat s[i] := cAusgabe[(Maske AND F) <> 0]; inc(i); if i> cColCnt then begin writeln(s); i := 1; end; Maske := Maske shr 1; until Maske = 0; end;
procedure MaskenAusgabe; var i : integer; begin For i := low(tElemIdx) to cElemHigh do begin Ausgabe(cXORMaske[i]); writeln; end; end;
procedure AnOrdEintueten(var AN:tarrAnOrd); var i,u,nr: integer; pUp,pDown : tpNextPrev; Maske : tAnordnung; begin i := 0; repeat u := low(tElemIdx); with AN[i] do begin pUp := @ftNextPrev[u]; pDown := @ftNextPrev[cElemHigh]; end; nr := cElemHigh; Maske := 1 SHL (cElemCnt-1); begin repeat IF (i AND Maske) = 0 then begin with pUp^ do begin npAN := i XOR cXORMaske[nr]; npSw := Nr; end; inc(pUp); inc(u); end else begin with pDown^ do begin npAN := i XOR cXORMaske[nr]; npSw := Nr; end; dec(pDown); end; dec(nr); Maske := Maske shr 1; until Maske = 0; with AN[i] do begin ftToEnds := u; ftPrev.npAn := -1;
end; end; inc(i); until i> High(AN); end;
procedure AnzahlProFeld(const AN:tarrAnOrd); var i,j: integer; Sum : tarrSum; begin fillchar(Sum,SizeOf(Sum),#0); For i := low(Sum) to High(Sum) do with AN[i] do For j := low(tElemIdx) to cElemHigh do inc(sum[ftNextPrev[j].npAN]); For i := low(Sum) to High(Sum) do If Sum[i]<> cElemCnt then writeln(i:4,Sum[i]:4); end; procedure ClearAN(var AN:tarrAnOrd); var i : integer; begin For i := Low(AN) to High(AN) do Anordnungen[i].ftPrev.npAn := -1; end;
procedure NachfolgerInListeEintragen( n:tNextPrev); var i : integer; k : tNextPrev; begin IF NOT ZielGefunden then Begin For i := Anordnungen[n.npAN].ftToEnds-1 downto 0 do begin k := Anordnungen[n.npAN].ftNextPrev[i]; with Anordnungen[k.npAn] do Begin IF ftPrev.npAn = -1 then begin inc(ListIdx.lsEnd); Liste[ListIdx.lsEnd]:= k; ftPrev := n; end; end; IF k.npAN = ZielFeld then begin ZielGefunden := true; BREAK; end; end; end; end;
procedure Check; var i, altEnd : integer; begin AltEnd := ListIdx.lsEnd; For i := ListIdx.lsStart to AltEnd do NachfolgerInListeEintragen(Liste[i]); IF Not(ZielGefunden) then begin ListIdx.lsStart := AltEnd+1; inc(Tiefe); Check; end else ;end;
var maxTiefe: integer;
BEGIN AnOrdEintueten(Anordnungen); Maxtiefe := 0; For StartFeld := 0 to 510 do For ZielFeld := 1 to 511 do begin IF ZielFeld <> Startfeld then begin ClearAN(Anordnungen); with ListIdx do begin lsStart := 0; lsEnd := 0; end; Liste[ListIdx.lsStart].npAN := StartFeld; ZielGefunden := false; tiefe := 0; Check; IF Tiefe > MaxTiefe then begin writeln(tiefe :4,StartFeld:4,Zielfeld:4); Ausgabe(StartFeld); Ausgabe(ZielFeld); MaxTiefe := tiefe; end; end; end; END. |
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:
| Tiefe/Startwert/Zielwert 5 0 1 0 ... ... ... 1 ... ... ..# 8 0 2 0 ... ... ... 2 ... ... .#. 9 1 494 1 ... ... ..# 494 ### #.# ##. 10 23 128 23 ... .#. ### 128 .#. ... ... 11 255 176 255 .## ### ### 176 .#. ##. ... 12 255 256 255 .## ### ### 256 #.. ... ...
real 0m0.869s user 0m0.867s sys 0m0.000s |
Wie man sieht, kann ich nicht geduldig knobeln...
Gruß Horst
|
|
C#
Beiträge: 561
Erhaltene Danke: 65
Windows 10, Kubuntu, Android
Visual Studio 2017, C#, C++/CLI, C++/CX, C++, F#, R, Python
|
Verfasst: Di 11.11.14 10:29
Hallo,
ich habe mich auch mal daran versucht einen kleinen Algo zu machen. Meiner ist allerdings in C#, weil ich von Delphi keine Ahnung habe .
Bei dem Beispiel oben komme ich auch auf 8 Schritte, die sich von Horsts Schritten unterscheiden.
Hier der Algorithmus:
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:
| public static readonly int[] OperationMasks = { Convert.ToInt32("110110000",2), Convert.ToInt32("111000000",2), Convert.ToInt32("011011000",2), Convert.ToInt32("100100100",2), Convert.ToInt32("010111010",2), Convert.ToInt32("001001001",2), Convert.ToInt32("000110110",2), Convert.ToInt32("000000111",2), Convert.ToInt32("000011011",2) };
public static List<Point> SingleTreeCalculation(int startMask, int endMask, int depth) { int[] values = new int[depth];
int[] indices = new int[values.Length];
List<Point> path = new List<Point>(); int count = values.Length - 1;
values[0] = startMask;
int i = 0;
while (i >= 0) { if (IsTrue(values[i], 8 - indices[i])) { values[i + 1] = values[i] ^ OperationMasks[indices[i]]; i++;
if (values[i] == endMask) { if (i < count) { count = i; path = new List<Point>(); for (int index = 0; index < count; index++) path.Add(new Point(indices[index] % 3, indices[index] / 3)); } indices[i] = 0; i--; if (i >= 0) indices[i]++; } } else if (indices[i] < 9) { indices[i]++; } else { indices[i] = 0; i--; if (i >= 0) indices[i]++; }
if (i >= count) { i--; indices[i]++; } }
return path; }
private static bool IsTrue(int val, int bit) { if (bit < 0) return false; return (val & (1 << bit)) != 0; } |
Und hier das Ergebnis:
C#-Quelltext 1: 2: 3: 4: 5: 6: 7: 8:
| 0) (2, 1) 1) (2, 0) 2) (1, 0) 3) (0, 0) 4) (2, 0) 5) (0, 1) 6) (2, 2) 7) (2, 1) |
_________________ Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 11.11.14 11:37
Hallo,
Die unterschiedlichen Schritte liegen auch an mehreren gleichlangen Wegen, die zum Ziel führen, zumal Start und Ziel sysmmetrisch sind.
Ich starte immer bei der "obersten" weiße Stelle und gehe dann rückwärts auf 0.Zudem breche ich beim ersten Ergebnis ab.Vielleicht sollte man da mal alle gleichlange Wege ausgeben lassen.
Wird der Baum bei Dir wirklich exponentiell groß? Bei Tiefe 12:
Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9:
| 12 255 256 255 .## ### ### 256 #.. ... ... | kannst Du mal den Speicherverbaruch testen.Bei immer ~ 4 Feldern immer weiß wären das 4^12 = 16Mio,. Schlechtes Beispiel, denn hier ist Beginn nur eine Möglichkeit und in Ebene 2 nur 3 sind also in der Gegend von 3 Mio.
Bei mir bleiben es 512. Eine Stellung die vorher schon mal aufgetreten ist, kann ja nicht auf dem kürzesten Weg liegen.
Gruß Horst
|
|
C#
Beiträge: 561
Erhaltene Danke: 65
Windows 10, Kubuntu, Android
Visual Studio 2017, C#, C++/CLI, C++/CX, C++, F#, R, Python
|
Verfasst: Di 11.11.14 14:28
Ja das mit den unterschiedlichen Wegen hab ich bemerkt. Ich habe mir alle Wege mal anzeigen lassen. Der Baum wird nur theoretisch exponentiell groß, da ja zu jeder neuen Tiefe/Ebene x neue, weiße Felder dazu kommen. Mein Speicherverbrauch ist relativ gering. Ich habe ja nur 2 List<int> die beide der Tiefe entsprechen. Also wenn Tiefe=12, beinhalten meine zwei Listen auch nur 12 Zahlen. Wenn man jede Ebene/Tiefe nacheinander rechnen würde, hätte man auch einen exponentiellen Speicherverbrauch. Mein Algorithmus rechnet aber bis zur letzten Ebene immer nur einen Wert. Also aus jeder Ebene wird genau ein weißes Feld benutzt. Wenn ich bei der letzten Ebene bin und das Ergebnis nicht übereinstimmt, nimmt der Algo das nächste weiße Feld aus dieser Ebene. Sind alle weißen Felder aus einer Ebene abgeklappert und immer noch keine Lösung vorhanden, geht der Algo eine Ebene zurück und wählt dort das nächste weiße Feld. Anschließend springt er wieder eine Ebene nach oben.
Ich lade nachher noch ein Bild hoch zum verdeutlichen was ich meine
_________________ Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 11.11.14 15:00
Hallo,
Gute Güte, dass ist ja Tiefensuche, da musst Da ja wirklich immer bis zur bisher maximalen Tiefe durchprobieren.Kann es Dir da nicht passieren in einen Zyklus zu geraten, also im Kreis zu gehen.Statt Start->Ziel nun Start -> A -> B-> A -> B etc pp, wenn Dir das beim ersten Duchgang passiert, hängst Du in einer Endlosschleife fest.
Da hatte ich die größten Bedenken.
Mir fällt auf, dass der Weg A-> B -> A immer beim ersten weißen Feld dann auftreten muss. Das macht die Sache dann noch theoretischer.
Gruß Horst
|
|
C#
Beiträge: 561
Erhaltene Danke: 65
Windows 10, Kubuntu, Android
Visual Studio 2017, C#, C++/CLI, C++/CX, C++, F#, R, Python
|
Verfasst: Di 11.11.14 17:14
So jetzt noch das Bild dazu:
Zuerst geht der Algo den roten Pfad. Anschließend geht er einen Schritt zurück und nimmt den blauen Pfad. Danach geht er wieder zurück und nimmt den grünen, dann den gelben, den lilanen, ... Pfad. Hat er einmal eine mögliche Lösung gefunden, setzt er das Maximum des Tiefenscans auf die Ebene der gefundenen Lösung, d.h. wenn ich bei Ebene 10 (also nach 10 Zügen) eine Lösung gefunden habe, sucht der Algorithmus nur noch bis zur 10ten Ebene. Wenn dann bei 8 eine Lösung gefunden wurde, scannt er noch bis zur 8ten Ebene.
Eine Endlosschleife erreiche ich nicht, da ich ja immer eine gewisse Tiefe für den Scan angebe, also z.B. 20 Schritte. Zugegeben: auf periodisches Verhalten prüfe ich nicht. Ich finde aber, dass sich dies bei einem 3x3 Feld nicht so wirklich lohnt :/
Ich hoffe man versteht mich
Einloggen, um Attachments anzusehen!
_________________ Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mi 12.11.14 22:14
Hallo,
jetzt ist mir ein Fall beim spielen aufgefallen, der oszillert, wenn man in der Rekursion immer mit dem ersten weißen ="_" Feld beginnt
Quelltext 1: 2: 3: 4:
| Start A B C Start _## #_# _#_ #__ _## ### __# __# ### ### ##_ ##_ ##_ ##_ ##_ |
Dabei würde Deine Rekursion nicht abbrechen, wenn depth nicht vorgegeben wäre und wer sagt einem wie groß es sein muss
int count = values.Length( = depth) - 1;
Man sieht also schon bei einem solchen Beispiel das schon, dass die 4 Anordnungen Start,A,B,C in einem Zyklus führen.Dabei ist nur die oberste Zeile wichtig, darunter hat man 2^6 Möglichkeiten irgendeiner Anordnung.
Gruß Horst
|
|
C#
Beiträge: 561
Erhaltene Danke: 65
Windows 10, Kubuntu, Android
Visual Studio 2017, C#, C++/CLI, C++/CX, C++, F#, R, Python
|
Verfasst: Mi 12.11.14 22:56
Abend,
wie gesagt: mein Algo erkennt kein periodisches Verhalten. Deshalb gebe ich ja auch einen Tiefenwert als Parameter mit. Ich hab nicht behauptet das mein Algo perfekt ist
_________________ Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Do 13.11.14 09:34
Hallo,
natürlich sehe ich das als quick'n'dirty Lösung.Auch bei der Tiefensuche hätte man den bisherigen Lösungsweg abklappern können, ob ein Wert schon mal vorgekommen ist oder ein seperates BitFeld mitführen können. Wie auch immer.
Deine Schätzwert für depth viel irgendwie vom Himmel
Ich wollte mal Breitensuche probieren, weil es offensichtlich eine maximale Breite= Anzahl der verschiedenen Stellungen gibt.
Bei großen Feldern 8x8 gibt es ja 2^(8x8) =2^64 Stellungen, da wäre Breitensuche ein Problem.
Gruß Horst
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: So 16.11.14 19:59
Moin,
jetzt hab ich mich aufgerafft.
Hier die rekursive Lösung:
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:
| procedure TQuad.Suche(Tiefe:Integer;SF:TFeld); var K,ZN,x,y,Index:Integer; ZugListe:Array[1..MaxZugListe]of TPoint; SFKopie:TFeld; begin ZN:=0; for y:=0 to 2 do for x:=0 to 2 do if SF[x,y]=0 then begin inc(ZN); ZugListe[ZN].X:=x; ZugListe[ZN].Y:=y; end; SFKopie:=SF; for K:=1 to ZN do begin SFAendern(ZugListe[K].X,ZugListe[K].Y,SF); Index:=FeldInDual(SF); if Benutzt[Index] then SF:=SFKopie else begin Benutzt[Index]:=True; Loesung[Tiefe].X:=ZugListe[K].X;Loesung[Tiefe].Y:=ZugListe[K].Y; if not Gleich(SF,Ziel) and (Tiefe<MaxTiefe) then Suche(Tiefe+1,SF); if Gleich(SF,Ziel) then begin if Tiefe<MaxTiefe then LAnzahl:=0; inc(LAnzahl); SetLength(EndLoesung,LAnzahl+1); EndLoesung[LAnzahl]:=Loesung; Gefunden:=True; MaxTiefe:=Tiefe; end; Benutzt[Index]:=False; SF:=SFKopie end end; end; |
Im Array Benutzt wird von jeder Stellung festgehalten ob sie schon benutzt worden ist, dies vermeidet Zyklen.
MaxTiefe wird zu Beginn auf 40 gesetzt.
Die neue Version ist hochgeladen.
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mo 17.11.14 10:54
Hallo,
ich habe mal
Quelltext 1: 2: 3: 4: 5: 6: 7:
| ##_ ### ### zu __# ___ ___ |
getestet, das Original dauert unter Linux/wine eine Ewigkeit mit über 60 Sekunden.
Mit Lazarus1.2.6 kompiliert keine 3 Sekunden für die 2616 Lösungen.Das ist schon befremdlich.
Jetzt fehlt nur noch etwas, was sie Lösung auch vorführt/abspielt
Gruß Horst
PS:
Das Wort Endlösung darf man wieder benutzen????
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Mo 17.11.14 14:18
Moin Horst,
deine Stellung benötigt wegen der Ausgabe soviel sek., die Berechnung dauert weniger als 2sek.
Zitat: | Das Wort Endlösung darf man wieder benutzen??? |
Der Begriff ist NICHT moralisch zu verstehen sondern logisch.
Ich habe in meiner Vergangenheit auch Variablennamen wie KZ (Zähler für K) benutzt.
Die Lösung abspielen werde ich noch einbauen - gute Idee
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
Horst_H
Beiträge: 1653
Erhaltene Danke: 243
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mo 17.11.14 14:35
Hallo,
jüst war ich am editieren..
Fiete neigt dazu, immer wieder Daten über den Stack zu kopieren, was nicht Not tut
Die minimale Umstellung auf const und schon ist es schneller.
Delphi-Quelltext 1: 2:
| function TQuad.FeldInDual(const F: TFeld): integer; function TQuad.Gleich(const S1, S2: TFeld): boolean; |
Anzahl Suchaufrufe 2443195
Laufzeit 00:01.336 // statt vorher 1.8 immer noch Lazarus
Ich gehe auch davon aus, das linux/wine einen mit der Ausgabe ärgert, es sind 2616 Lösungen á 15 Zeilen.
Schön, das Dir die Abspielidee gefällt.Ich hoffe, dass man dann ein Gefühl für eine Strategie bekommt.Beim Spiel 2048 war es ja immer nur eine verschieben in möglichst eine Ecke.
Gruß Horst
|
|
Fiete
Beiträge: 611
Erhaltene Danke: 347
W7
Delphi 6 pro
|
Verfasst: Di 18.11.14 20:10
Moin,
die Lösungen können jetzt angezeigt werden. Die Nummer der Lösung wird angegeben, anschließend wird jeder Zug ausgeführt und angezeigt. Mit vorwärts bzw. rückwärts kommt man zur nächsten bzw. vorherigen Lösung.
Im Memo wird die Lösung zur besseren Orientierung nach oben gescrollt.
Die neue Version ist hochgeladen.
Viel Spaß beim Testen.
Gruß Fiete
_________________ Fietes Gesetz: use your brain (THINK)
|
|
|