' 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
' Version 4: Auswertung Hidden+Naked Pairs/Triples/Qadruples gem�ss
' http://www.ahr-sudoku.de/solving1.php als zus�tzliche Indirekt-Operation
' mit Optimierung, keine unn�tigen Indirekt-Suchen machen m�ssen

CONST coHidNak% = 1
CONST coTrip% = 2

DECLARE FUNCTION FuehrNull$ (w%, b%)

DIM f%(8, 8), s%(8, 8, 1 TO 9), kombX%(2, 8), kombY%(8, 2)
DIM zeiSpa%(8, 8), auss%(8, 8), hidNaX%(8), hidNaY%(8), hidNaF%(1 TO 9)
DIM iRek%(8), hidNaS%(1 TO 9), staX%(200), staY%(200), staF%(200)
DIM spt%(20), indPf%(10), indPfGew%(10)

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.    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 1
      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 1
  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 "�= Zeile/Spalte indirekt";
LOCATE 24, 24
COLOR 14, 3
PRINT "�";
COLOR 10, 0
PRINT "� komb. Z/S+Auss. indirekt";
LOCATE 25, 24
COLOR 14
PRINT "�# Ausschluss indirekt";

' 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
  ' Pass-Nr. zeigen
  pass% = pass% + 1
  COLOR 3
  LOCATE 24, 55
  PRINT "Pass Nr. "; CHR$(64 + pass%);
  COLOR 15
  hPass% = hPass% + 1
  LOCATE hPass%, 43
  PRINT CHR$(64 + pass%); ":";
  wPass% = 0

  GOSUB ErstelleUndZeigeAusschluesse
  e2% = 0
  aTrip% = 0
  spt%(0) = 0
  e2min% = 1000
  aTripMax% = -1
  anzTotMax% = -1
  GOSUB SuchOperationRek
  IF anzTotMax% > 0 THEN
    ' Pass erfolgreich -> wir f�hren ihn definitiv aus
    GOSUB ErstelleUndZeigeAusschluesse
    FOR a% = 0 TO e2min% - 1
      ' Stackumgebung bereitstellen
      e2% = 1
      spt%(0) = 0
      spt%(1) = 0
      LOCATE hPass%, 45 + 4 * wPass%
      SELECT CASE indPfGew%(a%)
      CASE coHidNak%
        GOSUB SucheHiddenNaked
        COLOR 14, 4
        PRINT "H" + FuehrNull$(anzHidNak%, 2);
      CASE coTrip%
        GOSUB SucheVerdeckteTripel
        COLOR 14, 1
        PRINT "T" + FuehrNull$(anzTrip%, 2);
      CASE ELSE
        ' Sollte nicht vorkommen!
        STOP
      END SELECT
      COLOR , 0
      wPass% = wPass% + 1
    NEXT a%
    GOSUB TrefferSuchen
    ' Auswerten und darstellen
    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 e2min% > 0 THEN
                COLOR 14, 3
              ELSE
                COLOR 9, 4
              END IF
              PRINT "�";
              IF e2min% > 0 THEN
                COLOR 10, 0
                sy$ = "�"
              ELSE
                COLOR 5, 0
                sy$ = "�"
              END IF
            ELSE
              ' nur reine Zeile/Spalte
              IF e2min% > 0 THEN
                COLOR 3
                sy$ = "="
              ELSE
                COLOR 9
                sy$ = "_"
              END IF
              PRINT "�";
            END IF
          ELSE
            ' nur reiner Ausschluss
            IF e2min% > 0 THEN
              COLOR 14
              sy$ = "#"
            ELSE
              COLOR 4
              sy$ = "+"
            END IF
            PRINT "�";
          END IF
          LOCATE , 24 + 2 * x%
          PRINT CHR$(64 + pass%);
          IF wPass% > 8 THEN
            hPass% = hPass% + 1
            wPass% = 0
          END IF
          LOCATE hPass%, 45 + 4 * wPass%
          PRINT CHR$(97 + x%); CHR$(49 + y%); sy$;
          wPass% = wPass% + 1
        END IF
      NEXT x%
    NEXT y%
 
    LOCATE 23, 65
    IF e2min% > 0 THEN
      COLOR 3
    ELSE
      COLOR 9
    END IF
    PRINT USING "Zeile/Spalte:##"; anzZeiSpa%;
    LOCATE 24, 67
    IF e2min% > 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
  END IF
LOOP WHILE anzTotMax% > 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

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 Sudoku Analyse-Map anzeigen (seit Version 4 mit Reihenfolge-Map kombiniert)
FOR y% = 0 TO 8
  FOR x% = 0 TO 8
    LOCATE 4 + 2 * y%, 24 + 2 * x%
    IF f%(x%, y%) = 0 THEN
      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

SuchOperationRek:
' Zuerst schauen, ob nicht bereits Treffer
GOSUB TrefferSuchen
IF anzTot% > 0 THEN
  ' Suche erfolgreich => pr�fen, ob besserer Kandidat
  IF e2% < e2min% OR (e2% = e2min% AND (aTrip% > aTripMax% OR (aTrip% = aTripMax% AND anzTot% > anzTotMax%))) THEN
    e2min% = e2%
    aTripMax% = aTrip%
    anzTotMax% = anzTot%
    FOR i% = 0 TO e2% - 1
      indPfGew%(i%) = indPf%(i%)
    NEXT i%
  END IF
ELSE
  ' Keine Kandidaten -> wir m�ssen indirekt suchen
  indPf%(e2%) = coHidNak%
  e2% = e2% + 1
  spt%(e2%) = spt%(e2% - 1)
  GOSUB SucheHiddenNaked
  IF anzHidNak% > 0 THEN
    ' Wir konnten erfolgreiche Streichungen durchf�hren -> Rekursion
    GOSUB SuchOperationRek
    ' Rollback der indirekten Streichungen
    FOR i% = spt%(e2% - 1) TO spt%(e2%) - 1
      s%(staX%(i%), staY%(i%), staF%(i%)) = 0
    NEXT i%
  END IF
  indPf%(e2% - 1) = coTrip%
  spt%(e2%) = spt%(e2% - 1)
  GOSUB SucheVerdeckteTripel
  IF anzTrip% > 0 THEN
    aTrip% = aTrip% + 1
    ' Erfolgreiche Streichungen -> Rekursion
    GOSUB SuchOperationRek
    ' Rollback der indirekten Streichungen
    FOR i% = spt%(e2% - 1) TO spt%(e2%) - 1
      s%(staX%(i%), staY%(i%), staF%(i%)) = 0
    NEXT i%
    aTrip% = aTrip% - 1
  END IF
  e2% = e2% - 1
END IF
RETURN

' Innerhalb der Streichliste nach Treffern (Hidden/Naked Singles) suchen
TrefferSuchen:
' 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%
anzZeiSpa% = 0
' Suche nach Zeilen/Spalten (Hidden Singles)
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 AND zeiSpa%(pZ%, i%) = 0 THEN
      zeiSpa%(pZ%, i%) = z%
      anzZeiSpa% = anzZeiSpa% + 1
    END IF
    IF stS% = 8 AND zeiSpa%(i%, pS%) = 0 THEN
      zeiSpa%(i%, pS%) = z%
      anzZeiSpa% = anzZeiSpa% + 1
    END IF
    IF stQ% = 8 AND zeiSpa%(3 * (i% MOD 3) + pQ% MOD 3, 3 * (i% \ 3) + pQ% \ 3) = 0 THEN
      zeiSpa%(3 * (i% MOD 3) + pQ% MOD 3, 3 * (i% \ 3) + pQ% \ 3) = z%
      anzZeiSpa% = anzZeiSpa% + 1
    END IF
  NEXT i%
NEXT z%
' Ausschl�sse (Naked Singles)
anzTot% = anzZeiSpa%
anzAuss% = 0
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
        IF auss%(x%, y%) = 0 THEN
          auss%(x%, y%) = h%
          anzAuss% = anzAuss% + 1
          IF zeiSpa%(x%, y%) = 0 THEN
            anzTot% = anzTot% + 1
          END IF
        END IF
      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%
RETURN

' Suche nach verdeckten Tripel
SucheVerdeckteTripel:
anzTrip% = 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
          anzTrip% = anzTrip% + 1
          ' Tripel-"Querbalken" streichen
          FOR k% = 0 TO 2
            staX%(spt%(e2%)) = 3 * pxx% + k%
            staY%(spt%(e2%)) = 3 * (i% \ 3) + (i% + j%) MOD 3
            IF NOT s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) THEN
              s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) = -1
              staF%(spt%(e2%)) = z%
              spt%(e2%) = spt%(e2%) + 1
            END IF
          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
          anzTrip% = anzTrip% + 1
          ' Tripel-"Querbalken" streichen
          FOR k% = 0 TO 2
            staX%(spt%(e2%)) = 3 * (i% \ 3) + (i% + j%) MOD 3
            staY%(spt%(e2%)) = 3 * pyy% + k%
            IF NOT s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) THEN
              s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) = -1
              staF%(spt%(e2%)) = z%
              spt%(e2%) = spt%(e2%) + 1
            END IF
          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
          anzTrip% = anzTrip% + 1
          ' Tripel-"Querbalken" streichen
          FOR k% = 0 TO 2
            staX%(spt%(e2%)) = 3 * ((i% + j%) MOD 3) + k%
            staY%(spt%(e2%)) = 3 * (i% \ 3) + pxy%
            IF NOT s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) THEN
              s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) = -1
              staF%(spt%(e2%)) = z%
              spt%(e2%) = spt%(e2%) + 1
            END IF
          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
          anzTrip% = anzTrip% + 1
          ' Tripel-"Querbalken" streichen
          FOR k% = 0 TO 2
            staX%(spt%(e2%)) = 3 * (i% \ 3) + pyx%
            staY%(spt%(e2%)) = 3 * ((i% + j%) MOD 3) + k%
            IF NOT s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) THEN
              s%(staX%(spt%(e2%)), staY%(spt%(e2%)), z%) = -1
              staF%(spt%(e2%)) = z%
              spt%(e2%) = spt%(e2%) + 1
            END IF
          NEXT k%
        END IF
      NEXT j%
    END IF
  NEXT i%
NEXT z%
RETURN

' Version 4: Suche nach Hidden/Naked-Gruppen (Paare, Tipel, Quadrupel usw.)
SucheHiddenNaked:
anzHidNak% = 0
FOR i% = 0 TO 8
  ' Zeile
  anz% = 0
  FOR z% = 1 TO 9
    hidNaF%(z%) = -1
  NEXT z%
  FOR j% = 0 TO 8
    IF f%(j%, i%) > 0 THEN
      hidNaF%(f%(j%, i%)) = 0
    ELSE
      hidNaX%(anz%) = j%
      hidNaY%(anz%) = i%
      anz% = anz% + 1
    END IF
  NEXT j%
  e% = 0
  iRek%(0) = 0
  GOSUB RekHiddenNaked
  ' Spalte
  anz% = 0
  FOR z% = 1 TO 9
    hidNaF%(z%) = -1
  NEXT z%
  FOR j% = 0 TO 8
    IF f%(i%, j%) > 0 THEN
      hidNaF%(f%(i%, j%)) = 0
    ELSE
      hidNaX%(anz%) = i%
      hidNaY%(anz%) = j%
      anz% = anz% + 1
    END IF
  NEXT j%
  e% = 0
  iRek%(0) = 0
  GOSUB RekHiddenNaked
  ' Quadrat
  anz% = 0
  FOR z% = 1 TO 9
    hidNaF%(z%) = -1
  NEXT z%
  FOR j% = 0 TO 8
    IF f%(3 * (i% MOD 3) + j% MOD 3, 3 * (i% \ 3) + j% \ 3) > 0 THEN
      hidNaF%(f%(3 * (i% MOD 3) + j% MOD 3, 3 * (i% \ 3) + j% \ 3)) = 0
    ELSE
      hidNaX%(anz%) = 3 * (i% MOD 3) + j% MOD 3
      hidNaY%(anz%) = 3 * (i% \ 3) + j% \ 3
      anz% = anz% + 1
    END IF
  NEXT j%
  e% = 0
  iRek%(0) = 0
  GOSUB RekHiddenNaked
NEXT i%
IF anzHidNak% > 0 THEN
  ' Gefunden -> jetzt d�rfen die 1er durch richtige -1er ersetzt werden
  ' unter Zuhilfsnahme vom Stack
  FOR i% = spt%(e2% - 1) TO spt%(e2%) - 1
    s%(staX%(i%), staY%(i%), staF%(i%)) = -1
  NEXT i%
END IF
RETURN

RekHiddenNaked:
WHILE iRek%(e%) < anz%
  SWAP hidNaX%(e%), hidNaX%(iRek%(e%))
  SWAP hidNaY%(e%), hidNaY%(iRek%(e%))
  e% = e% + 1
  IF e% > 1 THEN
    ' ...##.#  Suche der
    ' .......  "Rechteck"-Struktur in der Streichliste
    ' ...##.#
    ' ...##.#
    h% = 0
    FOR z% = 1 TO 9
      IF hidNaF%(z%) THEN
        hidNaS%(z%) = -1
        FOR j% = 0 TO e% - 1
          IF s%(hidNaX%(j%), hidNaY%(j%), z%) <> -1 THEN
            hidNaS%(z%) = 0
          END IF
        NEXT j%
        IF hidNaS%(z%) THEN
          h% = h% + 1
        END IF
      END IF
    NEXT z%
    IF e% + h% > anz% THEN
      ' kann nicht vorkommen, da sonst f�r eine geschlossene Teilgruppe
      ' zuwenig "Platz" w�re -> Widerspruch
      widersp% = -1
    ELSEIF e% + h% = anz% THEN
      ' ...##.#  Treffer: "Rechteck"-Struktur gefunden
      ' XXX..X.  -> "XOR-Schottenmuster" streichen
      ' ...##.#
      ' ...##.#
      tr% = 0
      FOR z% = 1 TO 9
        IF hidNaF%(z%) AND NOT hidNaS%(z%) THEN
          FOR j% = e% TO anz% - 1
            IF s%(hidNaX%(j%), hidNaY%(j%), z%) = 0 THEN
              ' Echter Treffer -> streichen (nur mit 1 wegen Komb.-Level)
              s%(hidNaX%(j%), hidNaY%(j%), z%) = 1
              tr% = -1
              staX%(spt%(e2%)) = hidNaX%(j%)
              staY%(spt%(e2%)) = hidNaY%(j%)
              staF%(spt%(e2%)) = z%
              spt%(e2%) = spt%(e2%) + 1
            END IF
          NEXT j%
        END IF
      NEXT z%
      IF tr% THEN
        anzHidNak% = anzHidNak% + 1
      END IF
    END IF
  END IF
  IF e% < anz% - 2 THEN
    iRek%(e%) = iRek%(e% - 1) + 1
    GOSUB RekHiddenNaked
  END IF
  e% = e% - 1
  SWAP hidNaY%(e%), hidNaY%(iRek%(e%))
  SWAP hidNaX%(e%), hidNaX%(iRek%(e%))
  iRek%(e%) = iRek%(e%) + 1
WEND
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

FUNCTION FuehrNull$ (w%, b%)
  h$ = LTRIM$(STR$(w%))
  FuehrNull$ = STRING$(b% - LEN(h$), 48) + h$
END FUNCTION