RosettaCodeData/Task/Sudoku/BBC-BASIC/sudoku.basic

106 lines
2.4 KiB
Plaintext

VDU 23,22,453;453;8,20,16,128
*FONT Arial,28
DIM Board%(8,8)
Board%() = %111111111
FOR L% = 0 TO 9:P% = L%*100
LINE 2,P%+2,902,P%+2
IF (L% MOD 3)=0 LINE 2,P%,902,P% : LINE 2,P%+4,902,P%+4
LINE P%+2,2,P%+2,902
IF (L% MOD 3)=0 LINE P%,2,P%,902 : LINE P%+4,2,P%+4,902
NEXT
DATA " 4 5 6 "
DATA " 6 1 8 9"
DATA "3 7 "
DATA " 8 5 "
DATA " 4 3 "
DATA " 6 7 "
DATA " 2 6"
DATA "1 5 4 3 "
DATA " 2 7 1 "
FOR R% = 8 TO 0 STEP -1
READ A$
FOR C% = 0 TO 8
A% = ASCMID$(A$,C%+1) AND 15
IF A% Board%(R%,C%) = 1 << (A%-1)
NEXT
NEXT R%
GCOL 4
PROCshow
WAIT 200
dummy% = FNsolve(Board%(), TRUE)
GCOL 2
PROCshow
REPEAT WAIT 1 : UNTIL FALSE
END
DEF PROCshow
LOCAL C%,P%,R%
FOR C% = 0 TO 8
FOR R% = 0 TO 8
P% = Board%(R%,C%)
IF (P% AND (P%-1)) = 0 THEN
IF P% P% = LOGP%/LOG2+1.5
MOVE C%*100+30,R%*100+90
VDU 5,P%+48,4
ENDIF
NEXT
NEXT
ENDPROC
DEF FNsolve(P%(),F%)
LOCAL C%,D%,M%,N%,R%,X%,Y%,Q%()
DIM Q%(8,8)
REPEAT
Q%() = P%()
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = P%(R%,C%)
IF (D% AND (D%-1))=0 THEN
M% = NOT D%
FOR X% = 0 TO 8
IF X%<>C% P%(R%,X%) AND= M%
IF X%<>R% P%(X%,C%) AND= M%
NEXT
FOR X% = C%DIV3*3 TO C%DIV3*3+2
FOR Y% = R%DIV3*3 TO R%DIV3*3+2
IF X%<>C% IF Y%<>R% P%(Y%,X%) AND= M%
NEXT
NEXT
ENDIF
NEXT
NEXT
Q%() -= P%()
UNTIL SUMQ%()=0
M% = 10
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = P%(R%,C%)
IF D%=0 M% = 0
IF D% AND (D%-1) THEN
N% = 0
REPEAT N% += D% AND 1
D% DIV= 2
UNTIL D% = 0
IF N%<M% M% = N% : X% = C% : Y% = R%
ENDIF
NEXT
NEXT
IF M%=0 THEN = 0
IF M%=10 THEN = 1
D% = 0
FOR M% = 0 TO 8
IF P%(Y%,X%) AND (2^M%) THEN
Q%() = P%()
Q%(Y%,X%) = 2^M%
C% = FNsolve(Q%(),F%)
D% += C%
IF C% IF F% P%() = Q%() : = D%
ENDIF
NEXT
= D%