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 或更高版本才能執行。