Quadrati, ein Puzzlespiel

Fiete · Beiträge: 601 Erhaltene Danke: 339 W7 Delphi 6 pro

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.

user defined image

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)

Mathematiker · 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 · 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 · 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.

markieren

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: 601 Erhaltene Danke: 339 W7 Delphi 6 pro

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 · 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.

markieren

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:

program Quadconsole;
{$IFNDEF FPC}
  {$APPTYPE console}
{$ENDIF}
uses
  sysutils;
const
 cElemSide = 3;
 cElemCnt  = 3*3;
 cElemHigh = cElemCnt-1;

type
  tElemIdx    = 0..cElemHigh;
  tAnordnung  = integer;//set of tElemIdx;
  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;//round(sqrt(cElemCnt));
  // shl cColCnt = next row
  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;
//global
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;
{
      write(i:5,ftToEnds:5,': ');
      Ausgabe(i);
      For u := low(tElemIdx) to cElemHigh do
        Ausgabe(ftFromTo[u]);
      writeln;
}
      end;
    end;
    inc(i);
  until i> High(AN);
end;

procedure AnzahlProFeld(const AN:tarrAnOrd);
//kontrolliert, dass wirklich jedes Feld auch cElemCnt oft vorkommt
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;
        {
        repeat
          Ausgabe(n.npAN);
          writeln(n.npSw);
          writeln('Zeile ',n.npSw div cElemSide, 'Spalte',n.npSw mod cElemSide );
          n :=Anordnungen[n.npAN].ftPrev;
        until n.npAN = StartFeld;
        * }
        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
    ;//writeln(' Tiefe ',tiefe);
end;

var
  maxTiefe: integer;

BEGIN
  AnOrdEintueten(Anordnungen);
  Maxtiefe := 0;
  //Start kann nie 511 sein
  For StartFeld := 0 to 510 do
  //Ziel kann nie 0 sein
    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.

markieren

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:

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# · 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 :mrgreen:

.
Bei dem Beispiel oben komme ich auch auf 8 Schritte, die sich von Horsts Schritten unterscheiden.

Hier der Algorithmus:

markieren

C#-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:

  // Alle gültigen XOR operationen für jede Kacel von links nach rechts und oben nach unten
        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)
        {
            // startMask ist Ausgangsbituster, 1=weiß, 0=schwarz, Reihenfolge ist von links nach rechts, oben nach unten,
            // endMask ist das erwartete Ergebnisbitmuster
            // depth gibt die maximale Anzahl an zu versuchenden Zügen an

            // Man stelle sich das Ausgangsbitmuster und alle möglichen, daraus resultierenden Bitmuster vor.
            // Es entsteht ein exponentiell wachsender Baum. values beinhaltet genau einen Zweig von Anfang
            // bis zu depth
            int[] values = new int[depth]; 

            // indices beinhaltet die Zweigpunkte im aktuellen Baumzweig (values). Dabei gibt ein Index immer das zu
            // verwendente Bit (also eine Kachel) an. indices besteht nur aus Werten zwischen 0..8
            int[] indices = new int[values.Length];

            // der pfad zur Lösung
            List<Point> path = new List<Point>();
            
            int count = values.Length - 1;

            // root element des Baums ist das Ausgangsmuster
            values[0] = startMask;

            int i = 0;

            while (i >= 0)
            {
                // Prüfen ob index im gültigen Bereich ist und ob das Feld weiß ist
                if (IsTrue(values[i], 8 - indices[i]))    
                {
                    // Bits nach entsprechendem Muster kippen und in die nächste Ebene des Baums eintragen
                    values[i + 1] = values[i] ^ OperationMasks[indices[i]];
                    i++;

                    if (values[i] == endMask) // Ein Lösungsweg wurde gefunden
                    {
                        if (i < count) // Ist er kürzer als der Letzte?
                        {
                            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; // Index der aktuellen Ebene zurücksetzten
                        i--;  // Eine Ebene zurück gehen
                        if (i >= 0) indices[i]++; // Und in den nächsten möglichen Zweig wechseln
                    }
                }
                else if (indices[i] < 9) // nächste Kachel auswählen
                {
                    indices[i]++;
                }
                else // keine Kacheln mehr übrig. Eine Ebene zurück und in den nächsten Zweig springen
                {
                    indices[i] = 0;
                    i--;
                    if (i >= 0) indices[i]++;
                }

                // wenn der aktuelle Lösungsversch länger wird als die aktuelle Lösung, wird abgebrochen.
                // Eine Ebene zurück und in den nächsten Zweig springen
                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:

markieren

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 · 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:

markieren

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# · 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 :mrgreen:

_________________
Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler

Horst_H · 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# · Verfasst: Di 11.11.14 17:14

So jetzt noch das Bild dazu:
Algo

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 :mrgreen:

Einloggen, um Attachments anzusehen!

_________________
Der längste Typ-Name im .NET-Framework ist: ListViewVirtualItemsSelectionRangeChangedEventHandler

Horst_H · 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

markieren

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# · 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 · 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: 601 Erhaltene Danke: 339 W7 Delphi 6 pro

Moin,
jetzt hab ich mich aufgerafft.
Hier die rekursive Lösung:

markieren

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:

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 // Zug rückgängig machen
     else
      begin
       Benutzt[Index]:=True; // sperren
       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; // Suchtiefe verringern
        end;
       Benutzt[Index]:=False; // freigeben
       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 · Verfasst: Mo 17.11.14 10:54

Hallo,

ich habe mal

markieren

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: 601 Erhaltene Danke: 339 W7 Delphi 6 pro

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 :wink:

Gruß Fiete

_________________
Fietes Gesetz: use your brain (THINK)

Horst_H · Verfasst: Mo 17.11.14 14:35

Hallo,

jüst war ich am editieren..
user profile icon

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.

markieren

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: 601 Erhaltene Danke: 339 W7 Delphi 6 pro

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)

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme