' Copyright (c) Florian Jung, 2007, 2008 ' ' 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. ' ' 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. ' ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . ' ' 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 gel”st. Sollte sie aber erfolglos sein, obwohl 'noch unklare K„stchen 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 unl”sbar erkl„rt. ' ' 'Funktionsweise von Strategie 1 '============================== ' 'Es werden der Reihe nach alle noch leeren Felder des Sudokus 'abgearbeitet, und alle nicht m”glichen Zahlen (weil sie schon 'woanders in diesem System verwendet wurden) als unm”glich 'markiert. Ist nur noch eine Zahl in diesem Feld m”glich, wird 'sie angezeigt, das Feld wird in Zukunft von allen Strategien 'bergangen. 'Erkl„rung: Das sind die Regeln ;) ' 'Funktionsweise von Strategie 2 '============================== ' 'Es wird in allen Reihen, Spalten und 3x3-K„stchen der Reihe 'nach geprft, ob eine noch fehlende Zahl in nur einem Feld 'm”glich 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? ' 'Funktionsweise von Strategie 3 '============================== ' 'In allen Reihen, Spalten und 3x3-K„stchen wird berprft, ob 'in diesem System z.B. in zwei Feldern jeweils nur noch 4 oder '7 m”glich sind, oder in drei Feldern nur noch 3/5, 5/8 und '8/3 m”glich sind etc. Ist dies der Fall, k”nnen 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 'brigen Feldern des Systems als nicht m”glich vermerkt. 'Erkl„rung: 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 m”glich. ' jetzt nehmen wir nacheinander fr 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 heiáen jetzt 1 und 2. ' Feld 1: a Feld 2: b ' Feld 1: b Feld 2: a ' Jetzt sind s„mtliche Zweifel ausgeschlossen, diese ' drei (zwei, fnf, egal wie viele) Zahlen mssen ' dort verwendet worden sein und nicht woanders. ' Also k”nnen sie woanders nicht mehr sein! ' Das ganze funktioniert auch, wenn die n Felder ' nicht das gesamte Set enthalten. 'DEFINT A-Z 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 h”her" 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, fr" PRINT "ein leeres Feld 0, ?" PRINT "oder [LEER], Korrek-" PRINT "tur mit [BACKSPACE]" 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..." 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." 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ltiges 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ltiges 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ltiges 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 L”sung finden" PRINT "šberprfen Sie ggf." PRINT "Ihre Eingaben oder" PRINT "melden Sie mir den" PRINT "Bug."; 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 RTRIM$(LTRIM$(STR$(min))) + " Min. und "; RTRIM$(LTRIM$(STR$(sec))) + " Sek. " PRINT "mit "; RTRIM$(LTRIM$(STR$(durch))); " Durchl„ufen" PRINT "gel”st." SLEEP END