' Visueller Sudoku-Knacker
' (c) 2007, 2008 by Andreas Meile, CH-8242 Hofen SH

' Statt mit Rekursion wird mit Iterationen gearbeitet
' Kann folglich nur R�tsel l�sen, bei denen man mit Ausschluss und
' Zeilen/Spaltenoperationen ans Ziel kommt
' Version 3 mit Tripelmuster-Auswertung in Kombination mit Ausschluss
' (indirekte aufgrund von Zeile/Spalte)
' Ausserdem Abbruch bei Erkennung eines Widerspruchs in bestimmen Situationen

DIM f%(8, 8), s%(8, 8, 1 TO 9), kombX%(2, 8), kombY%(8, 2)
DIM zeiSpa%(8, 8), auss%(8, 8)

INPUT "Datei mit Sudokan-R�tsel"; d$

OPEN d$ FOR INPUT AS 1
FOR y% = 0 TO 8
  LINE INPUT #1, h$
  FOR x% = 0 TO 8
    f%(x%, y%) = ASC(MID$(h$, x% + 1, 1)) - 48
  NEXT x%
NEXT y%
CLOSE 1

SCREEN 0
' WIDTH 40, 25
CLS

t$ = ""
FOR i% = 1 TO 5
  READ h$
  t$ = t$ + h$
NEXT i%
DATA "���˻"
DATA "���׶"
DATA "�� ��"
DATA "���ι"
DATA "���ʼ"

' Felder zeichnen
COLOR 13
PRINT "  Akt. L�sungsstand   L�sungsreihenfolge   Ausschl.-Kandidaten  Passliste"
COLOR 8
FOR y% = 0 TO 18
  IF y% = 0 THEN
    ty% = 0
  ELSEIF y% = 18 THEN
    ty% = 4
  ELSEIF y% MOD 6 = 0 THEN
    ty% = 3
  ELSEIF y% MOD 2 = 0 THEN
    ty% = 1
  ELSE
    ty% = 2
  END IF
  FOR x% = 0 TO 18
    IF x% = 0 THEN
      tx% = 0
    ELSEIF x% = 18 THEN
      tx% = 4
    ELSEIF x% MOD 6 = 0 THEN
      tx% = 3
    ELSEIF x% MOD 2 = 0 THEN
      tx% = 1
    ELSE
      tx% = 2
    END IF
    FOR i% = 0 TO 2
      LOCATE 3 + y%, 2 + 21 * i% + x%
      PRINT MID$(t$, 1 + 5 * ty% + tx%, 1);
    NEXT i%
  NEXT x%
NEXT y%
COLOR 7
FOR i% = 0 TO 2
  FOR j% = 0 TO 8
    LOCATE 2, 3 + 21 * i% + 2 * j%
    PRINT CHR$(97 + j%);
    LOCATE 4 + 2 * j%, 1 + 21 * i%
    PRINT CHR$(49 + j%);
  NEXT j%
NEXT i%

LOCATE 22, 1
PRINT RIGHT$(d$, 14);

LOCATE 23, 53
COLOR 7
PRINT "<-Legende"
LOCATE 23, 1
COLOR 9
PRINT "�_ Zeile/Spalte direkt";
LOCATE 24, 1
COLOR 9, 4
PRINT "�";
COLOR 5, 0
PRINT "� komb. Z/S+Auss. dir.";
LOCATE 25, 1
COLOR 4
PRINT "�+ Ausschluss direkt";
LOCATE 23, 24
COLOR 3
PRINT "�= Z/S via indirektem Tripel";
LOCATE 24, 24
COLOR 14, 3
PRINT "�";
COLOR 10, 0
PRINT "� komb. Z/S+Auss. via Tripel";
LOCATE 25, 24
COLOR 14
PRINT "�# Ausschl. via indir. Tripel";

' Vorgegebene Ziffern darstellen
af% = 0
COLOR 15
FOR y% = 0 TO 8
  FOR x% = 0 TO 8
    IF f%(x%, y%) > 0 THEN
      LOCATE 4 + 2 * y%, 3 + 2 * x%
      PRINT CHR$(48 + f%(x%, y%));
      LOCATE , 24 + 2 * x%
      PRINT "*";
    END IF
  NEXT x%
NEXT y%
pass% = 0

' L�sung: Iterativ. Grundprinzip: Immer der "bequemste" Weg, d.h. wenn
' es direkte Z+S gibt, wird nicht mehr weitergesucht

widersp% = 0
hPass% = 1
DO
  GOSUB ZeigePass
  COLOR 15
  hPass% = hPass% + 1
  LOCATE hPass%, 63
  PRINT CHR$(64 + pass%); ":";
  wPass% = 0
  ' Trefferliste l�schen
  FOR y% = 0 TO 8
    FOR x% = 0 TO 8
      zeiSpa%(x%, y%) = 0
      auss%(x%, y%) = 0
    NEXT x%
  NEXT y%
  GOSUB ErstelleUndZeigeAusschluesse
  lev% = 0
  DO
    ' Suche nach Zeilen/Spalten
    FOR z% = 1 TO 9
      FOR i% = 0 TO 8
        stZ% = 0
        stS% = 0
        stQ% = 0
        FOR j% = 0 TO 8
          ' Zeile
          IF s%(j%, i%, z%) THEN
            stZ% = stZ% + 1
          ELSE
            pZ% = j%
          END IF
          ' Spalte
          IF s%(i%, j%, z%) THEN
            stS% = stS% + 1
          ELSE
            pS% = j%
          END IF
          ' Quadrat
          IF s%(3 * (i% MOD 3) + j% MOD 3, 3 * (i% \ 3) + j% \ 3, z%) THEN
            stQ% = stQ% + 1
          ELSE
            pQ% = j%
          END IF
        NEXT j%
        IF stZ% = 8 THEN
          zeiSpa%(pZ%, i%) = z%
        END IF
        IF stS% = 8 THEN
          zeiSpa%(i%, pS%) = z%
        END IF
        IF stQ% = 8 THEN
          zeiSpa%(3 * (i% MOD 3) + pQ% MOD 3, 3 * (i% \ 3) + pQ% \ 3) = z%
        END IF
      NEXT i%
    NEXT z%
    ' Ausschl�sse
    FOR y% = 0 TO 8
      FOR x% = 0 TO 8
        IF f%(x%, y%) = 0 THEN
          j% = 0
          FOR i% = 1 TO 9
            IF s%(x%, y%, i%) THEN
              j% = j% + 1
            ELSE
              h% = i%
            END IF
          NEXT i%
          IF j% = 8 THEN
            auss%(x%, y%) = h%
          ELSEIF j% = 9 THEN
            widersp% = -1
            LOCATE 4 + 2 * y%, 3 + 2 * x%
            COLOR 14, 12
            PRINT "!";
            COLOR 7, 0
          END IF
        END IF
      NEXT x%
    NEXT y%
    ' Auswerten und darstellen
    anzAuss% = 0
    anzZeiSpa% = 0
    anzTot% = 0
    FOR y% = 0 TO 8
      FOR x% = 0 TO 8
        IF zeiSpa%(x%, y%) > 0 OR auss%(x%, y%) > 0 THEN
          LOCATE 4 + 2 * y%, 3 + 2 * x%
          IF zeiSpa%(x%, y%) > 0 THEN
            IF auss%(x%, y%) > 0 THEN
              ' Zeile/Spalte kombiniert
              IF lev% > 0 THEN
                COLOR 14, 3
              ELSE
                COLOR 9, 4
              END IF
              PRINT "�";
              IF lev% > 0 THEN
                COLOR 10, 0
                sy$ = "�"
              ELSE
                COLOR 5, 0
                sy$ = "�"
              END IF
            ELSE
              ' nur reine Zeile/Spalte
              IF lev% > 0 THEN
                COLOR 3
                sy$ = "="
              ELSE
                COLOR 9
                sy$ = "_"
              END IF
              PRINT "�";
            END IF
          ELSE
            ' nur reiner Ausschluss
            IF lev% > 0 THEN
              COLOR 14
              sy$ = "#"
            ELSE
              COLOR 4
              sy$ = "+"
            END IF
            PRINT "�";
          END IF
          IF zeiSpa%(x%, y%) > 0 THEN
            anzZeiSpa% = anzZeiSpa% + 1
          END IF
          IF auss%(x%, y%) > 0 THEN
            anzAuss% = anzAuss% + 1
          END IF
          anzTot% = anzTot% + 1
          LOCATE , 24 + 2 * x%
          PRINT CHR$(64 + pass%);
          IF wPass% > 4 THEN
            hPass% = hPass% + 1
            wPass% = 0
          END IF
          LOCATE hPass%, 65 + 3 * wPass%
          PRINT CHR$(97 + x%); CHR$(49 + y%); sy$;
          wPass% = wPass% + 1
        END IF
      NEXT x%
    NEXT y%
    IF anzTot% = 0 THEN
      ' nur, falls bei der Suche erfolglos: Suche von verdeckten
      ' Tripel n�tig
      trip% = 0
      FOR z% = 1 TO 9
        FOR i% = 0 TO 8
          FOR j% = 0 TO 2
            kombX%(j%, i%) = -1
            kombY%(i%, j%) = -1
            FOR k% = 0 TO 2
              IF NOT s%(3 * j% + k%, i%, z%) THEN
                kombX%(j%, i%) = 0
              END IF
              IF NOT s%(i%, 3 * j% + k%, z%) THEN
                kombY%(i%, j%) = 0
              END IF
            NEXT k%
          NEXT j%
        NEXT i%
        FOR i% = 0 TO 8
          axx% = 0
          axy% = 0
          ayy% = 0
          ayx% = 0
          FOR j% = 0 TO 2
            IF kombX%(j%, i%) THEN
              axx% = axx% + 1
            ELSE
              pxx% = j%
            END IF
            IF kombY%(i%, j%) THEN
              ayy% = ayy% + 1
            ELSE
              pyy% = j%
            END IF
            IF kombX%(i% MOD 3, 3 * (i% \ 3) + j%) THEN
              axy% = axy% + 1
            ELSE
              pxy% = j%
            END IF
            IF kombY%(3 * (i% \ 3) + j%, i% MOD 3) THEN
              ayx% = ayx% + 1
            ELSE
              pyx% = j%
            END IF
          NEXT j%
          IF axx% = 2 THEN
            ' Wir haben ein ###xxx###-Pattern gefunden
            FOR j% = 1 TO 2
              IF NOT kombX%(pxx%, 3 * (i% \ 3) + (i% + j%) MOD 3) THEN
                trip% = -1
                ' Tripel-"Querbalken" streichen
                FOR k% = 0 TO 2
                  s%(3 * pxx% + k%, 3 * (i% \ 3) + (i% + j%) MOD 3, z%) = -1
                NEXT k%
              END IF
            NEXT j%
          END IF
          IF ayy% = 2 THEN
            ' dito vertikal
            FOR j% = 1 TO 2
              IF NOT kombY%(3 * (i% \ 3) + (i% + j%) MOD 3, pyy%) THEN
                trip% = -1
                ' Tripel-"Querbalken" streichen
                FOR k% = 0 TO 2
                  s%(3 * (i% \ 3) + (i% + j%) MOD 3, 3 * pyy% + k%, z%) = -1
                NEXT k%
              END IF
            NEXT j%
          END IF
          IF axy% = 2 THEN
            ' dito mit Quadratblock aus horizontalen Tripeln
            FOR j% = 1 TO 2
              IF NOT kombX%((i% + j%) MOD 3, 3 * (i% \ 3) + pxy%) THEN
                trip% = -1
                ' Tripel-"Querbalken" streichen
                FOR k% = 0 TO 2
                  s%(3 * ((i% + j%) MOD 3) + k%, 3 * (i% \ 3) + pxy%, z%) = -1
                NEXT k%
              END IF
            NEXT j%
          END IF
          IF ayx% = 2 THEN
            ' dito mit Quadratblock aus vertikalen Tripeln
            FOR j% = 1 TO 2
              IF NOT kombY%(3 * (i% \ 3) + pyx%, (i% + j%) MOD 3) THEN
                trip% = -1
                ' Tripel-"Querbalken" streichen
                FOR k% = 0 TO 2
                  s%(3 * (i% \ 3) + pyx%, 3 * ((i% + j%) MOD 3) + k%, z%) = -1
                NEXT k%
              END IF
            NEXT j%
          END IF
        NEXT i%
      NEXT z%
      lev% = lev% + 1
    END IF
  LOOP WHILE anzTot% = 0 AND trip%
 
  LOCATE 22, 49
  COLOR 7, 0
  PRINT USING "Komb.-level:##"; lev%;
  LOCATE 23, 65
  IF lev% > 0 THEN
    COLOR 3
  ELSE
    COLOR 9
  END IF
  PRINT USING "Zeile/Spalte:##"; anzZeiSpa%;
  LOCATE 24, 67
  IF lev% > 0 THEN
    COLOR 14
  ELSE
    COLOR 4
  END IF
  PRINT USING "Ausschluss:##"; anzAuss%;
  LOCATE 25, 72
  COLOR 7
  PRINT USING "Total:##"; anzTot%;
  d$ = INPUT$(1)
  IF UCASE$(d$) = "S" THEN
    GOSUB Speichern
  END IF
  ' Einsetzen
  COLOR 10
  FOR y% = 0 TO 8
    FOR x% = 0 TO 8
      IF zeiSpa%(x%, y%) > 0 THEN
        z% = zeiSpa%(x%, y%)
      ELSE
        z% = auss%(x%, y%)
      END IF
      IF z% > 0 THEN
        f%(x%, y%) = z%
        LOCATE 4 + 2 * y%, 3 + 2 * x%
        PRINT CHR$(48 + z%);
      END IF
    NEXT x%
  NEXT y%
  GOSUB ErstelleUndZeigeAusschluesse
  d$ = INPUT$(1)
  IF UCASE$(d$) = "S" THEN
    GOSUB Speichern
  END IF
LOOP WHILE anzTot% > 0 AND aL% > 0 AND NOT widersp%

LOCATE 22, 16
IF aL% = 0 THEN
  COLOR 10
  PRINT "Erfolgreich gel�st";
ELSE
  COLOR 12
  IF widersp% THEN
    PRINT "Wiederspruch->R�tsel fehlerhaft";
  ELSE
    PRINT "Annahme/Rekursion n�tig->Abbruch";
  END IF
END IF

d$ = INPUT$(1)
IF UCASE$(d$) = "S" THEN
  GOSUB Speichern
END IF
COLOR 7, 0
' SCREEN 0
' WIDTH 80, 25
CLS

END

ZeigePass:
pass% = pass% + 1
COLOR 3
LOCATE 24, 55
PRINT "Pass Nr. "; CHR$(64 + pass%);
RETURN

ErstelleUndZeigeAusschluesse:
' Kombi-Prozedur, welche den Ausschluss-"W�rfel" vorbereitet und
' gleichzeitig Ausschl�sse anzeigt

' Sucharray-"W�rfel" vorbereiten
FOR z% = 1 TO 9  ' alle Zahlen
  FOR y% = 0 TO 8
    FOR x% = 0 TO 8
      s%(x%, y%, z%) = f%(x%, y%) > 0
    NEXT x%
  NEXT y%
  FOR y% = 0 TO 8
    FOR x% = 0 TO 8
      IF f%(x%, y%) = z% THEN
        FOR i% = 0 TO 8
          ' Zeile
          s%(i%, y%, z%) = -1
          ' Spalte
          s%(x%, i%, z%) = -1
          ' Quadrat
          s%(3 * (x% \ 3) + i% MOD 3, 3 * (y% \ 3) + i% \ 3, z%) = -1
        NEXT i%
      END IF
    NEXT x%
  NEXT y%
NEXT z%

aL% = 0
' Auf 3. Sudoku Analyse-Map anzeigen
FOR y% = 0 TO 8
  FOR x% = 0 TO 8
    LOCATE 4 + 2 * y%, 45 + 2 * x%
    IF f%(x%, y%) > 0 THEN
       PRINT " ";
    ELSE
      j% = 0
      FOR i% = 1 TO 9
        IF NOT s%(x%, y%, i%) THEN
          j% = j% + 1
        END IF
     NEXT i%
      SELECT CASE j%
      CASE 0
        COLOR 12  ' Wiederspruch
        widersp% = -1
      CASE 1
        COLOR 10  ' eindeutiger Ausschluss
      CASE ELSE
        COLOR 7
      END SELECT
      PRINT CHR$(48 + j%);
      aL% = aL% + 1
    END IF
  NEXT x%
NEXT y%
COLOR 11
LOCATE 25, 55
PRINT USING "Anzahl L�cken:##"; aL%;
RETURN

Speichern:
COLOR 14
LOCATE 22, 16
PRINT SPACE$(34);
LOCATE , 16
INPUT "Dateiname"; d$
OPEN d$ FOR OUTPUT AS 1
FOR y% = 0 TO 8
  FOR x% = 0 TO 8
    PRINT #1, CHR$(48 + f%(x%, y%));
  NEXT x%
  PRINT #1, ""
NEXT y%
CLOSE 1
LOCATE 22, 16
PRINT SPACE$(34);
RETURN