Common Lispで数独を解くプログラム
お絵描きロジックをボールペンで解くと失敗したときに取り返しがつかない。何問かやってみて結構な頻度で取り返しがつかなくなるのに憤慨したからお絵描きロジックを解くプログラムを書こうと思った。お絵描きロジックを解くアルゴリズムをはっきりさせるのが難しそうだったからとりあえず探索するだけで解ける数独を解くプログラムを書いたってワケ。久々にLispで遊んだ。
(defparameter *nums* '(1 2 3 4 5 6 7 8 9)) (defparameter *rules* '(;; rows ((0 . 0) (0 . 1) (0 . 2) (0 . 3) (0 . 4) (0 . 5) (0 . 6) (0 . 7) (0 . 8)) ((1 . 0) (1 . 1) (1 . 2) (1 . 3) (1 . 4) (1 . 5) (1 . 6) (1 . 7) (1 . 8)) ((2 . 0) (2 . 1) (2 . 2) (2 . 3) (2 . 4) (2 . 5) (2 . 6) (2 . 7) (2 . 8)) ((3 . 0) (3 . 1) (3 . 2) (3 . 3) (3 . 4) (3 . 5) (3 . 6) (3 . 7) (3 . 8)) ((4 . 0) (4 . 1) (4 . 2) (4 . 3) (4 . 4) (4 . 5) (4 . 6) (4 . 7) (4 . 8)) ((5 . 0) (5 . 1) (5 . 2) (5 . 3) (5 . 4) (5 . 5) (5 . 6) (5 . 7) (5 . 8)) ((6 . 0) (6 . 1) (6 . 2) (6 . 3) (6 . 4) (6 . 5) (6 . 6) (6 . 7) (6 . 8)) ((7 . 0) (7 . 1) (7 . 2) (7 . 3) (7 . 4) (7 . 5) (7 . 6) (7 . 7) (7 . 8)) ((8 . 0) (8 . 1) (8 . 2) (8 . 3) (8 . 4) (8 . 5) (8 . 6) (8 . 7) (8 . 8)) ;; columns ((0 . 0) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) (6 . 0) (7 . 0) (8 . 0)) ((0 . 1) (1 . 1) (2 . 1) (3 . 1) (4 . 1) (5 . 1) (6 . 1) (7 . 1) (8 . 1)) ((0 . 2) (1 . 2) (2 . 2) (3 . 2) (4 . 2) (5 . 2) (6 . 2) (7 . 2) (8 . 2)) ((0 . 3) (1 . 3) (2 . 3) (3 . 3) (4 . 3) (5 . 3) (6 . 3) (7 . 3) (8 . 3)) ((0 . 4) (1 . 4) (2 . 4) (3 . 4) (4 . 4) (5 . 4) (6 . 4) (7 . 4) (8 . 4)) ((0 . 5) (1 . 5) (2 . 5) (3 . 5) (4 . 5) (5 . 5) (6 . 5) (7 . 5) (8 . 5)) ((0 . 6) (1 . 6) (2 . 6) (3 . 6) (4 . 6) (5 . 6) (6 . 6) (7 . 6) (8 . 6)) ((0 . 7) (1 . 7) (2 . 7) (3 . 7) (4 . 7) (5 . 7) (6 . 7) (7 . 7) (8 . 7)) ((0 . 8) (1 . 8) (2 . 8) (3 . 8) (4 . 8) (5 . 8) (6 . 8) (7 . 8) (8 . 8)) ;; squares ((0 . 0) (0 . 1) (0 . 2) (1 . 0) (1 . 1) (1 . 2) (2 . 0) (2 . 1) (2 . 2)) ((3 . 0) (3 . 1) (3 . 2) (4 . 0) (4 . 1) (4 . 2) (5 . 0) (5 . 1) (5 . 2)) ((6 . 0) (6 . 1) (6 . 2) (7 . 0) (7 . 1) (7 . 2) (8 . 0) (8 . 1) (8 . 2)) ((0 . 3) (0 . 4) (0 . 5) (1 . 3) (1 . 4) (1 . 5) (2 . 3) (2 . 4) (2 . 5)) ((3 . 3) (3 . 4) (3 . 5) (4 . 3) (4 . 4) (4 . 5) (5 . 3) (5 . 4) (5 . 5)) ((6 . 3) (6 . 4) (6 . 5) (7 . 3) (7 . 4) (7 . 5) (8 . 3) (8 . 4) (8 . 5)) ((0 . 6) (0 . 7) (0 . 8) (1 . 6) (1 . 7) (1 . 8) (2 . 6) (2 . 7) (2 . 8)) ((3 . 6) (3 . 7) (3 . 8) (4 . 6) (4 . 7) (4 . 8) (5 . 6) (5 . 7) (5 . 8)) ((6 . 6) (6 . 7) (6 . 8) (7 . 6) (7 . 7) (7 . 8) (8 . 6) (8 . 7) (8 . 8)) )) ;; collect rules relative to pos (defun collect-rules (pos rules) (remove-if-not (lambda (ru) (member pos ru :test #'equal)) rules)) ;; parse text file containing question ;; and generate candidates table (defun parse-question (filename nums) (with-open-file (ifs filename :direction :input) (let* ((ta (make-hash-table :test #'equal)) (str (read-line ifs nil)) (row (read-from-string str t nil :start 0)) (clm (read-from-string str t nil :start 2)) (lst nil)) (loop for r below row do (let ((s (read-line ifs nil))) (loop for c below clm do (let ((val (read-from-string s t nil :start (* c 2)))) (if (= val 0) (setf (gethash (cons r c) ta) nums) (setf (gethash (cons r c) ta) (cons val nil))) (setq lst (cons (cons r c) lst)))))) (values row clm (reverse lst) ta)))) ;; check whether a value can be put ;; under a rule and condition (defun validp-each (val rule certain) (not (find (list val) (mapcar (lambda (key) (gethash key certain)) rule) :test #'equal))) ;; check whether a value can be put at pos ;; under the condition and rules relative to the value (defun validp (pos val rules certain) (let ((rule (collect-rules pos rules))) (every (lambda (v) (not (null v))) (mapcar (lambda (r) (validp-each val r certain)) rule)))) ;; return next candidates table (defun possible-list (certain nums poslist rules) (let ((tmphash (make-hash-table :test #'equal))) (mapc (lambda (pair) (let* ((pos (car pair)) (possibility (cdr pair)) (certain? (gethash pos certain))) (if (= 1 (list-length certain?)) (setf (gethash pos tmphash) certain?) (setf (gethash pos tmphash) possibility)))) (mapcar (lambda (pos) (cons pos (remove-if-not (lambda (n) (validp pos n rules certain)) nums))) poslist)) tmphash)) ;; count elements with only 1 possible value (defun count-certain (certain) (count-if (lambda (v) (= 1 (length v))) (loop for val being the hash-values in certain collect val))) ;; check consistency (defun inconsistentp (certain rules) (let ((values (loop for val being the hash-values in certain collect val))) (cond ((some #'null values) t) ((some (lambda (val) (> (list-length val) 1)) values) nil) ((ruleviolatedp certain rules) t) (t nil)))) (defun ruleviolatedp (certain rules) (some #'null (mapcar (lambda (val1) (let ((lst (mapcar (lambda (val2) (gethash val2 certain)) val1))) (= (list-length lst) (list-length (remove-duplicates lst :test #'equal))))) rules))) ;; check if solved or not (defun solvedp (certain rules) (and (not (ruleviolatedp certain rules)) (every (lambda (v) (= 1 (list-length v))) (loop for val being the hash-values in certain collect val)))) (defun print-solution (certain row clm) (loop for r below row do (progn (loop for c below clm do (format t "~S " (car (gethash (cons r c) certain)))) (format t "~%"))) (format t "~%")) (defun smallest-uncertain (certain num) (let ((cand (find-if (lambda (pair) (= (list-length (cdr pair)) num)) (loop for key being the hash-keys in certain using (hash-value val) collect (cons key val))))) (if cand cand (smallest-uncertain certain (+ 1 num))))) ;; solve sudoku (defun solve (certain nums poslist rules row clm solutions) (let ((sol1 solutions)) (cond ((inconsistentp certain rules) nil) ((solvedp certain rules) (setf sol1 (cons certain sol1)) ) (t (let ((next (possible-list certain nums poslist rules))) (if (< (count-certain certain) (count-certain next)) (setf sol1 (solve next nums poslist rules row clm sol1)) (let ((first-uncertain (smallest-uncertain certain 2))) (mapc (lambda (val) (progn (setf (gethash (car first-uncertain) next) (list val)) (setf sol1 (solve next nums poslist rules row clm sol1)))) (cdr first-uncertain))))))) sol1)) (defun run (pathname) (multiple-value-bind (r c l ta) (parse-question pathname *nums*) (time (mapc (lambda (s) (print-solution s r c)) (solve ta *nums* l *rules* r c nil)))))
sudoku-sample.txt 9 9 0 0 5 3 0 0 0 0 0 8 0 0 0 0 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 0 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
こんなファイルを用意して
CL_USER> (run "sudoku-sample.txt")
ってやると
1 4 5 3 2 7 6 9 8 8 3 9 6 5 4 1 2 7 6 7 2 9 1 8 5 4 3 4 9 6 1 8 5 3 7 2 2 1 8 4 7 3 9 5 6 7 5 3 2 9 6 4 8 1 3 6 7 5 4 2 8 1 9 9 8 4 7 6 1 2 3 5 5 2 1 8 3 9 7 6 4 Evaluation took: 14.176 seconds of real time 14.289376 seconds of total run time (14.124370 user, 0.165006 system) [ Run times consist of 0.356 seconds GC time, and 13.934 seconds non-GC time. ] 100.80% CPU 39,602,840,884 processor cycles 1,647,842,864 bytes consed
こんな感じに結果が出る。
答えが一つと決まってるならいいんだけど複数のあり得る答えがある場合もあるから結局全探索する事になって難しい問題だと時間がかかる。高速化を図ろうかな。
normal-top-level-add-subdirs-to-load-path
新しくインストールしたelispにいちいちパスを通すのが面倒だから、
init.elに
(defun add-to-load-path (&rest paths) (let (path) (dolist (path paths paths) (let ((default-directory (expand-file-name (concat user-emacs-directory path)))) (add-to-list 'load-path default-directory) (if (fboundp 'normal-top-level-add-subdirs-to-load-path) (normal-top-level-add-subdirs-to-load-path))))))
みたいな事を書いてる。
(add-to-load-path "elisp")
みたいな事をすれば、elisp以下にある全てのディレクトリを再帰的にたどってパスを通してくれる。
.nosearchっていうファイルがあるフォルダは無視してくれるって事を今日知ったからメモる。
adobe illustrator cs6のparmエラー
adobe master collection cs6を買った。なぜか日本語版だった。
普段macは英語環境にしてるんだけどそのままillustratorを起動しようとすると
PARMとかいう謎のダイアログがでて起動しない。
こんな理由らしい。
解決方法はいくつかあるけどどれもめんどくさい。
1. OSを日本語環境にする
- > 普段ランチャとして使ってるspotlight検索がめんどうになる
2. illustrator開くときだけlanguagesでenglishを日本語の下にする
- > めんどい
だから結局ここを参考にしてlanguageswitcherを使う事にした。
かゆいところに手が届くソフトを作る人がいるんだなあと思う一方で、
adobeもソフトのプロならそんぐらいなんとかしろよと思った。
PyROOTのTips
pyrootを起動したときにもrootlogon.Cとかを読む
別にrootlogon.Cじゃなくても多分任意のCルートマクロを読めると思う。
ROOT.gROOT.Macro(os.path.expanduser("~/soft/root/tutorials/rootlogon.C"))
TreeのBranchを自動で全部イテレートする
f = ROOT.TFile("treefile.root") t = f.Get("tree") oa = t.GetListOfBranches() namelst = [] for i in range(oa.GetEntries()): namelst.append(oa.At(i).GetName()) for i in range(10): print "--- entry %(i)d ---"%locals() t.GetEntry(i) for name in namelst: print name, " = ", getattr(t, name)
TreeのBranchが"x","xerr"とかだったら
--- entry 0 --- x = 0.5 xerr = 0.1 --- entry 1 --- x = 1.5 xerr = 0.2 --- entry 2 --- ...
とか出る。
auto-insert-modeでひな形を自動入力
スクリプトの最初の行の
#!/usr/bin/env ruby
みたいなのってシバンって呼ぶらしい。
新しいスクリプトを書くときにこれをいちいち書くのって面倒だなあと思ってた。
pythonとかだとimport sys, osあたりも必ず書くからなおのこと面倒だった。
emacsにauto-insert-modeというのがあって、ひな形を自動入力してくれるらしい。
新しく何かを入れる必要はなくて、init.elとかに
(require 'autoinsert) (add-hook 'find-file-hooks 'auto-insert) ;; (setq auto-insert-query nil) ;; 自動補完しますか?って最初に聞かれる機能のオンオフ
と書けばよい。
C-x fとかで新しいファイルを作ると、拡張子で判断してそれぞれの自動入力がスタートする。
ミニバッファで何か聞かれたり聞かれなかったりして、その結果に応じて自動的にいろいろと入力してくれる。
デフォルトではc++のヘッダとかemacs lispのひな形とかが入っていた。
emacs lispのひな形は自動的にGNUライセンスとかまで入れてくれてなかなかの見物。
ひな形はテキスト形式かSkeleton言語形式で与えられる。
テキスト形式だと入力されることはされるんだけどカーソルが一番上にあって面倒だからSkeleton言語で書くほうがおすすめ。
デフォルトのひな形を全部切って、よく書くスクリプトのやつだけ書いた。
;; テキスト形式で与える方法 ;; (setq auto-insert-directory "~/.emacs.d/insert/") ;; 最後にスラッシュ必要 ;; (define-auto-insert "\\.rb$" "template.rb") (setq auto-insert-alist nil) ;; デフォルトのひな形を一度全部オフにする。 (setq auto-insert-alist (append '( (("\\.rb$" . "ruby template") nil ;; ここに"name?"とか書くと、最初にミニバッファで"name?"ってでて入力を促される。入力したものはstrという変数に入る。 "#!/usr/bin/env ruby\n" "\n" _ ;; アンダーバーを書いたところにカーソルが移動する )) auto-insert-alist)) (setq auto-insert-alist (append '( (("\\.py$" . "python template") nil "#!/usr/bin/env python\n" "\n" "import sys, os, math\n" "# import numpy as np\n" "# import scipy as sp\n" "# import ROOT\n" "# import pyfits as pf\n" "\n" _ )) auto-insert-alist)) (setq auto-insert-alist (append '( (("\\.sh$" . "shell script template") nil "#!/bin/bash\n" "\n" _ )) auto-insert-alist))
これでたとえばhoge.rbというファイルを新しく作ると
#!/usr/bin/env ruby
って入力されて、3行目にカーソルが移動した状態から編集をスタートできる。
ちなみにシバンがあるファイルを保存したときに、実行権限がなければ自動的にchmodして実行権限をつけるということもできる。
(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p)
ここも参考になった。
autoinsert mode - Yasuto Takenaka 's
autoinsert
メモ
現在のスペースで新しくターミナルウィンドウを開くショートカットを作る
macos - Accessing dock icon right-click menu items with AppleScript - Stack Overflow
参考になりそう
GUIスクリプティングで使いたくなる道具 - ザリガニが見ていた...。
MacBookのメニューをショートカットで操作する試行錯誤 - ザリガニが見ていた...。
Safariのテキストエンコーディングを循環的に切り替えるサービスメニュー
最近Safariを使ってて文字化けにあうことが多くなった気がする。
テキストエンコーディングの自動判別がどうも切れているみたい。
旧・Macの手書き説明書 - FC2 BLOG パスワード認証
ここに書いてあるようにdefaultを書き換えてみたりもしたけど効果がよくわからなかった。
基本的に文字化けで困るのは日本語のときだから、
前まではSystem Preferences/Keyboard/Keyboard Shortcutsに
それぞれのエンコーディングに切り替える専用のショートカットを登録してた。
でもいざ文字化けに合うと正しい文字コードがどれかなんてよくわからないことが多い上に、自分で登録したショートカットは覚えられないしで結局メニューバーから自分で選んだりしていた。何にしても面倒だった。
これは一つのショートカットでいろんなエンコーディングを切り替えてくれるようなメニューがあれば解決する。
という訳で、Safariで使えるServiceメニューをAutomator+Applescriptで作った。
Safari/Servicesにこんな感じのメニューが追加される。
