XQuery/数独

XQuery 中的数独求解器

谜题

数独谜题可以用矩阵形式表示。以下是泰晤士报数独书中的一个谜题的一部分。

<?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/>

主脚本

主脚本传递一个引用问题 XML 文件的 URL。矩阵格式转换为单元格序列，解决谜题，将结果单元格列表转换回矩阵，并打印矩阵。求解搜索的经过时间在初始问题和解决方案之后计算并显示。

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>

函数

此模块定义了支持对解决方案树进行暴力深度优先搜索的必要函数。这里使用了两种数独谜题的表示方式

nested columns within rows  -  element(matrix) - the input format
list of cells with explicit row and column numbers  - element(cells)

算法从单元格列表表示开始。计算每个空方格可能的解决方案数量。如果有一个单元格只有一个值，则将该单元格添加到单元格列表中，算法继续。如果一个单元格有多个可能的值，算法将遍历这些可能的值，假设每个值依次是正确的值。如果没有可能的值，则该部分解决方案是不可行的，该解决方案路径将被放弃，返回 null，并将尝试下一个可能的单元格值。

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, ' ' ))
};

执行

使用泰晤士报数独书中的几个问题

讨论

此代码需要 eXist 1.3 或更高版本才能运行。