' Copyright (c) Florian Jung, 2007, 2008
'https://windfisch.org/puzzlesol/sudoku.html
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
' このプログラムはフリーソフトです。
'FreeSoftware Foundation 発行の GNU General Public License の条件に基づいて、
'ラ イセンスのバージョン3または（オプション） 以降のバージョンのいずれかで、
' プログラムを再配布または変更できます。
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
' このプログラムは、役立つことを期待して配布されていますが、いかなる保証もありません。
' 商品性または特定の目的への適合性の暗黙の保証さえありません。
' 詳細については、GNU General Public License を参照してください。
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see <http://www.gnu.org/licenses/ >.
' このプログラムと共に、GNU General Public License のコピーを
' 受け取っていない場合は、<http://www.gnu.org/licenses/ >を参照してください。
'
' compile with FreeBASIC: fbc -lang qb sudoku.bas
'
'Funktionsweise des Sudokuknackers:
'数独クラッカーの仕組み
'Grundlegendes Prinzip:
'基本的な原則
'======================
'
'Das Sudoku wird mit 3 verschiedenen Strategien (die auch
'unterschiedlich zeitaufwendig sind) durchgearbeitet.
'Es wird zuerst die schnelle Strategie 1 verwendet.
'Wenn diese Strategie in einem Durchlauf keine einzige klare
'Zahl errechnet hat, und keine leeren Felder mehr existieren,
'ist das Sudoku gelost. Sollte sie aber erfolglos sein, obwohl
'noch unklare Kastchen existieren, wird die langsamere
'Strategie 2 angewandt. Sollte auch sie erfolglos bleiben, wird
'die langsamste Strategie 3 angewandt, wenn auch diese versagt,
'wird das Sudoku als unlosbar erklart.
'数独は3つの異なる戦略で処理されます（これには時間もかかります）。
'最初に高速戦略1が使用されます。
'この戦略で1回の実行で1 つの明確な数値が計算されず、
'空のフィールドが残っていない場合、数独は解決されます。
'それが失敗した場合、まだ不明なボックスが存在しますが、
'より遅い戦略2が使用されます。
'それも失敗した場合は、最も遅い戦略3が使用されます。
'これも失敗した場合、数独は解決不可能と宣言されます。
'
'
'Funktionsweise von Strategie 1
'戦略1の仕組み
'==============================
'
'Es werden der Reihe nach alle noch leeren Felder des Sudokus
'abgearbeitet, und alle nicht moglichen Zahlen (weil sie schon
'woanders in diesem System verwendet wurden) als unmoglich
'markiert. Ist nur noch eine Zahl in diesem Feld moglich, wird
'sie angezeigt, das Feld wird in Zukunft von allen Strategien
'ubergangen.
'Erklarung: Das sind die Regeln ;)
'数独のすべての空のフィールドは順番に処理され、
'すべての不可能な数（他の場所ですでに使用されている）は、
'不可能なものとしてマークされます。
'このフィールドで可能な数字が1 つだけの場合、その数字が表示されます。
'今後、このフィールドはすべての戦略で無視されます。
'説明：これらはルールです ;)
'
'
'Funktionsweise von Strategie 2
'戦略2の仕組み
'==============================
'
'Es wird in allen Reihen, Spalten und 3x3-Kгtchen der Reihe
'nach gepr’t, ob eine noch fehlende Zahl in nur einem Feld
'moglich ist. Ist das der Fall, wird sie dort eingetragen.
'Erkl"rung: die Zahl MUSS irgendwo in dem System stehen, und
' wenn nicht an dieser Position, wo dann?
'すべての行、列、および3x3 ブロックが次々にチェックされ、
'欠落している数字が1 つのフィールドでのみ可能かどうかが確認されます。
'この場合、そこに入力されます。
'説明：数はシステムのどこかにある必要があり、
'この位置にない場合、どこにありますか？
'
'Funktionsweise von Strategie 3
'戦略3の仕組み
'==============================
'
'In allen Reihen, Spalten und 3x3-Kastchen wird uberpruft, ob
'in diesem System z.B. in zwei Feldern jeweils nur noch 4 oder
'7 moglich sind, oder in drei Feldern nur noch 3/5, 5/8 und
'8/3 moglich sind etc. Ist dies der Fall, konnen diese Zahlen
'(4 und 7 im ersten Beispiel, 3,5 und 8 im zweiten) nirgendwo
'anders in diesem System existieren, also werden sie in allen
'ubrigen Feldern des Systems als nicht moglich vermerkt.
'すべての行、列、3x3 ボックスで、
'たとえば、 2 つのフィールドでは4または7 のみが可能であり、
'3 つのフィールドでは3/5、5/8および8/3 のみが可能です。
'この場合、これらの数値（最初の例では4および7、3 、2番目の5と8）は、
'このシステムの他の場所には存在しないため、
'システムの他のすべてのフィールドでは不可能であると記載されています。
'Erklarung: angenommen, wir haben ein Set aus n Zahlen, im
' Beispiel sei n = 3: wir haben die Zahlen a,b,c
' und in jedem Feld seien alle 3 Zahlen noch moglich.
' jetzt nehmen wir nacheinander fur Feld 1 die Werte
' a,b,c an (irgendeiner muss ja drinstehen!)
' Feld 1: a Feld 2: b oder c Feld 3: b oder c
' Feld 1: b Feld 2: a oder c Feld 3: a oder c
' Feld 1: c Feld 2: a oder b Feld 3: a oder b
' Wie man sieht, hat man in jedem Fall dieselben
' n-1 M"glichkeiten in Feld 2 und Feld 3. Jetzt
' sind wir wieder am Ausgangspunkt,nur dass unser Set
' um eins kleiner wurde (welche Zahl nun fehlt ist
' ohne Bedeutung) und auch die fraglichen Felder
' eins weniger sind. Also ist n=2, wir haben die zwei
' Werte a und b (das haben wir hiermit neu definiert)
' und Felder 2 und 3 heiben jetzt 1 und 2.
' Feld 1: a Feld 2: b
' Feld 1: b Feld 2: a
' Jetzt sind samtliche Zweifel ausgeschlossen, diese
' drei (zwei, funf, egal wie viele) Zahlen mussen
' dort verwendet worden sein und nicht woanders.
' Also konnen sie woanders nicht mehr sein!
' Das ganze funktioniert auch, wenn die n Felder
' nicht das gesamte Set enthalten.
' 説明：n個の数値のセットがあるとします。
' 例 n = 3：数字a、b、c があり、各フィールドで3 つの数字はすべて可能です。
' 今度は、フィールド1の値a、b、cを順番に取得します（何かがそこにある必要があります！）
' フィールド1：a フィールド2：bまたはc フィールド3：bまたはc
' フィールド1：b フィールド2：aまたはc フィールド3：aまたはc
' フィールド1：c フィールド2：aまたはb フィールド3：aまたはb
' ご覧のように、フィールド2 とフィールド3には常に同じn-1 の可能性があります。
' これで開始点に戻りましたが、セットが1減っただけです（欠落している数は関係ありません）。
' また、問題のフィールドもあります。 1つ少ない。
' したがって、n = 2、2つの値aおよびb （これを再定義しました）があり、
' フィールド2および3は1および2と呼ばれるようになりました。
' フィールド1：a フィールド2：b
' フィールド1：b フィールド2：a
' ここですべての疑いが除外され、
' これらの3つ（2つ、5つ、いくつあっても）の数値がそこで使用され、
' 他では使用されていないはずです。
' だから彼らは他のどこにもいることはできません！
' n フィールドにセット全体が含まれていなくても、全体が機能します。
'DEFINT A-Z
'$lang: "qb"
CLS
LOCATE 2, 23: PRINT "Sudoku-Knacker Version 3.0";
LOCATE 3, 23: PRINT "Copyright 2008 by Florian Jung";
LOCATE 4, 23: PRINT "Lizenz: GPL3 oder hoher"
LOCATE 5, 23: PRINT "Kontakt: flo@windfisch.org"
LOCATE 6, 23: PRINT "ICQ: 305-487-969"
LOCATE 14, 1
'PRINT "Bitte die gegebenen"
'PRINT "Zahlen eingeben, fur"
'PRINT "ein leeres Feld 0, ?"
'PRINT "oder [LEER], Korrek-"
'PRINT "tur mit [BACKSPACE]"
PRINT "各フィールドに、問題を入力して下さい。"
PRINT "空白は 0、？、[空白]で、"
PRINT "数値はキーで入力してください。"
PRINT "入力修正は[BACKSPACE]を使います。"
PRINT "右下まで入力が終わると、解析開始します。"
LOCATE 1, 1
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
PRINT
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
PRINT
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
PRINT "? ? ? ? ? ? ? ? ?"
DIM feld(1 TO 9, 1 TO 9, 1 TO 9)
DIM hat(1 TO 9)
DIM set(1 TO 9), cnt(1 TO 9), cnta(1 TO 9), cntb(1 TO 9)
DIM cnt1, cnt2, cnt1a, cnt1b, cnt2a, cnt2b, success
FOR y = 1 TO 9
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
FOR x = 1 TO 9
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
LOCATE ly, lx: COLOR 0, 7: PRINT "?";
DO
i$ = INKEY$
SELECT CASE i$
CASE "0" TO "9", "?", " ": EXIT DO
CASE CHR$(8)
IF y > 1 OR x > 1 THEN
IF x = 1 THEN x = 9: y = y - 1 ELSE x = x - 1
LOCATE ly, lx: COLOR 7, 0: PRINT "?";
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
LOCATE ly, lx: COLOR 0, 7: PRINT "?";
ELSE
BEEP
END IF
CASE CHR$(27): COLOR 7, 0: CLS : END
END SELECT
LOOP
FOR i = 1 TO 9
feld(x, y, i) = 0
NEXT
LOCATE ly, lx: COLOR 7, 0
IF VAL(i$) <> 0 THEN
feld(x, y, VAL(i$)) = -1: PRINT i$;
ELSE
FOR i = 1 TO 9
feld(x, y, i) = -1
NEXT
PRINT "?";
END IF
NEXT
NEXT
LOCATE 14, 1: PRINT SPACE$(20): PRINT SPACE$(20): PRINT SPACE$(20): PRINT SPACE$(20): PRINT SPACE$(20)
LOCATE 14, 1
'PRINT "Das Programm arbeitet"
'PRINT "Bitte haben Sie etwas"
'PRINT "Geduld..."
PRINT "プログラムは動作中です。 "
PRINT "しばらくお待ちください... "
PRINT " "
ox = 1: oy = 1
s& = TIMER
durch = -1
DO
solved = 0
durch = durch + 1
ganzja = 0
FOR x = 1 TO 9
IF INKEY$ = CHR$(27) THEN
COLOR 7, 0
LOCATE 13, 1: PRINT " ";
LOCATE 14, 1: PRINT SPACE$(22): PRINT SPACE$(22): PRINT SPACE$(22)
LOCATE 14, 1
'PRINT "Das Programm wurde"
'PRINT "unterbrochen."
PRINT "プログラムが中断されました。 "
PRINT " "
END
END IF
FOR y = 1 TO 9
IF x > 6 THEN lx = x * 2 + 2 ELSE IF x > 3 THEN lx = x * 2 + 1 ELSE lx = x * 2
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
LOCATE ly, lx: PRINT "<";
IF ox > 6 THEN lx = ox * 2 + 2 ELSE IF ox > 3 THEN lx = ox * 2 + 1 ELSE lx = ox * 2
IF oy > 6 THEN ly = oy + 2 ELSE IF oy > 3 THEN ly = oy + 1 ELSE ly = oy
LOCATE ly, lx: PRINT " ";
ox = x: oy = y
ja = 1
FOR i = 1 TO 9
IF feld(x, y, i) = -1 THEN
IF ja = 1 THEN ja = 0 ELSE ja = -1: EXIT FOR
END IF
NEXT
IF ja = -1 THEN
ganzja = -1
FOR xx = 1 TO 9
IF xx <> x THEN
nr = 0
FOR i = 1 TO 9
IF feld(xx, y, i) = -1 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN feld(x, y, nr) = 0
END IF
NEXT
FOR yy = 1 TO 9
IF yy <> y THEN
nr = 0
FOR i = 1 TO 9
IF feld(x, yy, i) = -1 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN feld(x, y, nr) = 0
END IF
NEXT
SELECT CASE x
CASE 1 TO 3: vonx = 1
CASE 4 TO 6: vonx = 4
CASE 7 TO 9: vonx = 7
END SELECT
SELECT CASE y
CASE 1 TO 3: vony = 1
CASE 4 TO 6: vony = 4
CASE 7 TO 9: vony = 7
END SELECT
FOR xx = vonx TO vonx + 2
FOR yy = vony TO vony + 2
IF xx <> x THEN
IF yy <> y THEN
nr = 0
FOR i = 1 TO 9
IF feld(xx, yy, i) = -1 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN feld(x, y, nr) = 0
END IF
END IF
NEXT
NEXT
nr = 0
FOR i = 1 TO 9
IF feld(x, y, i) = -1 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
LOCATE ly, lx: PRINT RTRIM$(LTRIM$(STR$(nr))); : solved = -1
END IF
END IF
zeich = zeich + 1: IF zeich = 4 THEN zeich = 0
LOCATE 13, 1
SELECT CASE zeich
CASE 1: PRINT "|";
CASE 2: PRINT "/";
CASE 3: PRINT "-";
CASE 0: PRINT "\";
END SELECT
NEXT
NEXT
IF ganzja AND solved = 0 THEN 'Strategie 2
'LOCATE 13, 5: PRINT "*";
FOR x = 1 TO 9 'Vertikale Richtung
FOR i = 1 TO 9
hat(i) = 0
NEXT
LOCATE 13, 5: PRINT RTRIM$(LTRIM$(STR$(x)));
machmal = 0
FOR y = 1 TO 9
nr = 0
FOR i = 1 TO 9
IF feld(x, y, i) <> 0 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN hat(nr) = -1 ELSE machmal = -1
NEXT
IF machmal THEN
FOR y = 1 TO 9
FOR i = 1 TO 9
IF hat(i) <> -1 THEN
IF feld(x, y, i) THEN
hat(i) = hat(i) + 1
END IF
END IF
NEXT
NEXT
FOR i = 1 TO 9
IF hat(i) = 1 THEN
FOR y = 1 TO 9
IF feld(x, y, i) = -1 THEN
FOR j = 1 TO 9
feld(x, y, j) = 0
NEXT
feld(x, y, i) = -1
solved = -1
nr = i
IF nr <> 10 THEN
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
LOCATE ly, lx: PRINT RTRIM$(LTRIM$(STR$(nr))); : solved = -1
END IF
EXIT FOR
END IF
NEXT
END IF
NEXT
END IF
NEXT
FOR y = 1 TO 9 'Horizontale Richtung
FOR i = 1 TO 9
hat(i) = 0
NEXT
LOCATE 13, 6: PRINT RTRIM$(LTRIM$(STR$(y)));
machmal = 0
FOR x = 1 TO 9
nr = 0
FOR i = 1 TO 9
IF feld(x, y, i) <> 0 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN hat(nr) = -1 ELSE machmal = -1
NEXT
IF machmal THEN
FOR x = 1 TO 9
FOR i = 1 TO 9
IF hat(i) <> -1 THEN
IF feld(x, y, i) THEN
hat(i) = hat(i) + 1
END IF
END IF
NEXT
NEXT
FOR i = 1 TO 9
IF hat(i) = 1 THEN
FOR x = 1 TO 9
IF feld(x, y, i) = -1 THEN
FOR j = 1 TO 9
feld(x, y, j) = 0
NEXT
feld(x, y, i) = -1
solved = -1
nr = i
IF nr <> 10 THEN
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
LOCATE ly, lx: PRINT RTRIM$(LTRIM$(STR$(nr))); : solved = -1
END IF
EXIT FOR
END IF
NEXT
END IF
NEXT
END IF
NEXT
FOR xx = 1 TO 3 '3x3 Blocks
FOR yy = 1 TO 3
FOR i = 1 TO 9
hat(i) = 0
NEXT
LOCATE 13, 7: PRINT RTRIM$(LTRIM$(STR$(xx * 3 - 3 + yy)));
machmal = 0
FOR x = xx * 3 - 2 TO xx * 3
FOR y = yy * 3 - 2 TO yy * 3
nr = 0
FOR i = 1 TO 9
IF feld(x, y, i) <> 0 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 10 THEN hat(nr) = -1 ELSE machmal = -1
NEXT
NEXT
IF machmal THEN
FOR x = xx * 3 - 2 TO xx * 3
FOR y = yy * 3 - 2 TO yy * 3
FOR i = 1 TO 9
IF hat(i) <> -1 THEN
IF feld(x, y, i) THEN
hat(i) = hat(i) + 1
END IF
END IF
NEXT
NEXT
NEXT
FOR i = 1 TO 9
IF hat(i) = 1 THEN
FOR x = xx * 3 - 2 TO xx * 3
FOR y = yy * 3 - 2 TO yy * 3
IF feld(x, y, i) = -1 THEN
FOR j = 1 TO 9
feld(x, y, j) = 0
NEXT
feld(x, y, i) = -1
solved = -1
nr = i
IF nr <> 10 THEN
IF x > 6 THEN lx = x * 2 + 1 ELSE IF x > 3 THEN lx = x * 2 ELSE lx = x * 2 - 1
IF y > 6 THEN ly = y + 2 ELSE IF y > 3 THEN ly = y + 1 ELSE ly = y
LOCATE ly, lx: PRINT RTRIM$(LTRIM$(STR$(nr))); : solved = -1
END IF
EXIT FOR
END IF
NEXT
NEXT
END IF
NEXT
END IF
NEXT
NEXT
LOCATE 13, 5: PRINT " ";
END IF
IF ganzja AND solved = 0 THEN 'Strategie 3
success = 0
FOR x = 1 TO 9 'Phase 1: schnell
LOCATE 13, 9: PRINT RTRIM$(LTRIM$(STR$(x)));
cnt1 = 0
DO 'g〕tiges cnt1 suchen
cnt1 = cnt1 + 1
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt1, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt1 < 8
IF isclear <> 1 THEN 'wenn eins gefunden wurde
cnt2 = cnt1
DO
cnt2 = cnt2 + 1
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt2, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt2 < 9
IF isclear <> 1 THEN 'alle z�hler auf startpos.
DO
setcnt = 0
FOR i = 1 TO 9 'z�hlen
IF feld(x, cnt1, i) OR feld(x, cnt2, i) THEN setcnt = setcnt + 1
NEXT
IF setcnt = 2 THEN 'set gefunden!
FOR i = 1 TO 9
IF i <> cnt1 AND i <> cnt2 THEN 'ein feld das nicht das set h�lt
FOR m = 1 TO 9 'alle setelemente nullen
IF feld(x, cnt1, m) OR feld(x, cnt2, m) THEN
IF feld(x, i, m) THEN feld(x, i, m) = 0: success = -1
END IF
NEXT
END IF
NEXT 'ok, alle felder abgearbeitet...
END IF
'weiterz�hlen...
DO
cnt2 = cnt2 + 1
IF cnt2 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt2, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
DO
cnt1 = cnt1 + 1
IF cnt1 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt1, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
ELSE
cnt2 = cnt1
DO
cnt2 = cnt2 + 1
IF cnt2 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt2, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
'ende
END IF
END IF
END IF
'LOCATE 3, 1: PRINT cnt1: PRINT cnt2
LOOP
END IF
END IF
NEXT
FOR y = 1 TO 9
LOCATE 13, 10: PRINT RTRIM$(LTRIM$(STR$(y)));
cnt1 = 0
DO 'g〕tiges cnt1 suchen
cnt1 = cnt1 + 1
isclear = 0
FOR i = 1 TO 9
IF feld(cnt1, y, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt1 < 8
IF isclear <> 1 THEN 'wenn eins gefunden wurde
cnt2 = cnt1
DO
cnt2 = cnt2 + 1
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2, y, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt2 < 9
IF isclear <> 1 THEN 'alle z�hler auf startpos.
DO
setcnt = 0
FOR i = 1 TO 9 'z�hlen
IF feld(cnt1, y, i) OR feld(cnt2, y, i) THEN setcnt = setcnt + 1
NEXT
IF setcnt = 2 THEN 'set gefunden!
FOR i = 1 TO 9
IF i <> cnt1 AND i <> cnt2 THEN 'ein feld das nicht das set h�lt
FOR m = 1 TO 9 'alle setelemente nullen
IF feld(cnt1, y, m) OR feld(cnt2, y, m) THEN
IF feld(i, y, m) THEN feld(i, y, m) = 0: success = -1
END IF
NEXT
END IF
NEXT 'ok, alle felder abgearbeitet...
END IF
'weiterz�hlen...
DO
cnt2 = cnt2 + 1
IF cnt2 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2, y, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
DO
cnt1 = cnt1 + 1
IF cnt1 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt1, y, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
ELSE
cnt2 = cnt1
DO
cnt2 = cnt2 + 1
IF cnt2 = 10 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2, y, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
'ende
END IF
END IF
END IF
'LOCATE 3, 1: PRINT cnt1: PRINT cnt2
LOOP
END IF
END IF
NEXT
FOR xx = 1 TO 7 STEP 3
FOR yy = 1 TO 7 STEP 3
LOCATE 13, 11: PRINT RTRIM$(LTRIM$(STR$(yy \ 3 + xx)));
cnt1a = xx - 1: cnt1b = yy
cnt1 = 0
DO 'g〕tiges cnt1 suchen
cnt1 = cnt1 + 1
cnt1a = cnt1a + 1
IF cnt1a = xx + 3 THEN cnt1a = xx: cnt1b = cnt1b + 1
isclear = 0
FOR i = 1 TO 9
IF feld(cnt1a, cnt1b, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt1 < 8
IF isclear <> 1 THEN 'wenn eins gefunden wurde
cnt2 = cnt1
cnt2a = cnt1a
cnt2b = cnt1b
DO
cnt2 = cnt2 + 1
cnt2a = cnt2a + 1
IF cnt2a = xx + 3 THEN cnt2a = xx: cnt2b = cnt2b + 1
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2a, cnt2b, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN EXIT DO
LOOP WHILE cnt2 < 9
IF isclear <> 1 THEN 'alle z�hler auf startpos.
DO
setcnt = 0
FOR i = 1 TO 9 'z�hlen
IF feld(cnt1a, cnt1b, i) OR feld(cnt2a, cnt2b, i) THEN setcnt = setcnt + 1
NEXT
IF setcnt = 2 THEN 'set gefunden!
FOR xi = xx TO xx + 2
FOR yi = yy TO yy + 2
IF xi <> cnt1a AND yi <> cnt1b AND xi <> cnt2a AND yi <> cnt2b THEN 'ein feld das nicht das set h�lt
FOR m = 1 TO 9 'alle setelemente nullen
IF feld(cnt1a, cnt1b, m) OR feld(cnt2a, cnt2b, m) THEN
IF feld(xi, yi, m) THEN feld(xi, yi, m) = 0: success = -1
END IF
NEXT
END IF
NEXT
NEXT 'ok, alle felder abgearbeitet...
END IF
'weiterz�hlen...
DO
'cnt2 = cnt2 + 1
cnt2a = cnt2a + 1
IF cnt2a = xx + 3 THEN cnt2a = xx: cnt2b = cnt2b + 1
IF cnt2b = yy + 3 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2a, cnt2b, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
DO
'cnt1 = cnt1 + 1
cnt1a = cnt1a + 1
IF cnt1a = xx + 3 THEN cnt1a = xx: cnt1b = cnt1b + 1
IF cnt1b = yy + 3 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt1a, cnt1b, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
ELSE
cnt2a = cnt1a
cnt2b = cnt1b
DO
cnt2a = cnt2a + 1
IF cnt2a = xx + 3 THEN cnt2a = xx: cnt2b = cnt2b + 1
IF cnt2b = yy + 3 THEN isclear = 1: EXIT DO
isclear = 0
FOR i = 1 TO 9
IF feld(cnt2a, cnt2b, i) = -1 THEN isclear = isclear + 1
NEXT
'IF isclear <> 1 THEN EXIT DO
LOOP WHILE isclear = 1
IF isclear = 1 THEN
EXIT DO
'ende
END IF
END IF
END IF
LOOP
END IF
END IF
NEXT
NEXT
LOCATE 13, 9: PRINT " ";
IF success = 0 THEN
LOCATE 15, 17: PRINT "viel ";
COLOR 0, 7
FOR x = 1 TO 9
LOCATE 13, 9: PRINT RTRIM$(LTRIM$(STR$(x)));
cntpos = 1: cnt(1) = 0
DO
cnt(cntpos) = cnt(cntpos) + 1
WHILE cnt(cntpos) = 10
IF cntpos = 1 THEN EXIT DO
'else:
cntpos = cntpos - 1
cnt(cntpos) = cnt(cntpos) + 1
WEND
isclear = 0
FOR i = 1 TO 9
IF feld(x, cnt(cntpos), i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN
setsize = 0
FOR i = 1 TO 9
bla = 0
FOR j = 1 TO cntpos
IF feld(x, cnt(j), i) THEN bla = -1: EXIT FOR
NEXT
IF bla THEN setsize = setsize + 1: set(i) = -1 ELSE set(i) = 0
NEXT
IF setsize = cntpos THEN 'wir haben ein komplettes set gefunden!
FOR y = 1 TO 9
settemp = -1
FOR cntpos = 1 TO setsize 'eig. TO cntpos_alt, aber ist ja gleich
IF y = cnt(cntpos) THEN settemp = 0: EXIT FOR
NEXT
cntpos = setsize
IF settemp THEN
FOR i = 1 TO 9
IF set(i) <> 0 THEN IF feld(x, y, i) <> 0 THEN feld(x, y, i) = 0: success = -1
NEXT
END IF
NEXT
cntpos = 1
ELSE 'kein komplettes set gefunden
cntpos = cntpos + 1
IF cntpos = 10 THEN cntpos = 9 ELSE cnt(cntpos) = cnt(cntpos - 1)
END IF
END IF 'von if not isclear...
LOOP
NEXT
FOR y = 1 TO 9
LOCATE 13, 10: PRINT RTRIM$(LTRIM$(STR$(y)));
cntpos = 1: cnt(1) = 0
DO
cnt(cntpos) = cnt(cntpos) + 1
WHILE cnt(cntpos) = 10
IF cntpos = 1 THEN EXIT DO
'else:
cntpos = cntpos - 1
cnt(cntpos) = cnt(cntpos) + 1
WEND
isclear = 0
FOR i = 1 TO 9
IF feld(cnt(cntpos), y, i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN
setsize = 0
FOR i = 1 TO 9
bla = 0
FOR j = 1 TO cntpos
IF feld(cnt(j), y, i) THEN bla = -1: EXIT FOR
NEXT
IF bla THEN setsize = setsize + 1: set(i) = -1 ELSE set(i) = 0
NEXT
IF setsize = cntpos THEN 'wir haben ein komplettes set gefunden!
FOR x = 1 TO 9
settemp = -1
FOR cntpos = 1 TO setsize 'eig. TO cntpos_alt, aber ist ja gleich
IF x = cnt(cntpos) THEN settemp = 0: EXIT FOR
NEXT
cntpos = setsize
IF settemp THEN
FOR i = 1 TO 9
IF set(i) <> 0 THEN IF feld(x, y, i) <> 0 THEN feld(x, y, i) = 0: success = -1
NEXT
END IF
NEXT
cntpos = 1
ELSE 'kein komplettes set gefunden
cntpos = cntpos + 1
IF cntpos = 10 THEN cntpos = 9 ELSE cnt(cntpos) = cnt(cntpos - 1)
END IF
END IF 'von if not isclear...
LOOP
NEXT
FOR xx = 1 TO 7 STEP 3
FOR yy = 1 TO 7 STEP 3
LOCATE 13, 11: PRINT RTRIM$(LTRIM$(STR$(yy \ 3 + xx)));
cntpos = 1: cnta(1) = xx - 1: cntb(1) = yy
DO
cnta(cntpos) = cnta(cntpos) + 1
IF cnta(cntpos) = xx + 3 THEN cnta(cntpos) = xx: cntb(cntpos) = cntb(cntpos) + 1
WHILE cntb(cntpos) = yy + 3
IF cntpos = 1 THEN EXIT DO
'else:
cntpos = cntpos - 1
cnta(cntpos) = cnta(cntpos) + 1
IF cnta(cntpos) = xx + 3 THEN cnta(cntpos) = xx: cntb(cntpos) = cntb(cntpos) + 1
WEND
isclear = 0
FOR i = 1 TO 9
IF feld(cnta(cntpos), cntb(cntpos), i) = -1 THEN isclear = isclear + 1
NEXT
IF isclear <> 1 THEN
setsize = 0
FOR i = 1 TO 9
bla = 0
FOR j = 1 TO cntpos
IF feld(cnta(j), cntb(j), i) THEN bla = -1: EXIT FOR
NEXT
IF bla THEN setsize = setsize + 1: set(i) = -1 ELSE set(i) = 0
NEXT
IF setsize = cntpos THEN 'wir haben ein komplettes set gefunden!
FOR x = xx TO xx + 2
FOR y = yy TO yy + 2
settemp = -1
FOR cntpos = 1 TO setsize 'eig. TO cntpos_alt, aber ist ja gleich
IF x = cnta(cntpos) AND y = cntb(cntpos) THEN settemp = 0: EXIT FOR
NEXT
cntpos = setsize
IF settemp THEN
FOR i = 1 TO 9
IF set(i) <> 0 THEN IF feld(x, y, i) <> 0 THEN feld(x, y, i) = 0: success = -1
NEXT
END IF
NEXT
NEXT
cntpos = 1
ELSE 'kein komplettes set gefunden
cntpos = cntpos + 1
IF cntpos = 10 THEN cntpos = 9 ELSE cnta(cntpos) = cnta(cntpos - 1): cntb(cntpos) = cntb(cntpos - 1)
END IF
END IF 'von if not isclear...
LOOP
NEXT
NEXT
COLOR 7, 0
LOCATE 15, 17: PRINT "etwas";
END IF
LOCATE 13, 9: PRINT "...";
FOR xx = 1 TO 9
FOR yy = 1 TO 9
nr = 0
FOR i = 1 TO 9
IF feld(xx, yy, i) = -1 THEN IF nr = 0 THEN nr = i ELSE nr = 10
NEXT
IF nr <> 0 AND nr <> 10 THEN
IF xx > 6 THEN lx = xx * 2 + 1 ELSE IF xx > 3 THEN lx = xx * 2 ELSE lx = xx * 2 - 1
IF yy > 6 THEN ly = yy + 2 ELSE IF yy > 3 THEN ly = yy + 1 ELSE ly = yy
LOCATE ly, lx: PRINT RTRIM$(LTRIM$(STR$(nr)));
END IF
NEXT
NEXT
LOCATE 13, 9: PRINT " ";
END IF
IF ganzja AND solved = 0 AND success = 0 THEN
LOCATE 11, 20: PRINT " ";
LOCATE 13, 1: PRINT " ";
LOCATE 14, 1: PRINT SPACE$(22): PRINT SPACE$(22): PRINT SPACE$(22)
LOCATE 13, 1
'PRINT "Das Programm konnte"
'PRINT "keine Losung finden"
'PRINT "Uberprufen Sie ggf."
'PRINT "Ihre Eingaben oder"
'PRINT "melden Sie mir den"
'PRINT "Bug.";
PRINT "プログラムは解決策を見つけることができませんでした。"
PRINT "必要に応じて入力内容を確認してください。 "
PRINT "内容やバグを報告してください。"
PRINT " "
PRINT " ";
SLEEP
END
END IF
LOOP UNTIL ganzja = 0
zeit& = FIX(TIMER - s&)
LOCATE 11, 20: PRINT " ";
min = zeit& \ 60
sec = zeit& - min * 60
LOCATE 13, 1: PRINT " ";
LOCATE 14, 1: PRINT SPACE$(22): PRINT SPACE$(22): PRINT SPACE$(22)
LOCATE 14, 1
'PRINT "Das Sudoku wurde in "
PRINT "数独は、 "
'PRINT RTRIM$(LTRIM$(STR$(min))) + " Min. und "; RTRIM$(LTRIM$(STR$(sec))) + " Sek. "
PRINT RTRIM$(LTRIM$(STR$(min))) + " 分、 "; RTRIM$(LTRIM$(STR$(sec))) + " 秒. ";
'PRINT "mit "; RTRIM$(LTRIM$(STR$(durch))); " Durchlеfen"
PRINT ""; RTRIM$(LTRIM$(STR$(durch)))
'PRINT "gelost."
PRINT "で解決しました。 "
PRINT " "
PRINT " "
SLEEP
END
