Autor Beitrag
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 540
Erhaltene Danke: 240

W7
Delphi 6 pro
BeitragVerfasst: Mo 30.09.19 13:20 
Moin,
das Programm berechnet die Anzahl von Stellungen zu einer gewählten Seitenlänge.
Anzahl_11
Regeln zu Gappy:
In jeder Zeile und Spalte gibt es genau zwei schwarze Felder.
Schwarze Felder dürfen einander nicht berühren, auch nicht diagonal.

Die Suche kann mit <ESC> abgebrochen werden.

ausblenden XML-Daten
1:
2:
3:
4:
5:
6:
7:
Seitenlänge     Anzahl      Rechenzeit
   7                0            0,00
   8                2            0,00
   9              664            0,00
  10           146510         0:00,42
  11         31197434         1:30,17
  12   Abbruch 702662000    4:7:26,39

Die Anzahl für Seitenlängen >11 fehlen mir noch, der Suchalgorithmus ist wohl noch nicht optimal.
Länger als vier Stunden wollte ich nicht warten.
Die Suchprozedur
ausblenden volle Höhe 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:
function TGappy.Erlaubt(x1,x2:Integer):Boolean;
  var Sum1,Sum2,y1:Integer;
  begin
   Result:=True;
   // Spaltentest
   Sum1:=0;Sum2:=0;
   for y1:=1 to FeldBreite do
    begin
     if Feld[x1,y1]=1 then inc(Sum1);
     if Sum1>1 then begin Result:=False;exit end;
     if Feld[x2,y1]=1 then inc(Sum2);
     if Sum2>1 then begin Result:=False;exit end;
    end;
  end;

 procedure TGappy.Such(y:Integer);
  var F:TFeld;
      x1,x2:Integer;
      TimeStr:String;
      TSek:Extended;
  begin
   for x1:=1 to FeldBreite-2 do
    if Feld[x1,y]=0 then
     for x2:=x1+2 to FeldBreite do
      if Feld[x2,y]=0 then
       if Erlaubt(x1,x2) then
        begin
         F:=Feld;
         Feld[x1,y]:=1;Feld[x2,y]:=1;
         Feld[x1-1,y+1]:=5;Feld[x1,y+1]:=5;Feld[x1+1,y+1]:=5;
         Feld[x2-1,y+1]:=5;Feld[x2,y+1]:=5;Feld[x2+1,y+1]:=5;
         if y<FeldBreite then Such(y+1)
         else
          begin
           inc(Stellungen);
           if Stellungen mod 1000=0 then // Abbruch mit <ESC>
            begin
             Application.ProcessMessages;
             if GetAsyncKeyState(VK_Escape)<0 then
              begin
               QueryPerformanceCounter(ZielZeit);
               TSek:=(ZielZeit-StartZeit)/Frequenz;
               TimeStr:=TimeInTStMS(TSek);
               LabelInfo.Caption:=IntToStr(Stellungen)+' Stellungen in '+TimeStr+' gefunden';
               if MessageDlg('Weiter Suchen?',mtConfirmation,[mbyes,mbNo],0)=mrno then
                begin Abbruch:=True;exit end;
              end;
            end;
           if Zeigen.Checked then FeldAusgabe(Stellungen,Feld)
          end;
         if Abbruch then exit;
         Feld:=F
        end;
  end;

Es läßt sich sicher einiges verbessern!?

Gruß Fiete
Einloggen, um Attachments anzusehen!
_________________
Fietes Gesetz: use your brain (THINK)
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1647
Erhaltene Danke: 238

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Di 01.10.19 14:24 
Hallo,

if Zeigen.Checked then FeldAusgabe(Stellungen,Feld) kostet bei mir die Hauptzeit unter Lazarus :-(
11 in 18,5 Sekunden statt 1min30

Gruß Horst
Fiete Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 540
Erhaltene Danke: 240

W7
Delphi 6 pro
BeitragVerfasst: Di 01.10.19 16:33 
Moin Horst,
bei mir hat die Deaktivierung leider keine Verbesserung gebracht.(Delphi6 pro unter W7 in Parallels auf Mac 3,5 GHz)

Die Steigerung bei Dir ist natürlich toll, vielleicht probierst Du mal die 12, bin gespannt was unter Lazarus sich ergibt!

Gruß Fiete

_________________
Fietes Gesetz: use your brain (THINK)
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1647
Erhaltene Danke: 238

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Di 01.10.19 18:34 
Hallo,

Du hattest ja :
ausblenden Quelltext
1:
2:
3:
4:
5:
6:
7:
Seitenlänge     Anzahl      Rechenzeit
   7                  0            0,00
   8                  2            0,00
   9                664            0,00
  10            146.510         0:00,42
  11         31.197.434         1:30,17
  12Abbruch 702.662.000    4:7:26,39

angegeben.
Ich habe mal einen Abbruch eingebaut:
ausblenden Delphi-Quelltext
1:
2:
                IF Stellungen > 702662000 then
                  Abbruch := true;

und mit 12 laufen lassen -> 6min 10,47 sec
Sicher fehlt da eine Stelle. 4h ist nicht plausibel.
ausblenden Quelltext
1:
2:
Beim Übergang  9 auf 10 sind es etwa 220-fache Lösungszahl.
Beim Übergang 10 auf 11 sind es etwa 212-fache Lösungszahl.

Also erwarte ich etwa 210 *31197434 = 6.551.081.140 Lösungen also in der 10-fachen Zeit müsste es fertig sein.

Gruß Horst
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1647
Erhaltene Danke: 238

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Di 01.10.19 19:55 
Hallo,

für Seitenlänge 12 sind es 6.798.881.226 Stellungen in 44min4,55sek.
Also das 217.9 fache von 11 Seitenlänge.
In 161 Stunden ~ 1 Woche wäre dann Seitenlänge 13 fertig :D

Gruß Horst

Edit: Jetzt mal unter wine64/Linux64 laufen lassen, einmal das Original und dann die aufgemotzten/gepimpten, die nur zählen.
Unter Linux wird nicht ständig der CPU-Kern gewechselt.Rein für Linux compiliert war langsamer, wohl wegen einer anderen Compiler Version.
FieteGappy
FieteGappy11
FieteGappy12
Einloggen, um Attachments anzusehen!

Für diesen Beitrag haben gedankt: Fiete
Fiete Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 540
Erhaltene Danke: 240

W7
Delphi 6 pro
BeitragVerfasst: Mi 02.10.19 13:59 
Moin Horst,
mit den Bitmasken ist Dir ein toller Einfall gekommen :wink:
Auf meinem Rechner erhalte ich jetzt ähnlich Zeiten, 11,37 statt Deinen 10,7

Ein SuperLob dem Tüftler!
Gruß Fiete

_________________
Fietes Gesetz: use your brain (THINK)