Fast sudoku solver
Monkey Forums/Monkey Programming/Fast sudoku solver
| ||
| strict global start:Int[]= [ 0,308,0, 75,0,180, 2,10,400, 510,30,96, 0,0,0, 640,90,18, 8,60,900, 91,0,670, 0,905,0 ] Global indexes:Int[]= [ 0,9,18,0,10,18,0,11,18, 0,12,19,0,13,19,0,14,19, 0,15,20,0,16,20,0,17,20, 1,9,18,1,10,18,1,11,18, 1,12,19,1,13,19,1,14,19, 1,15,20,1,16,20,1,17,20, 2,9,18,2,10,18,2,11,18, 2,12,19,2,13,19,2,14,19, 2,15,20,2,16,20,2,17,20, 3,9,21,3,10,21,3,11,21, 3,12,22,3,13,22,3,14,22, 3,15,23,3,16,23,3,17,23, 4,9,21,4,10,21,4,11,21, 4,12,22,4,13,22,4,14,22, 4,15,23,4,16,23,4,17,23, 5,9,21,5,10,21,5,11,21, 5,12,22,5,13,22,5,14,22, 5,15,23,5,16,23,5,17,23, 6,9,24,6,10,24,6,11,24, 6,12,25,6,13,25,6,14,25, 6,15,26,6,16,26,6,17,26, 7,9,24,7,10,24,7,11,24, 7,12,25,7,13,25,7,14,25, 7,15,26,7,16,26,7,17,26, 8,9,24,8,10,24,8,11,24, 8,12,25,8,13,25,8,14,25, 8,15,26,8,16,26,8,17,26 ] Global Number_of_bits:Int[]=[ 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8, 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8, 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8, 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8, 4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8,5,6,6,7,6,7,7,8,6,7,7,8,7,8,8,9] Global Highest_bitnumber:Int[]=[ ' Return highest bitnumber + 1 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9] Class Myerr Extends Throwable Field msg:string Method New(s:String) msg=s End method End class Class sudoku Const RASTERSIZE:=81 Const FREESIZE:=27 Field raster:Int[RASTERSIZE] Field free:Int[FREESIZE] Field stack:Int[RASTERSIZE] Field sp:int Field i0:Int,i1:Int,i2:Int Field freebits:Int Field solutioncnt:int Method reset_all_free:Void() For Local i:Int=0 Until FREESIZE free[i]=$1ff Next End Method init_stack:Void() sp=0 For Local i:Int=0 Until RASTERSIZE If raster[i]=0 stack[sp]=i sp+=1 end end End Method init:Void(startraster:Int[]) If startraster.Length<>FREESIZE Throw New Myerr("Startraster length not 27 !!") Local t:Int,z:Int,i:Int,x:Int solutioncnt=0 sp=0 reset_all_free For i=0 Until RASTERSIZE raster[i]=0 next x=RASTERSIZE-1 For i=FREESIZE-1 To 0 Step -1 z=startraster[i] For Local j:Int=1 To 3 t=z Mod 10 If t<>0 set_occupied x,(1 Shl (t-1)) z/=10 x-=1 next Next init_stack end Method New(is:Int[]) init is End Method Method showraster:Void() Local n:Int=0,v:Int=0,n2:Int=0,n3:Int=0 Local s:String="" For Local i:Int=0 Until RASTERSIZE v=v*10+Highest_bitnumber[raster[i]] n+=1 If n=3 If s="" s+=v Else s+=("|"+v) n=0 v=0 n2+=1 Endif If n2=3 Print(s) s="" n2=0 n3+=1 If n3=3 And i<>(RASTERSIZE-1) n3=0 Print("---+---+---") end next End Method Method set_indexes:Void(pos:Int) pos=(pos Shl 1) + pos 'pos*=3 i0=indexes[pos+0] i1=indexes[pos+1] i2=indexes[pos+2] End Method get_free:void(pos:Int) set_indexes pos freebits=free[i0] & free[i1] & free[i2] End Method set_free:Void(pos:Int) ' n goes from 1 to 9 Local n:Int=raster[pos] If n=0 return raster[pos]=0 set_indexes pos free[i0]|=n free[i1]|=n free[i2]|=n End Method set_occupied:Void(pos:Int,n:Int) set_indexes pos raster[pos]=n free[i0]~=n free[i1]~=n free[i2]~=n End Method find_best_pos:Int() Local n:Int,oldn:Int=9,newpos:Int=RASTERSIZE,pos:Int,i:Int,x:Int=-1 Local fb:Int=0 i=sp-1 While i>=0 pos=stack[i] get_free(pos) n=Number_of_bits[freebits] If n=0 Return -1 If n=1 newpos=pos x=i Exit end If n<oldn oldn=n newpos=pos fb=freebits x=i End i-=1 End sp-=1 stack[x]=stack[sp] If n>1 freebits=fb Return newpos End Method solveloop:Void() If sp=0 If solutioncnt=0 showraster solutioncnt+=1 Else Throw New Myerr("Aborted. More then 1 solution !!") end Return end Local pos:Int,bm:Int,t:Int pos=find_best_pos() If pos<0 Return bm=freebits While bm t=1 Shl (Highest_bitnumber[bm]-1) set_occupied pos,t solveloop set_free pos bm~=t Wend stack[sp]=pos sp+=1 end Method solve:Void() init start Print "" solveloop If solutioncnt=0 Throw New Myerr("No solution found !!") End End Class Function Main:Int() Try Local s:sudoku= New sudoku(start) s.solve Catch ex:Myerr Print ex.msg End Return 0 End function |
| ||
| well done ! |
| ||
Here an indented version (just cut & pasted into Jungle Ide) and added a couple of missing ;
Strict
Global start:Int[] =
[0, 308, 0,
75, 0, 180,
2, 10, 400,
510, 30, 96,
0, 0, 0,
640, 90, 18,
8,60,900 ,
91, 0, 670,
0, 905, 0]
Global indexes:Int[] =
[0, 9, 18, 0, 10, 18, 0, 11, 18,
0, 12, 19, 0, 13, 19, 0, 14, 19,
0, 15, 20, 0, 16, 20, 0, 17, 20,
1, 9, 18, 1, 10, 18, 1, 11, 18,
1, 12, 19, 1, 13, 19, 1, 14, 19,
1, 15, 20, 1, 16, 20, 1, 17, 20,
2, 9, 18, 2, 10, 18, 2, 11, 18,
2, 12, 19, 2, 13, 19, 2, 14, 19,
2, 15, 20, 2, 16, 20, 2, 17, 20,
3, 9, 21, 3, 10, 21, 3, 11, 21,
3, 12, 22, 3, 13, 22, 3, 14, 22,
3, 15, 23, 3, 16, 23, 3, 17, 23,
4, 9, 21, 4, 10, 21, 4, 11, 21,
4, 12, 22, 4, 13, 22, 4, 14, 22,
4, 15, 23, 4, 16, 23, 4, 17, 23,
5, 9, 21, 5, 10, 21, 5, 11, 21,
5, 12, 22, 5, 13, 22, 5, 14, 22,
5, 15, 23, 5, 16, 23, 5, 17, 23,
6, 9, 24, 6, 10, 24, 6, 11, 24,
6, 12, 25, 6, 13, 25, 6, 14, 25,
6, 15, 26, 6, 16, 26, 6, 17, 26,
7, 9, 24, 7, 10, 24, 7, 11, 24,
7, 12, 25, 7, 13, 25, 7, 14, 25,
7, 15, 26, 7, 16, 26, 7, 17, 26,
8, 9, 24, 8, 10, 24, 8, 11, 24,
8, 12, 25, 8, 13, 25, 8, 14, 25,
8, 15, 26, 8, 16, 26, 8, 17, 26]
Global Number_of_bits:Int[]=[
0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4, 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5, 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6, 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7, 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8,
4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8, 5, 6, 6, 7, 6, 7, 7, 8, 6, 7, 7, 8, 7, 8, 8, 9]
Global Highest_bitnumber:Int[]=[ ' Return highest bitnumber + 1
0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9]
Class Myerr Extends Throwable
Field msg:string
Method New(s:String)
msg = s
End Method
End Class
Class sudoku
Const RASTERSIZE:= 81
Const FREESIZE:= 27
Field raster:Int[RASTERSIZE]
Field free:Int[FREESIZE]
Field stack:Int[RASTERSIZE]
Field sp:int
Field i0:Int, i1:Int, i2:Int
Field freebits:Int
Field solutioncnt:int
Method reset_all_free:Void()
For Local i:Int = 0 Until FREESIZE; free[i] = $1ff; Next
End
Method init_stack:Void()
sp = 0
For Local i:Int = 0 Until RASTERSIZE
If raster[i] = 0
stack[sp] = i
sp += 1
end
end
End
Method init:Void(startraster:Int[])
If startraster.Length <> FREESIZE Throw New Myerr("Startraster length not 27 !!")
Local t:Int, z:Int, i:Int, x:Int
solutioncnt = 0
sp = 0
reset_all_free
For i = 0 Until RASTERSIZE raster[i] = 0; Next
x = RASTERSIZE - 1
For i = FREESIZE - 1 To 0 Step - 1
z = startraster[i]
For Local j:Int=1 To 3
t = z Mod 10
If t <> 0 set_occupied x, (1 Shl (t - 1))
z /= 10
x -= 1
next
Next
init_stack
End
Method New(is:Int[])
init is
End Method
Method showraster:Void()
Local n:Int = 0, v:Int = 0, n2:Int = 0, n3:Int = 0
Local s:String = ""
For Local i:Int = 0 Until RASTERSIZE
v = v * 10 + Highest_bitnumber[raster[i]]
n += 1
If n = 3
If s = "" s += v Else s += ("|" + v)
n = 0
v = 0
n2 += 1
EndIf
If n2 = 3 Print(s) s = "" n2 = 0 n3 += 1
If n3 = 3 And i <> (RASTERSIZE - 1)
n3 = 0
Print("---+---+---")
End
Next
End Method
Method set_indexes:Void(pos:Int)
pos = (pos Shl 1) + pos 'pos*=3
i0 = indexes[pos + 0]
i1 = indexes[pos + 1]
i2 = indexes[pos + 2]
End
Method get_free:Void(pos:Int)
set_indexes pos
freebits = free[i0] & free[i1] & free[i2]
End
Method set_free:Void(pos:Int) ' n goes from 1 to 9
Local n:Int = raster[pos]
If n = 0 Return
raster[pos] = 0
set_indexes pos
free[i0] |= n free[i1] |= n free[i2] |= n
End
Method set_occupied:Void(pos:Int, n:Int)
set_indexes pos
raster[pos]=n
free[i0] ~= n free[i1] ~= n free[i2] ~= n
End
Method find_best_pos:Int()
Local n:Int, oldn:Int = 9, newpos:Int = RASTERSIZE, pos:Int, i:Int, x:Int = -1
Local fb:Int = 0
i = sp - 1
While i >= 0
pos = stack[i]
get_free(pos)
n = Number_of_bits[freebits]
If n = 0 Return - 1
If n = 1
newpos = pos
x = i
Exit
End
If n < oldn
oldn = n
newpos = pos
fb = freebits
x = i
End
i -= 1
End
sp -= 1
stack[x] = stack[sp]
If n > 1 freebits = fb
Return newpos
End
Method solveloop:Void()
If sp = 0
If solutioncnt = 0
showraster
solutioncnt += 1
Else
Throw New Myerr("Aborted. More then 1 solution !!")
end
Return
end
Local pos:Int, bm:Int, t:Int
pos = find_best_pos()
If pos < 0 Return
bm = freebits
While bm
t = 1 Shl (Highest_bitnumber[bm] - 1)
set_occupied pos, t
solveloop
set_free pos
bm ~= t
Wend
stack[sp] = pos
sp += 1
end
Method solve:Void()
init start
Print ""
solveloop
If solutioncnt = 0 Throw New Myerr("No solution found !!")
End
End Class
Function Main:Int()
Try
Local s:sudoku = New sudoku(start)
s.solve
Catch ex:Myerr
Print ex.msg
End
Return 0
End Function
|