Sudoku

7x7 · Beitrag von **7x7** » 07.06.2011 16:47

Wenn ich -so wie gestern- zufällig auf ein Sudoku-Rätsel in einer Zeitschrift stosse, dann juckt es mich in den Fingern und muss es lösen.

Nachdem ich es gelöst hatte, habe ich mich gefragt, wie viele mögliche Sudoku-Kombinationen es wohl gibt und mir vorgenommen, irgendwann mal ein kleines Programm zu schreiben, was alle Kombinationen ausrechnet.

Das "irgendwann" war gleich heute morgen (hat mich zu sehr gereizt

). Wenn ich gleich auf Wikipedia nachgelesen hätte, dass es im 9x9 Sudoku 6.670.903.752.021.072.936.960 (ca. 6,7 Trilliarden) Möglichkeiten gibt, hätte ich es wohl gleich sein lassen

Na, wie auch immer. Gereizt hat mich der rekursive Ansatz. Für den, den es interessiert...hier ist mein Code:
(Wenn jemand den code verbessern (schneller) machen kann...nur zu! Interessiert mich!)

Code: Alles auswählen

Declare Generate(Feld)
Declare anzeige(nr)


Global Dim reihe(9)     ;für jede Reihe eine Bit-Liste
Global Dim spalte(9)    ;für jede Spalte eine Bit-Liste
Global Dim quader(9)    ;für jeden Quader eine Bit-Liste

Global Dim Bit(9)       ;Bitdefinitionen
Bit(1)=  1
Bit(2)=  2
Bit(3)=  4
Bit(4)=  8
Bit(5)= 16
Bit(6)= 32
Bit(7)= 64
Bit(8)=128
Bit(9)=256


Structure su
    re.l
    sp.l
    qu.l
EndStructure
    
Global Dim Liste.su(81)

;zugehörige reihen-, spalten- und quader-Nr von SpielfeldNr erkennen und merken 
For a=1 To 81
    
    ;reihe erkennen
    Liste.su(a)\re=(a-1)/9+1
    
    ;spalte erkennen
    spalte=a % 9: If spalte=0: spalte=9: EndIf
    Liste.su(a)\sp=spalte
    
    ;quader erkennen
    If spalte<4     ;Quader 1 / 4 / 7
        If a<22: qstart= 1: q=1: Goto gen2: EndIf
        If a<49: qstart=28: q=4: Goto gen2: EndIf
        If a<76: qstart=55: q=7: Goto gen2: EndIf
    EndIf
    If spalte<7     ;Quader 2 / 5 / 8
        If a<25: qstart= 4: q=2: Goto gen2: EndIf
        If a<52: qstart=31: q=5: Goto gen2: EndIf
        If a<79: qstart=58: q=8: Goto gen2: EndIf
    EndIf
    If spalte<10    ;Quader 3 / 6 / 9
        If a<28: qstart= 7: q=3: Goto gen2: EndIf
        If a<55: qstart=34: q=6: Goto gen2: EndIf
        If a<82: qstart=61: q=9: Goto gen2: EndIf
    EndIf
    
    gen2:
    For b=qstart To qstart+2
        Liste.su(a)\qu=q
    Next b   
    For b=qstart+9 To qstart+11
        Liste.su(a)\qu=q
    Next b
    For b=qstart+18 To qstart+20
        Liste.su(a)\qu=q
    Next b
    
Next a


Global Dim Spielfeld(81)

Global sudoku=0


;Start...
OpenConsole()
    Generate(1)
    a$=Input()
CloseConsole()


Procedure Generate(Feld)
    For a=1 To 9
        
        ;Regelverstoss? 
        If  Reihe(liste(feld)\re) & bit(a): Goto nexta: EndIf
        If Spalte(liste(feld)\sp) & bit(a): Goto nexta: EndIf
        If Quader(liste(feld)\qu) & bit(a): Goto nexta: EndIf
        
        ;nein...Zahl einsetzen (Bit belegen)
         Reihe(liste(feld)\re)+bit(a)
        Spalte(liste(feld)\sp)+bit(a)
        Quader(liste(feld)\qu)+bit(a)
        
        Spielfeld(Feld)=a
        
        If feld=81
            sudoku+1
            ;nur jede millionste Kombination anzeigen
            If sudoku % 1000000=0: anzeige(sudoku/1000000): EndIf
        
            ;Zug rückgängig machen
            Reihe(liste(feld)\re)-bit(a)
            Spalte(liste(feld)\sp)-bit(a)
            Quader(liste(feld)\qu)-bit(a)
    
            Spielfeld(Feld)=0
            ProcedureReturn
        EndIf
        
        Generate(Feld+1)
        
        ;Zug rückgängig machen
        Reihe(liste(feld)\re)-bit(a)
        Spalte(liste(feld)\sp)-bit(a)
        Quader(liste(feld)\qu)-bit(a)
        
        Spielfeld(Feld)=0        
        
        nexta:
    Next a
    
EndProcedure

Procedure anzeige(nr)
    PrintN(Str(nr)+".millionste...")
    For c=0 To 8
        a$=""
        For d=1 To 9
            a$=a$+Str(Spielfeld(c*9+d))+" "
        Next d
          
        PrintN(a$)
    Next c
    PrintN("")
EndProcedure

Nino · Beitrag von **Nino** » 08.06.2011 22:32

Ich sehe nur eine leere Konsole (PB 4.51 auf Windows XP). Was genau soll das Programm denn machen?

Grüße, Nino

Mr.L · Beitrag von **Mr.L** » 08.06.2011 23:26

Etwas schneller wirds, wenn Du Pointer und Bit Operationen verwendest:
(Bei mir ohne Optimierung ca 11 , mit ca 6 Sekunden pro 1 Millionen Kombinationen)

Code: Alles auswählen

Declare Generate(Feld)
Declare anzeige(nr)

Global Dim reihe.l(9)     ; für jede Reihe eine Bit-Liste
Global Dim spalte.l(9)    ; für jede Spalte eine Bit-Liste
Global Dim quader.l(9)    ; für jeden Quader eine Bit-Liste

Global ms = ElapsedMilliseconds()

Structure su
  re.l
  sp.l
  qu.l
EndStructure

Global Dim Liste.su(81)

;zugehörige reihen-, spalten- und quader-Nr von SpielfeldNr erkennen und merken
For a=1 To 81
  
  ;reihe erkennen
  Liste.su(a)\re=(a-1)/9+1
  
  ;spalte erkennen
  spalte=a % 9: If spalte=0: spalte=9: EndIf
  Liste.su(a)\sp=spalte
  
  ;quader erkennen
  If spalte<4     ;Quader 1 / 4 / 7
    If a<22: qstart= 1: q=1: Goto gen2: EndIf
    If a<49: qstart=28: q=4: Goto gen2: EndIf
    If a<76: qstart=55: q=7: Goto gen2: EndIf
  EndIf
  If spalte<7     ;Quader 2 / 5 / 8
    If a<25: qstart= 4: q=2: Goto gen2: EndIf
    If a<52: qstart=31: q=5: Goto gen2: EndIf
    If a<79: qstart=58: q=8: Goto gen2: EndIf
  EndIf
  If spalte<10    ;Quader 3 / 6 / 9
    If a<28: qstart= 7: q=3: Goto gen2: EndIf
    If a<55: qstart=34: q=6: Goto gen2: EndIf
    If a<82: qstart=61: q=9: Goto gen2: EndIf
  EndIf
  
  gen2:
  For b=qstart To qstart+2
    Liste.su(a)\qu=q
  Next b   
  For b=qstart+9 To qstart+11
    Liste.su(a)\qu=q
  Next b
  For b=qstart+18 To qstart+20
    Liste.su(a)\qu=q
  Next b
  
Next a

Global Dim Spielfeld(81)

Global sudoku=0

;Start...
OpenConsole()
Generate(0)
a$=Input()
CloseConsole()


Procedure Generate(Feld)
  
  If feld = 82
    sudoku+1
    ;nur jede millionste Kombination anzeigen
    If sudoku % 1000000=0: anzeige(sudoku/1000000): EndIf
    ProcedureReturn
  EndIf
  
  *l.su = Liste(Feld)
  *reihe.Long = @Reihe(*l\re)
  *spalte.Long = @Spalte(*l\sp)
  *quader.Long = @Quader(*l\qu)
  *spielfeld.Long = @Spielfeld(Feld)
  b.l = 1
  
  For a = 1 To 9
    
    ;Regelverstoss?		
    If  (*reihe\l & b) = 0
      If (*spalte\l & b) = 0		
        If (*quader\l & b) = 0
          
          ;nein...Zahl einsetzen (Bit belegen)
          *reihe\l  | b
          *spalte\l | b
          *quader\l | b
          
          *spielfeld\l = a
          
          Generate(Feld + 1)
          
          ;Zug rückgängig machen
          *reihe\l  & ~b
          *spalte\l & ~b
          *quader\l & ~b
          
          *spielfeld\l = 0
          
        EndIf
      EndIf
    EndIf		
    
    b << 1
    
  Next a
  
EndProcedure

Procedure anzeige(nr)
  PrintN(Str(nr)+".millionste...   " + Str(ElapsedMilliseconds() - ms) + "ms")
  For c=0 To 8
    For d=1 To 9
      Print(Str(Spielfeld(c*9+d))+" ")
    Next d		
    PrintN("")
  Next c
  PrintN("")
  ms = ElapsedMilliseconds()
EndProcedure

7x7 · Beitrag von **7x7** » 09.06.2011 07:57

@Nino
Erstelle eine exe. Je nach Rechnerleistung sollten nach einigen Sekunden in Intervallen Sudoku-Kombinationen in der Konsole erscheinen

@Mr.L
Spitze!

Bei mir von 9,0s auf 5,4 s/Million (mit I7-720QM 1,6GHz, ohne Turbo-Mode weil unter XP).

Ich vermeide normalerweise Pointer, weil es meine grauen Zellen zu sehr beansprucht

. Aber du hast recht: In Brute-Force Routinen sind sie natürlich die beste Methode. Hast auch Generate() etwas aufgeräumt.

Was mir allgemein noch auffiel: die Zählvariable "sudoku" muss von .l auf .q umgestellt werden, wegen dem Überlauf. Bei .q dauerts bis zum Überlauf einen Monat länger

PureBoard

Sudoku

Sudoku

Re: Sudoku

Re: Sudoku

Re: Sudoku