XQuery/Sudoku

Sudoku solver in XQuery

A Puzzle
A sudoku puzzle can be expressed in matrix form. Here is part of one from a Times book of sudokus.

The Main script
The main script is passed a URL referencing the problem XML file. The matrix format is converted to a sequence of cells, the puzzle solved, the resultant cell list converted back to a matrix and the matrix printed. The elapsed time of the solution search is computed and displayed after the initial problem and the solution.

Elapsed time in milliseconds : {$elapsedms}

Functions
This module defines the necessary functions to support a brute force, depth-first search of the solution tree. Two representations of a sudoku puzzle are used here: nested columns within rows -  element(matrix) - the input format list of cells with explicit row and column numbers - element(cells)

The algorithm starts with the cell list representation. The number of possible solutions to every empty square is calculated. If there there is a cell with only one value, that cell is added to the list of cells and the algorithm continues. If there is more than one possible value for a cell, the algorithm iterates over the possible values, positing that each in turn is the correct value. If there is no possible value, that partial solution is infeasible and that solution path is abandoned, returning null and the next possible cell value will be tried.

};

declare function su:matrix-to-cells($s as element(matrix)) as element(cell)* { for $i in (1 to 9) for $j in (1 to 9) let $c := $s/row[$i]/col[$j] return if ($c/text) then {string($c)} else };

declare function su:cells-to-matrix($s as element(cell)*) as element(matrix) { { for $i in (1 to 9) return { for $j in (1 to 9) let $c := $s[@row = $i][@col = $j] return {string($c)} } } };

declare function su:block($s as element(cell)*, $i as xs:integer, $j as xs:integer ) as element(cell)+ { (: return the block of 9 cells containing $i, $j :) let $tci := (($i - 1) idiv 3 * 3 ) + 1 let $tcj := (($j - 1) idiv 3 * 3 ) + 1 return $s[@row = ($tci to $tci + 2)][@col = ($tcj to $tcj + 2)] };

declare function su:row($s as element(cell)*,$i as xs:integer) as element(cell)+ { (: return the cells in row $i :) $s[@row = $i] };

declare function su:col($s as element(cell)* ,$j as xs:integer) as element(cell)+{ (: return the cells in column $j :) $s[@col = $j] };

declare function su:values($s as element(cell)*, $i as xs:integer, $j as xs:integer) as xs:integer* { (: return the set (sequence) of values in a cell's row, column and block :) distinct-values( (su:row($s,$i) ,su:col($s,$j), su:block($s,$i,$j) )) };

declare function su:missing-values($s as element(cell)*,$i as xs:integer,$j as xs:integer) as xs:integer* { (: return the numbers missing from 1 to 9 i.e. the possible values for cell $i, $j :) let $vals := su:values($s,$i,$j) return (1 to 9) [not(. = $vals)] };

declare function su:missing-cells($s as element(cell)*) as element(cells)* { for $i in (1 to 9) for $j in (1 to 9) where empty($s[@row = $i][@col = $j]) return let $m := su:missing-values($s,$i,$j) return {$m} };

declare function su:best-cell($s as element(cell)*) as element(cell)* { (: return (one of ) the cells with the minimum number of possible values :) let $empty := su:missing-cells($s) let $min := min( $empty/@n) return ($empty[@n = $min])[1] };

declare function su:search-for-solution($s as element(cell)*, $cell as element(cell), $posvalues as xs:string*) { (: recursive search of a set of possible values for a cell :) if (empty($posvalues)) then else let $pos:= $posvalues[1]  (: choose the first :) let $posit := {$pos} let $sol := su:solve(($s,$posit)) (: try with this posited value for the cell :) return if ($sol ) (: a solution :) then $sol else  (: continue with the rest of the possible values :) su:search-for-solution($s, $cell, subsequence($posvalues,2)) };

declare function su:solve($s as element(cell)*) as element(cell)* { (: solve a sudoku problem  - $s is  a sequence of cells with values :) let $cell:= su:best-cell($s) return if (empty($cell) ) then $s (: solved :) else if ( $cell/@n=0) (: infeasible :) then else if ($cell/@n = 1) (: forced move :) then su:solve(($s,$cell)) else  (: multiple possible, so do depth-first search  :) su:search-for-solution($s, $cell, tokenize($cell, ' ' )) };

Execution
With a few problems from the Times book of Sudoku problems:


 * solve Puzzle 1
 * solve Puzzle 2
 * solve Puzzle 100 - the last

Discussion
This code requires eXist 1.3 or above to run.