newLISP で数独を解いてみる。

　超難解な数独があります。

解けたら天才！ フィンランドの数学者が作った「世界一難しい数独」

　フィンランドの数学者Arto Inkala氏が作成に3ヶ月を要したというもの。
　タイトル通り、全然歯が立ちませんでした（汗）。
　ということで、newLISP で解くことに（笑）。
　手始めに、空いているマスの数字の候補を調べるスクリプト。

(define (sudoku1pass nums)
  (let (res)
  (for (i 0 8)
    (let (row)
    (for (j 0 8)
      (let (n (nums i j))
       (if (> n 0) (push (list n) row -1)
         (letn (can (difference '(1 2 3 4 5 6 7 8 9) (nums i))
                can (difference can (map (curry nth j) nums))
                can (difference can (flat (map (curry (* (/ j 3) 3) 3) ((* (/ i 3) 3) 3 nums)))))
           (if (= (length can) 1) (setf (nums i j) (can 0)))
           (push can row -1)
         )
    )))
    (let (tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append row))))
      (if tmp (dolist (k (apply append tmp)) (setf (nums i ((ref k row) 0)) k))))
    (push row res -1)))
    (for (j 0 8)
      (letn (col (map (curry nth j) res)
             tmp (ref-all 1 (count '(0 1 2 3 4 5 6 7 8 9) (apply append col))))
      (if tmp (dolist (k (apply append tmp)) (setf (nums ((ref k col) 0) j) k)))))
  (list nums res)))

　数独自体は、空いているマスを 0 で埋めて、9 行 9 列のリスト testx にします。
　実行してみると、

> (sudoku1pass testz)
(((0 0 5 3 0 0 0 0 0) 
  (8 0 0 0 5 0 0 2 0) 
  (0 7 0 0 1 0 5 0 0) 
  (4 0 0 0 0 5 3 0 0) 
  (0 1 0 0 7 3 0 0 6) 
  (0 0 3 2 0 0 0 8 0) 
  (0 6 0 5 0 0 0 0 9) 
  (0 0 4 0 0 0 0 3 0) 
  (0 0 0 0 0 9 7 0 0)) 
 (((1 2 6 9) (2 4 9) (5) (3) (2 4 6 8 9) (2 4 6 7 8) (1 4 6 8 9) (1 4 6 7 9) (1 4 7 8)) 
  ((8) (3 4 9) (1 6 9) (4 6 7 9) (4 5 6 9) (4 6 7) (1 4 6 9) (2) (1 3 4 7)) 
  ((2 3 6 9) (7) (2 6 9) (4 6 8 9) (1) (2 4 6 8) (5) (4 6 9) (3 4 8)) 
  ((4) (2 8 9) (2 6 7 8 9) (1 6 8 9) (6 8 9) (5) (3) (1 7 9) (1 2 7)) 
  ((2 5 9) (1) (2 8 9) (4 8 9) (7) (3 4 8) (2 4 9) (4 5 9) (6)) 
  ((5 6 7 9) (5 9) (3) (2) (4 6 9) (1 4 6) (1 4 9) (8) (1 4 5 7)) 
  ((1 2 3 7) (6) (1 2 7 8) (5) (2 3 4 8) (1 2 4 7 8) (1 2 4 8) (1 4) (9)) 
  ((1 2 5 7 9) (2 5 8 9) (4) (1 6 7 8) (2 6 8) (1 2 6 7 8) (1 2 6 8) (3) (1 2 5 8)) 
  ((1 2 3 5) (2 3 5 8) (1 2 8) (1 4 6 8) (2 3 4 6 8) (9) (7) (1 4 5 6) (1 2 4 5 8))))
> 

　こんな感じ。返り値リストの第一項が数独リスト、二項目が数字の候補リストです。
（戻り値は、見やすいように改行を入れてあります。）
　これだけでは、簡単見つかる 3 と 5 しか埋まりません（汗）。
　簡単な数独であれば、何回か繰り返すと解答が出るはずですが、

(define (sudoku-loop lst (cnt 0))
  (let (old lst)
    (setq lst (sudoku1pass lst))
    (if (= (lst 0) old) 
        (begin (println cnt) (if (ref 0 (lst 0)) lst (list (lst 0)) ))
      (sudoku-loop (lst 0) (++ cnt)))))

　試してみると、

> (sudoku-loop testz)
1
(((0 0 5 3 0 0 0 0 0) 
  (8 0 0 0 5 0 0 2 0) 
  (0 7 0 0 1 0 5 0 0) 
  (4 0 0 0 0 5 3 0 0) 
  (0 1 0 0 7 3 0 0 6) 
  (0 0 3 2 0 0 0 8 0) 
  (0 6 0 5 0 0 0 0 9) 
  (0 0 4 0 0 0 0 3 0) 
  (0 0 0 0 0 9 7 0 0)) 
 (((1 2 6 9) (2 4 9) (5) (3) (2 4 6 8 9) (2 4 6 7 8) (1 4 6 8 9) (1 4 6 7 9) (1 4 7 8)) 
  ((8) (3 4 9) (1 6 9) (4 6 7 9) (5) (4 6 7) (1 4 6 9) (2) (1 3 4 7)) 
  ((2 3 6 9) (7) (2 6 9) (4 6 8 9) (1) (2 4 6 8) (5) (4 6 9) (3 4 8)) 
  ((4) (2 8 9) (2 6 7 8 9) (1 6 8 9) (6 8 9) (5) (3) (1 7 9) (1 2 7)) 
  ((2 5 9) (1) (2 8 9) (4 8 9) (7) (3) (2 4 9) (4 5 9) (6)) 
  ((5 6 7 9) (5 9) (3) (2) (4 6 9) (1 4 6) (1 4 9) (8) (1 4 5 7)) 
  ((1 2 3 7) (6) (1 2 7 8) (5) (2 3 4 8) (1 2 4 7 8) (1 2 4 8) (1 4) (9)) 
  ((1 2 5 7 9) (2 5 8 9) (4) (1 6 7 8) (2 6 8) (1 2 6 7 8) (1 2 6 8) (3) (1 2 5 8)) 
  ((1 2 3 5) (2 3 5 8) (1 2 8) (1 4 6 8) (2 3 4 6 8) (9) (7) (1 4 5 6) (1 2 4 5 8))))
> 

　最初に出力されている 1 は、sudoku1pass を実行した回数 – 1 です。
　見ての通り、この超難解問題には、まったく歯が立ちません。
　そこで（？）、力技で解きます（笑）。

(define (sudoku-solve lst)
  (let (org lst
        ans (sudoku-loop lst 0))
    (if (= 2 (length ans))
      (letn (options (ans 1)
             tmp (ans 0)
             pos (ref nil options (fn (x y) (and (list? y) (> 9 (length y)) (> (length y) 1)))))
        (if pos
            (do-until (or (= 1 (length ans)) (not (options pos)))
              (setf (tmp pos) ((options pos) 0))
              (setf (options pos) (rest (options pos)))
              (setq ans (sudoku-solve tmp 0))))))
    ans))

　要するに、候補の数字を片っ端から入れて試すというスクリプト（汗）。
　試してみると、

> (sudoku-solve testz)
1
0
11
0
0
0
4
1
1
5
4
4
5
（ここから解答が出力されますが、削除してあります）
　：
> 

　解けました、、、当たり前か（笑）。
　数独の中には、解答が一つ以上のものがあります。この sudoku-solve は解けたところで終わりますが、ちょっとした変更で、全ての候補を試して、全ての解答を出すことができます。はたして、この超難解問題の解答は、1 つでした。つまり、解法が必ずあるということ、、、その内、sudoku1pass を改良しよっと（汗）。
　入力のチェックを入れれば、

(define (sudoku lst)
  (let (res (and (list? lst)
                 (let (len (length lst))
                   (cond ((and (= len 9) (for-all (fn (x) (= x 9)) (map length lst)))
                          (sudoku-solve lst))
                         ((= len 81)(sudoku-solve (explode lst 9)))
                         (true (println lst " is wrong list. Please 9 x 9 matrix.") nil)))))
    (if (= (length res) 1) 
        (res 0)
      (println "Soory, I can't solve. Please check input list:\n" lst nil))))

　数独解法スクリプト sudoku の完成です（笑）。
　その内、GUI の入力スクリプトでも書くことにしましょう。

　以上、如何でしょうか？

newLISP マニュアル v.10.3.0 日本語訳公開

　newLISP ｖ10.3 がリリースされました。
　v.10.2.14 から開発版を使っていた私には、待ちに待ったバージョンアップ。
　ためらう必要はありません。さっさとバージョンアップしましょう！（笑）
　ということで、newLISP マニュアル ＆ リファレンス v.10.3 の全訳リリースです。

日本語併記 newLISP ユーザー マニュアル

　目次も含め日本語併記にしてあります。

　いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報下さい。

　以上、如何でしょうか？