Technical details:
First, let me post the code. There are two programs, a main one and a subprogram.
prgmSUDOKU
Code: FnOff :AxesOff
~62->Ymin:0->Xmin:0->Ymax:94->Xmax
{9,9->dim([A]
SetUpEditor |LSUDOS
If not(dim(|LSUDOS
Then
{7->|LSUDOS
ClrDraw
Text(~1,8,20,"WELCOME!
Text(23,20,"PLEASE READ THE
Text(31,20,"MANUAL TO LEARN
Text(39,20,"USING CALKUSUDO.
Text(47,20,"PRESS ANY KEY
0:prgmSUDOKUIO
End
|LSUDOS(1->S
Archive |LSUDOS
Lbl M
ClrDraw
Text(~1,8,20,"CALKUSUDO
Text(23,20,"NEW GAME
Text(31,20,"LOAD GAME
Text(39,20,"SETTINGS
Text(47,20,"QUIT
4->Z
prgmSUDOKUIO
If X=4 or max(int(K)={1,45
Goto Q
If X=2
Goto L
If X=3
Goto S
ClrDraw
Text(~1,8,20,"NEW GAME
20-25[i]->Z
2:prgmSUDOKUIO
Text(28,20,"DIFFICULTY:
20+37[i]->Z
3:prgmSUDOKUIO
Text(37,27,"SYMMETRY
0->R:5->N:1->O
Repeat max(K={45,105
Text(22+15R,14,">
Text(37-15R,14,"
If N!=10
Line(72,~25,22+5.1N,~25,0
Line(21,~25,21+5.1N,~25
Text(28,64,N,"
If O
Then
Pt-On(22,~40
Pt-On(22,~40,2
Else
Pt-Off(22,~40
Pt-Off(22,~40,2
End
0:prgmSUDOKUIO
abs(R-max(int(K)={25,34,2,4->R
If not(R
max(1,min(10,round(N-(int(K)=1)10fPart(K)-(K=24)+(int(K)=3)10fPart(K)+(K=26),0->N
abs(O-Rnot(max(int(K)={2,4,25,34,45,105->O
End
If K=45
Goto M
ClrDraw
0->L
Text(~1,8,18,"GENERATING
Text(~1,17,30,"PUZZLE
20-33[i]->Z
2:prgmSUDOKUIO
[[9,8,2,1,5,4,6,7,3][5,6,1,3,7,2,4,8,9][3,7,4,9,8,6,2,1,5][7,5,6,4,2,8,9,3,1][1,4,3,5,6,9,7,2,8][8,2,9,7,3,1,5,6,4][4,1,7,6,9,3,8,5,2][6,9,8,2,1,5,3,4,7][2,3,5,8,4,7,1,9,6->[A]
For(A,1,2
randInt(0,2,3
seq(randInt(1,3)+3Ans(1+int(A/3)),A,0,8->L1
For(B,1,9
L+1->L
Pxl-On(33,21+int(51L/(186-44O+4N-2NO
rowSwap([A],B,L1(B
End
[A]^^T->[A]
End
rand(9->L2
seq(A,A,1,9->L1
SortA(L2,L1
seq(A,A,1,9->L2
For(A,1,9
For(B,1,9
L+1->L
Pxl-On(33,21+int(51L/(186-44O+4N-2NO
.1+max(L1*([A](A,B)=L2->[A](A,B
End
End
seq(1.1+iPart(A/9)+.9fPart(A/9),A,0,80->L1
If O
41->dim(L1
"dim(L1->|u
For(A,1,(22+N)(2-O
L+2->L
Pxl-On(33,21+int(51L/(186-44O+4N-2NO
randInt(1,|u->B
iPart(L1(B->C
10fPart(L1(B->D
L1(|u->L1(B
|u-1->dim(L1
0->[A](C,D
If O
0->[A](10-C,10-D
End
Goto P
Lbl L
ClrDraw
Text(~1,8,20,"LOAD GAME
Text(23,20,"[SLOT 1]
Text(31,20,"[SLOT 2]
Text(39,20,"[SLOT 3]
Text(47,20,"CANCEL
4->Z
prgmSUDOKUIO
If X=4 or K=45
Goto M
"dim(L1->|u
If X=1
Then
SetUpEditor |LSUDO1
|LSUDO1->L1
If |u
Archive |LSUDO1
If not(|u
DelVar |LSUDO1
End
If X=2
Then
SetUpEditor |LSUDO2
|LSUDO2->L1
If |u
Archive |LSUDO2
If not(|u
DelVar |LSUDO2
End
If X=3
Then
SetUpEditor |LSUDO3
|LSUDO3->L1
If |u
Archive |LSUDO3
If not(|u
DelVar |LSUDO3
End
If dim(Ans
Then
ClrDraw
Text(~1,17,12,"LOADING GAME
20-33[i]->Z
2:prgmSUDOKUIO
For(A,1,9
For(B,1,9
Pxl-On(33,15+int((459A+51B)/79
int(L1(A))/19->L1(A
round(19fPart(Ans),1
If Ans>9
Ans-8.9
Ans->[A](A,10-B
End
End
Else
ClrDraw
Text(~1,8,20,"EMPTY SLOT!
Text(23,20,"PRESS ANY KEY
0:prgmSUDOKUIO
End
If not(dim(L1
Goto L
Lbl P
ClrDraw
Line(19,~1,19,~59
Line(39,~1,39,~59
Line(1,~20,57,~20
Line(1,~40,57,~40
Line(0,0,58,0
Line(58,0,58,~60
Line(58,~60,0,~60
Line(0,~60,0,0
For(A,1,9
For(B,1,9
B+.1A->Z
1:If [A](B,A:prgmSUDOKUIO
End
End
Line(78,~56,95,~56
Line(77,~57,77,~63
Text(57,79,"QUIT
5->N:5->O:5->P:5->Q
Repeat K=15
6N-5+2int((N-1)/3->R
~6O-1-2int((O-1)/3
Line(R,Ans,R+4,Ans
6P-5+2int((P-1)/3->R
~6Q-1-2int((Q-1)/3
If N!=P or O!=Q
Line(R,Ans,R+4,Ans,0
0:prgmSUDOKUIO
N->P:O->Q
round(N-(int(K)=1)10fPart(K)-(K=24)+(int(K)=3)10fPart(K)+(K=26),0->N
9(N<1)+(N>9)+N(N>=1)(N<=9->N
round(O-(int(K)=2)10fPart(K)-(K=25)+(int(K)=4)10fPart(K)+(K=34),0->O
9(O<1)+(O>9)+O(O>=1)(O<=9->O
If K=45 or (K>71 and K<103 and not(fPart([A](O,N)) or max(fPart(.1K)={.1,.5
Then
0->[A](O,N
If K!=45
expr(sub("7894561230",K-71-7(iPart(.1K)-7),1->[A](O,N
O+.1N->Z
1:prgmSUDOKUIO
1->A
For(B,1,9
Matr>list([A],B,L1
Amin(L1->A
End
If A
Then
Text(1,61,"CHECKING
seq(A,A,1,9->L4
{1.1,2.4,3.7,4.2,5.5,6.8,7.3,8.6,9.9->L5
1->A
For(B,1,9
L5(B->Z
5:prgmSUDOKUIO
SortA(L1
SortA(L2
SortA(L3
Amin(L1=L4)min(L2=L4)min(L3=L4->A
End
"MISTAKES
If A
"NO ERRORS
Text(1,61,Ans
Else
If [A](O,N)max(int(.5S)={1,3
Then
Text(1,61,"CHECKING
O+.1N->Z
5:prgmSUDOKUIO
SortD(L1
SortD(L2
SortD(L3
While dim(L1)>2 and not(L1(dim(L1
dim(L1)-1->dim(L1
End
While dim(L2)>2 and not(L2(dim(L2
dim(L2)-1->dim(L2
End
While dim(L3)>2 and not(L3(dim(L3
dim(L3)-1->dim(L3
End
For(A,2,6
Line(61,~A,95,~A,0
End
If not(min(abs(DeltaList(L1)))min(abs(DeltaList(L2)))min(abs(DeltaList(L3
Text(1,61,"MISTAKE
End
End
End
End
If K=15
Then
ClrDraw
Text(~1,8,20,"SAVE GAME?
Text(23,20,"CANCEL
Text(31,20,"[SLOT 1]
Text(39,20,"[SLOT 2]
Text(47,20,"[SLOT 3]
Text(55,20,"DISMISS GAME
5->Z
4:prgmSUDOKUIO
If X=1 or K=45
Goto P
If X=5
Goto M
ClrDraw
Text(~1,17,15,"SAVING GAME
20-33[i]->Z
2:prgmSUDOKUIO
9->dim(L1
For(A,1,9
0->C
For(B,1,9
Pxl-On(33,15+int((459A+51B)/79
[A](A,B
C*19+int(Ans+90fPart(Ans->C
End
C->L1(A
End
If X=2
Then
SetUpEditor |LSUDO1
L1->|LSUDO1
Archive |LSUDO1
End
If X=3
Then
SetUpEditor |LSUDO2
L1->|LSUDO2
Archive |LSUDO2
End
If X=4
Then
SetUpEditor |LSUDO3
L1->|LSUDO3
Archive |LSUDO3
End
Goto M
End
If K=15
Goto M
Goto P
Lbl S
ClrDraw
Text(~1,8,20,"SETTINGS
Text(23,27,"MARK START NUMBERS
Text(31,27,"CHECK EVERY MOVE
Text(39,27,"PAUSE WHEN UNUSED
Text(47,20,"BACK
For(A,23,39,8
20+A[i]->Z
3:prgmSUDOKUIO
End
"2fPart(.5iPart(S/Ans->|u
1:|u->N
2:|u->O
4:|u->P
1->X:1->Y:1->Q
Repeat K=45 or (X=4 and Q
If Q
Then
{N,O,P
For(A,1,3
If Ans(A
Then
Pt-On(22,~18-8A,2
Pt-On(22,~18-8A
Else
Pt-Off(22,~18-8A,2
Pt-Off(22,~18-8A
End
End
End
Text(15+8X,15,">
If X!=Y
Text(15+8Y,15,"
0:prgmSUDOKUIO
not(max(K={2,4,25,34,45->Q
X->Y
X-max(K={2,25})+max(K={4,34->X
X(X>=1)(X<=4)+(X>4)+4(X<1->X
abs(N-Q(X=1->N
abs(O-Q(X=2->O
abs(P-Q(X=3->P
End
N+2O+4P->S
UnArchive |LSUDOS
Ans->|LSUDOS(1
Archive |LSUDOS
Goto M
Lbl Q
DelVar [A]DelVar L1DelVar L2DelVar L3ClrDraw
ClrHome
Output(1,1,"SEE YOU!
prgmSUDOKUIOCode: Ans->theta
If not(Ans
Then
0->|N:0->dim(L1:0->T
Repeat Ans
T+1->T
getKey->K
If S>3 and T>8|E3
Then
ClrHome
Disp "CALKUSUDO IS
Pause "PAUSED
Pt-On(1,1
0->T
End
End
Repeat |N=5
getKey:If Ansnot(max(Ans={23,24,25,26,34
Then
Ans->L1(1+dim(L1
0->|N
Else
|N+1->|N
End
End
If 1<dim(L1
Then
L1->L2
mean(DeltaList(10fPart(.1L1->A
mean(DeltaList(iPart(.1L2->B
If abs(A)>0.1+abs(B
2+A/abs(A)+0.1abs(A->K
If abs(B)>0.1+abs(A
3+B/abs(B)+0.1abs(B->K
End
End
If not(theta
Return
If theta=1
Then
[A](iPart(Z),10fPart(Z->Y
sub("0123456789",1+int(Y),1->Str1
If not(Y
" ->Str1
6iPart(Z)-5+2int(iPart(Z-1)/3->X
60fPart(Z)-4+2int(10fPart(Z-.1)/3->Z
Text(X,Ans,Str1
If fPart(Y)fPart(.5iPart(S
Then
X
For(Y,~1,3
For(X,1,5
Pxl-Change(Ans+X,Z+Y
End
End
End
End
If theta=1
Return
If theta=2
Then
"93-imag([i]Z->|u
imag([i]Z
Pt-On(Ans,imag(Z
Pt-On(|u,imag(Z
Line(Ans+1,imag(Z)+1,|u-1,imag(Z+[i]
Line(Ans+1,imag(Z)-1,|u-1,imag(Z-[i]
End
If theta=3
Then
Z:For(Z,0,6
Text(imag(Ans),imag([i]Ans)+Z,sub("[]]][ ",Z+1,1
End
End
If theta=4
Then
1->X:1->Y
Repeat not(max(int(K)={2,4,25,34
Text(15+8X,14,">
If X!=Y
Text(15+8Y,14,"
0:prgmSUDOKUIO
X->Y
X+max(int(K)={4,34})-max(int(K)={2,25
(Ans>Z)+Znot(Ans)+Ans(Ans<=Z)(Ans>=1->X
End
End
If theta=5
Then
iPart(Z->Y
10fPart(Z->Z
seq(int([A](A,Z)),A,1,9->L1
seq(int([A](Y,A)),A,1,9->L2
seq(int([A](1+3int((Y-1)/3)+int(A/3),1+3int((Z-1)/3)+round(3fPart(A/3),0))),A,0,8->L3
End
I will try to find some time to comment the code one day, if anyone shows interest.
TODO:
- I have barely started optimizing it, I guess one could squeeze another 100 or 200 bytes out of here.
- I want to optimize the Sudoku rendering and generating routines for speed, they are too much of a pain to wait through.
- The checking routine is a weird hacky thing. I want to change that one day, but I found no better solution.
Main algorithm overview:
- The level generator: I basically take a fixed solved Sudoku and scramble it in three steps. First, I scramble the rows and columns, while preserving their sets of three. This would leave fixed recurring patterns, so I additionally conceal that by swapping equal numbers (e.g. all 1's turn to 9's and vice-versa). And finally I create empty spots by replacing some numbers with 0. Obviously this is not a very proper way of generating Sudokus, but it works. Nevertheless, it is slow and I wish to find a better, proper algorithm.
- The checking routine: Of the to-be-checked square, I take the column, row and large square contents as a list. Then I truncate all the zeroes but one, to ensure I always have a list of at least two elements but never two zeroes in it. And then I do min(deltaList(. This is even more hacky than the generator algorithm. 100% needs at least optimization.
- The saving/loading algorithm: For each square, I have 19 distinct possible states: 0 - 9 and initially filled 1 - 9. I save the puzzles with near-optimal compression with a row per list element by basically converting the data from base 19 to base 10 and load them by reversing the process.
Did I miss anything? Let me know and feel free to ask.