Skip to content

Instantly share code, notes, and snippets.

@naohaq naohaq/sudoku.ps
Created Mar 14, 2013

Embed
What would you like to do?
Learn more about clone URLs
Download ZIP
Solving sudoku by postscript.
Raw
sudoku.ps
/# {load def} bind def
/! {exch def} bind def
/M/moveto #/L/lineto #/RM/rmoveto #/RL/rlineto #
/s/stroke #/f/fill #/S/show #/CP/closepath #
/sudokuDict 256 dict def
sudokuDict begin
[
%------------ Write the problem here ---------------
[[ ] [6] [1] [ ] [ ] [7] [ ] [ ] [3]]
[[ ] [9] [2] [ ] [ ] [3] [ ] [ ] [ ]]
[[ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]]
[[ ] [ ] [8] [5] [3] [ ] [ ] [ ] [ ]]
[[ ] [ ] [ ] [ ] [ ] [ ] [5] [ ] [4]]
[[5] [ ] [ ] [ ] [ ] [8] [ ] [ ] [ ]]
[[ ] [4] [ ] [ ] [ ] [ ] [ ] [ ] [1]]
[[ ] [ ] [ ] [1] [6] [ ] [8] [ ] [ ]]
[[6] [ ] [ ] [ ] [ ] [ ] [ ] [ ] [ ]]
%---------------------------------------------------
]
/board !
/len/length #/g/get #/x/exch #/clr/cleartomark #
/id { } bind def
/head { 0 get } bind def
/map { [ 3 1 roll forall ] } def
/adup { { id } map } bind def
/filter {
[ 3 1 roll x { 2 copy x mark 3 1 roll exec { clr x } { clr pop } ifelse } forall pop ]
} def
/seq { [ 3 1 roll 1 x { } for ] } def
/arg {
dup len
mark
1 index 3 add 1 roll
1 sub dup 0 x seq
{
dup 3 index x
get x
2 index x sub
3 add index
def
} forall
clr
} def
/applyAtDict 3 dict def
/applyAt
{
applyAtDict begin
[/ary /i /proc] arg
ary i get proc
end
% separating namespace
exec
applyAtDict begin
ary x i x put
end
} def
/includes?
{
2 dict begin
[/ary /val] arg
ary { val eq } map false x { or } forall
end
} def
/isValid
{
1 x { len mul } forall 0 gt
} def
/isComplete
{
dup
1 x { len mul } forall 1 eq
{
dup
0 x { head add } forall 45 eq x
1 x { head mul } forall 362880 eq
and
} { pop false } ifelse
} def
/checkValid {
true x
{ isValid and } forall
} def
/perm_delete_elem_dict 3 dict def
/perm_delete_elems
{
perm_delete_elem_dict begin
/i !
/bs !
bs i get 0 get
/v !
0 bs len 1 sub seq {
dup bs x get
x i gt
{ { v ne } filter }
{ adup }
ifelse
} map
end
} def
/perm_main_dict 2 dict def
/perm_main
{
perm_main_dict begin
[/lst /pos] arg
[
lst pos get
{
lst adup dup
3 -1 roll
[ x ] pos x
put
} forall
]
{ pos perm_delete_elems } map
{ isValid } filter
end
} def
/permutationDict 5 dict def
/permutation
{
permutationDict begin
[/base_lst] arg
mark
base_lst len 1 sub /n !
base_lst 0
perm_main
0 0
{
[/lst /i /j] arg
j lst len lt
{
% save context
lst i j 1 add
lst j get
i n lt
{ i 1 add perm_main i 1 add 0 }
{
counttomark 1 add 1 roll
}
ifelse
}
{
i 0 eq { exit } if
}
ifelse
} loop
clr
end
} def
/deepcopy {
{ { adup } map } map
} def
/arrayEq
{
2 dict begin
[/a1 /a2] arg
a1 len a2 len eq
{
true
0 a1 len 1 sub seq {
dup a1 x get x a2 x get eq
and
} forall
}
{
false
}
ifelse
end
} def
/compareStateDict 5 dict def
/compareState {
compareStateDict begin
[/s1 /s2] arg
true
0 8 seq {
/i !
s1 i get /r1 !
s2 i get /r2 !
true
0 8 seq {
dup r1 x get x r2 x get arrayEq
and
dup not { exit } if
} forall
and
dup not { exit } if
} forall
end
} def
/blk2griddict 2 dict def
/blk2grid {
blk2griddict begin
/j ! /i !
i 3 idiv 3 mul j 3 idiv add
i 3 mod 3 mul j 3 mod add
end
} def
/extractDict 4 dict def
/extractBlock {
extractDict begin
/b !
/cand !
0 8 seq { b x blk2grid cand 3 -1 roll get x get adup } map
end
} def
/extractRow {
get { adup } map
} def
/extractColumn {
extractDict begin
/c !
{ c get adup } map
end
} def
/replaceDict 6 dict def
/replaceRow {
replaceDict begin
[/brd /r /ln] arg
brd r get
0 8 seq { 2 copy 3 -1 roll ln x get put } forall
pop
end
} def
/replaceColumn {
replaceDict begin
[/brd /c /ln] arg
0 8 seq { dup brd x get x ln x get c x put } forall
end
} def
/replaceBlock {
replaceDict begin
[/brd /b /ln] arg
0 8 seq {
/j !
b j blk2grid x brd x get
x ln j get put
} forall
end
} def
/eliminateDict 8 dict def
/eliminateLine {
[/ln] arg
0 8 seq {
/i !
ln i get
dup len
1 eq
{
0 get /v !
0 8 seq {
/j !
i j ne
{
ln j get
{ v ne } filter
ln x j x
put
} if
} forall
}
{
pop
}
ifelse
} forall
} def
/eliminateRow {
eliminateDict begin
[/cands] arg
0 8 seq {
/r !
cands r extractRow dup
eliminateLine
cands x r x replaceRow
} forall
end
} def
/eliminateColumn {
eliminateDict begin
[/cands] arg
0 8 seq {
/c !
cands c extractColumn dup
eliminateLine
cands x c x replaceColumn
} forall
end
} def
/eliminateBlock {
eliminateDict begin
[/cands] arg
0 8 seq {
/b !
cands b extractBlock dup
eliminateLine
cands x b x replaceBlock
} forall
end
} def
/findConcreteDict 8 dict def
/findConcrete {
[/ln] arg
0 8 seq { pop 0 } map /cnts !
0 8 seq {
ln x get { 1 sub cnts x { 1 add } applyAt } forall
} forall
0 8 seq {
/i !
cnts i get 1 eq
{
0 8 seq {
/j !
ln j get i 1 add includes?
{
ln j [i 1 add] put
} if
} forall
} if
} forall
} def
/fixConcreteInRows {
findConcreteDict begin
[/cands] arg
0 8 seq {
/r !
cands r extractRow dup
findConcrete
cands x r x replaceRow
} forall
end
} def
/fixConcreteInColumns {
findConcreteDict begin
[/cands] arg
0 8 seq {
/c !
cands c extractColumn dup
findConcrete
cands x c x replaceColumn
} forall
end
} def
/fixConcreteInBlocks {
findConcreteDict begin
[/cands] arg
0 8 seq {
/b !
cands b extractBlock dup
findConcrete
cands x b x replaceBlock
} forall
end
} def
/applyHeuristicsDict 4 dict def
/applyHeuristics {
applyHeuristicsDict begin
[/cands] arg
/ret -1 def
1 20 seq {
/i !
cands deepcopy /new_cands !
new_cands eliminateRow
new_cands checkValid not { exit } if
new_cands eliminateColumn
new_cands checkValid not { exit } if
new_cands eliminateBlock
new_cands checkValid not { exit } if
new_cands fixConcreteInRows
new_cands fixConcreteInColumns
new_cands fixConcreteInBlocks
new_cands checkValid not { exit } if
cands new_cands compareState
{
/ret i def
exit
} if
new_cands cands copy pop
} forall
ret
end
} def
/checkComplete {
1 dict begin
[/brd] arg
true 0 8 seq { brd x extractRow isComplete and } forall
dup
{
0 8 seq { brd x extractColumn isComplete and } forall
dup
{
0 8 seq { brd x extractBlock isComplete and } forall
} if
}
if
end
} def
/genInitialCandidates {
{
{
dup len
1 ge
{ adup }
{ pop 1 9 seq }
ifelse
} map
} map
} def
/findPivot {
4 dict begin
[/cands] arg
387420489 /min !
0 /minRow !
0 8 seq {
/i !
1 cands i get { len mul } forall
dup
dup
1 gt x
min lt and
{ /min ! i /minRow ! }
{ pop }
ifelse
} forall
minRow
end
} def
/solveSudoku_main {
mark
0 /cnt !
0
cands
cands findPivot dup
cands x get
[ x permutation ] x
0
{
[/d /brd /perms /p /j] arg
j perms len lt
{
% push current context
d brd perms p j 1 add
brd deepcopy /new_brd !
new_brd p perms j get replaceRow
new_brd applyHeuristics 0 ge
{
new_brd checkComplete
{
cnt 1 add /cnt !
new_brd
counttomark 1 add 1 roll
}
{
% push new context
d 1 add
new_brd
new_brd findPivot dup
new_brd x get [ x permutation ] x
0
} ifelse
} if
}
{
d 0 gt not { exit } if
} ifelse
cnt 10 ge {
(**There are more than 10 answers of this problem!**) =
exit
} if
} loop
clr
} def
/solveSudoku {
16 dict begin
[/problem] arg
problem genInitialCandidates /cands !
cands applyHeuristics
0 ge
{
[ solveSudoku_main ]
}
{
[ ]
}
ifelse
end
} def
/drawBoardGrid {
3 setlinewidth
0 0 M 450 0 RL 0 -450 RL -450 0 RL CP s
0 -150 M 450 0 RL s
0 -300 M 450 0 RL s
150 0 M 0 -450 RL s
300 0 M 0 -450 RL s
1 setlinewidth
0 -50 M 450 0 RL s
0 -100 M 450 0 RL s
0 -200 M 450 0 RL s
0 -250 M 450 0 RL s
0 -350 M 450 0 RL s
0 -400 M 450 0 RL s
50 0 M 0 -450 RL s
100 0 M 0 -450 RL s
200 0 M 0 -450 RL s
250 0 M 0 -450 RL s
350 0 M 0 -450 RL s
400 0 M 0 -450 RL s
} def
/drawBoard {
16 dict begin
[/brd /ans] arg
gsave
25 500 translate
drawBoardGrid
/Helvetica-Bold findfont 36 scalefont setfont
0 8 seq {
/i !
brd i get /probRow !
ans i get /ansRow !
0 8 seq {
/j !
probRow j get dup
len 1 eq
{
0 get /v !
50 j mul 15 add -50 i mul -40 add M
v ( ) cvs true charpath s
}
{
pop
ansRow j get
0 get /v !
50 j mul 15 add -50 i mul -40 add M
v ( ) cvs true charpath f
}
ifelse
} forall
} forall
grestore
end
} def
/noAnswer {
gsave
/GothicBBB-Medium-H findfont 72 scalefont setfont
50 700 M
<3272244a2437212a> show
grestore
} def
board solveSudoku /answers !
answers len 1 ge
{
answers len 2 ge
{
gsave
/GothicBBB-Medium-H findfont 28 scalefont setfont
50 770 M
<3272242c42743b332422246a245e24392123> show
50 730 M
<245f2443244424402431493d3c282437245e24392123> show
grestore
gsave
50 400 translate
0.5 0.5 scale
board answers 0 get drawBoard
grestore
gsave
305 400 translate
0.5 0.5 scale
board answers 1 get drawBoard
grestore
answers len 2 gt
{
gsave
50 50 translate
0.5 0.5 scale
board answers 2 get drawBoard
grestore
} if
}
{
gsave
25 842 50 sub 500 sub translate
board answers 0 get drawBoard
gsave
} ifelse
showpage
}
{
noAnswer
showpage
}
ifelse
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.