XQuery/Sudoku
Sudoku solver in XQuery
A Puzzle edit
A sudoku puzzle can be expressed in matrix form. Here is part of one from a Times book of sudokus.
<?xml version="1.0" encoding="UTF-8"?>
<sudoku name="Times 1 p1">
<matrix>
<row>
<col/>
<col>6</col>
<col>1</col>
<col/>
<col>3</col>
<col/>
<col/>
<col>2</col>
<col/>
</row>
<row>
<col/>
<col>5</col>
<col/>
<col/>
<col/>
<col>8</col>
<col>1</col>
<col/>
<col>7</col>
</row>
<row>
<col/>
The Main script edit
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.
import module namespace su = 'http://www.cems.uwe.ac.uk/wiki/sudoku' at 'sudoku4.xqm';
declare option exist:serialize 'method=xhtml media-type=text/html';
declare function local:duration-as-ms($t) {
round((minutes-from-duration($t) * 60 + seconds-from-duration($t)) * 1000 )
};
let $url := request:get-parameter('url',())
let $sudoku :=doc($url)/sudoku
let $p := $sudoku/matrix
let $pc := su:matrix-to-cells($p)
let $start := util:system-time()
let $ps := su:solve($pc)
let $finish := util:system-time()
let $elapsedms := local:duration-as-ms($finish - $start)
let $s := su:cells-to-matrix($ps)
return
<div>
<h1>Solving Sudoku problem {string($sudoku/@name)}</h1>
<table border = '1'>
<tr>
<td>{su:matrix-to-table($p)}</td>
<td>{su:matrix-to-table($s)}</td>
</tr>
</table>
<p>Elapsed time in milliseconds : {$elapsedms}</p>
</div>
Functions edit
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-table($s as element(matrix)) as element(table) {
<table class="sudoku">
{ for $r in $s/row
return
<tr>
{ for $c in $r/col
return <td>{string($c)}</td>
}
</tr>
}
</table>
};
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 <cell row='{$i}' col='{$j}'>{string($c)}</cell>
else ()
};
declare function su:cells-to-matrix($s as element(cell)*) as element(matrix) {
<matrix>
{ for $i in (1 to 9)
return
<row>
{ for $j in (1 to 9)
let $c := $s[@row = $i][@col = $j]
return
<col>{string($c)}</col>
}
</row>
}
</matrix>
};
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 <cell row='{$i}' col='{$j}' n='{count($m)}'>{$m}</cell>
};
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 := <cell row='{$cell/@row}' col='{$cell/@col}'>{$pos}</cell>
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 edit
With a few problems from the Times book of Sudoku problems:
- solve Puzzle 1
- solve Puzzle 2
- solve Puzzle 100 - the last
Discussion edit
This code requires eXist 1.3 or above to run.