参考：数独の平凡な解法（C言語・Mathematica）

Rubyのバイブル『プログラミング言語 Ruby』の第1.4節では、「Rubyプログラムが実際にはどのようなものかというイメージをもっとよくつかめるように(p.18)」数独を解くRubyプログラムが紹介されています（ソースコードは原著のサポートサイトにあります）。曰く、

コメントと空行を取り除くと、ちょうど129行のコードが残る。これは、単純な力任せのアルゴリズムに頼るわけではないオブジェクト指向の数独ソルバとしてはまずまずの長さだ。このサンプルは、Rubyのパワーと表現力をよく示していると思うがどうだろうか。(p.25)

どうだろうかって、このサンプルは、Rubyのパワーと表現力を示すものとしてはふさわしくないんじゃないでしょうか。100行以上書かないと数独が解けないなんて、Rubyのイメージダウンにならなければいいのですが。

Rubyが手続き型プログラミングのためのすばらしい言語であることは否定しませんが、所詮は手続き型なので、「欲しい結果を得るための処理」を書かなければならない場合には便利でも、「欲しい結果の性質」を書けばよい言語に比べれば、プログラマの負担は大きいはずです。

Ruby本のコードには入力からゴミを取り除くような本質的ではない処理も含まれているので、行数で比較することが最善の評価法というわけではありませんが、数独はSQLなら1行ですし、その1行を生成させるJavaのコードでも70行程度です。行数というのはそんなにいい指標ではないわけですが（Pythonでは1行という話もありますし）、一つの目安ということで。

適材適所という観点から言って、数独はProlog（やSQL）のような言語で解くのがいいと思うのですが、どうしても手続き型の言語を使いたいという向きのために、Ruby本よりはシンプルな方法（10行）を紹介しましょう。実装にはMathematicaを使いますが、関数型の記述ができる言語になら簡単に翻訳できるでしょう。引用箇所の「オブジェクト指向の」は無視します。

単純探索のテンプレートを使います。まず、数独に限らず、一般的な探索に使える述語を定義します。

search[x_] := Or[goal@x, deepen@x]
scanOr[f_, x_] := Catch[Scan[If[f@#, Throw@True] &, x]; False] (* 深さ優先探索 *)

数独の解を定義します。空白(0)の部分が無い(Not@MemberQ)ものが解です。

goal[x_] := And[Not@MemberQ[x, 0, 2], report@x]
report[x_] := (Sow@TableForm@x; True) (* 解の表示 *)

力任せの方法

引用箇所には「単純な力任せのアルゴリズムに頼るわけではない」とあります。Ruby本のコードは、未定のマス目に入りうる数字を数独のルール通りに決めているだけなので、「力任せ」だと言っていいと思うのですが、ここで言う「力任せ」の方法とは次のようなものでしょう。

力任せの方法：「空白部分に1から9までの数字を入れてルールをチェック」の繰り返し

述語deepenは、空白部分を調べ(Position)、1から9までの数字(Range[1,9])を入れてみて、ルール(test)に違反していなければ(Select)探索(search)を進めます。

deepen[x_] := scanOr[search, Select[ReplacePart[x, First@Position[x, 0] -> #] & /@ Range[1, 9], test]]

ルール(test)は、各行(x)と各列(Transpose@x)、各ブロック(Flatten…)を集計(Tally)し、1以上の部分({_, a_ /; a > 1})がないことを確認します。

test[x_] :=
 And @@ Map[Not[MemberQ[Tally[Select[#, (# != 0) &]], {_, a_ /; a > 1}]] &,
   Flatten[{
     x,
     Transpose@x,
     Flatten[Table[Flatten[Take[x, 3 i - {2, 0}, 3 j - {2, 0}]], {i, 1, 2}, {j, 1, 2}], 1]
     }, 1]]

再帰の深さ制限をなくしてから探索すれば、どんな問題でも解けますが、さすがに時間がかかりすぎます（「scanOr」を「Or @@ Map」に置き換えればすべての解を見つけますが、やめたほうがいいでしょう）。

$RecursionLimit = Infinity;

Reap@search@{
  {1,0,0,0,0,7,0,9,0},
  {0,3,0,0,2,0,0,0,8},
  {0,0,9,6,0,0,5,0,0},
  {0,0,5,3,0,0,9,0,0},
  {0,1,0,0,8,0,0,0,2},
  {6,0,0,0,0,4,0,0,0},
  {3,0,0,0,0,0,0,1,0},
  {0,4,0,0,0,0,0,0,7},
  {0,0,7,0,0,0,3,0,0}}

方法2（これも力任せ）

Ruby本のように、入りうる数字(candidates)をルール通りに決めて、それだけを調べるようにしてみましょう。

述語deepenは、空白の場所(pos)を、そこに入りうる数字(candidates)で置き換え(ReplacePart)、探索を進めます（入りうる数字が無いと、Or @@ Mapの結果はFalseになります）。入りうる数字だけを使うので、ルールのチェック(test)は不要です。

deepen[x_] := With[{pos = First@Position[x, 0]}, 
  Or @@ Map[search, (ReplacePart[x, pos -> #] & /@ candidates[x, pos])]]

i行j列に入りうる数字(candidates)は、1から9の数字(Range[1,9])から、i行目(board[[i]])とj列目(board[[Range[1, 9], j]])、そのマス目が属するブロック(Flatten…)に属する数字を除いたもの(Complement)です。

candidates[board_, {i_, j_}] := Complement[Range[1, 9],
  board[[i]],
  board[[Range[1, 9], j]],
  Flatten[Take[board, 3 Ceiling[i/3] - {2, 0}, 3 Ceiling[j/3] - {2, 0}]]]

今度はすぐに解が求まります（「Or @@ Map」なので、すべての解を求めます）。

Reap@search@{
  {1,0,0,0,0,7,0,9,0},
  {0,3,0,0,2,0,0,0,8},
  {0,0,9,6,0,0,5,0,0},
  {0,0,5,3,0,0,9,0,0},
  {0,1,0,0,8,0,0,0,2},
  {6,0,0,0,0,4,0,0,0},
  {3,0,0,0,0,0,0,1,0},
  {0,4,0,0,0,0,0,0,7},
  {0,0,7,0,0,0,3,0,0}}

{True, {{1 6 2 8 5 7 4 9 3}}}
         5 3 4 1 2 9 6 7 8
         7 8 9 6 4 3 5 2 1
         4 7 5 3 1 2 9 8 6
         9 1 3 5 8 6 7 4 2
         6 2 8 7 9 4 1 3 5
         3 5 6 4 7 8 2 1 9
         2 4 1 9 3 5 8 6 7
         8 9 7 2 6 1 3 5 4

結論

空行を取り除くと、ちょうど10行のコードが残ります。これは、単純な力任せのアルゴリズムに頼る関数型言語の数独ソルバとしてはまずまずの長さです。このサンプルは、Mathematicaのパワーと表現力をよく示していると思いますがどうでしょう。

search[x_] := Or[goal@x, deepen@x]
goal[x_] := And[Not@MemberQ[x, 0, 2], report@x]
report[x_] := (Sow@TableForm@x; True)
deepen[x_] := With[{pos = First@Position[x, 0]}, 
  Or @@ Map[search, (ReplacePart[x, pos -> #] & /@ candidates[x, pos])]]
candidates[board_, {i_, j_}] := Complement[Range[1, 9],
  board[[i]],
  board[[Range[1, 9], j]],
  Flatten[Take[board, 3 Ceiling[i/3] - {2, 0}, 3 Ceiling[j/3] - {2, 0}]]]
$RecursionLimit = Infinity;

補足：Mathematica 5で試す場合には、述語deepenの中のReplacePart[x, pos -> #]をReplacePart[x, #, pos]に置き換えてください。