Be ambigous
どんどん日が進み、
どんどん日記が遅れてゆく…
(これかいてるの8/25かも)
非決定性計算
なんだか毎回続く、とか書きながら違うことを書いているような気がする。
今回は、リストモナドを使うと非決定性計算が記述できるという話。
また微妙に脇にそれる。
そういやSICPにamb評価器があったよなぁとか、
それをすんなりかけそうだなぁとか。
というわけで、SICPの4.3章より、非決定性計算のところ。
詳しくはそちらを参考に…
(define (prime-sum-pair list1 list2) (let *1
list-element-ofは、与えられたリストの要素のどれか、を返す。
この辺が非決定。
requireは与えられた式が偽のときリジェクトするような関数。
で、全体では、与えられたリスト2つから一つずつ選んだ
要素の和が素数になるようなもののどれか、を返す(文章がなんかおかしい…)。
どれか、といっているけど、実際にはシステマティックに調べられる
わけなので、その辺は心配いらない。
というか、こんな書き方でrequireとかが継続とかを使って
バックトラックさせたり、Schemeはやっぱりすごいなぁ…
で、同じようなことをHaskellでは、
遅延評価+モナドでできるっぽいということに最近ふと気が付いた。
primSumPair l1 l2 = do a <- l1 b <- l2 guard $ prime (a+b) return (a,b)
list-element-ofが <- になっている。
Scheme版でも非決定性な値の候補はリストで表しているので、
(まぁ、当たり前といえば当たり前だけど…)
Haskellでもリストを。
requireはguardでいける。偽で呼び出せばfailになるのか。
せっかくなので、ambEvalっぽい物を。
Scheme版よりはるかにしょぼいけど…
解を一つずつ表示する機能のみ。
ambEval [] = putStrLn ";;; There are no more values." ambEval (x:xs) = do putStrLn ";;; Amb-Eval value:" print x putStrLn ";;; Amb-Eval input:" str <- getLine if str == "try-again" then ambEval xs else return ()
で、このようにすると
main = ambEval $ primSumPair [1,3,5,8] [20,35,110]
こうなる。
;;; Amb-Eval value: (3,20) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (3,110) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (8,35) ;;; Amb-Eval input: try-again ;;; There are no more values.
このような例ではあまり面白くないので、
SICPにある例、論理パズルでも解かせてみる。
まず、問い。
Baker,Cooper,Fletcher,MillerとSmithは五階建てアパートの相異なる階に住んでいる。
・Backerは最上階に住んでいない。
・Cooperは最下階に住んでいない。
・Fletcherは最上階にも最下階にも住んでいない。
・MillerはCooperよりも上の階に住んでいる。
・SmithはFletcherの隣の階に住んでいない。
・FletcherはCooperの隣の階に住んでいない。
それぞれの住んでいる階は?
Haskellでの実装例。
というか、本文中にてSchemeで書かれているものを
そのままモナドに変換しただけ…
multipleDwelling = do backer <- [1,2,3,4,5] cooper <- [1,2,3,4,5] fletcher <- [1,2,3,4,5] miller <- [1,2,3,4,5] smith <- [1,2,3,4,5] guard $ distinct [backer,cooper,fletcher,miller,smith] guard $ backer /= 5 guard $ cooper /= 1 guard $ fletcher /= 5 guard $ fletcher /= 1 guard $ miller > cooper guard $ abs (smith - fletcher) /= 1 guard $ abs (fletcher - cooper) /= 1 return [("backer" , backer) ,("cooper" , cooper) ,("fletcher",fletcher) ,("miller" , miller) ,("smith" , smith)]
distinctの定義は、
distinct [] = True distinct (x:xs) = all (/=x) xs && distinct xs
こんな感じ。
これを実行すると
;;; Amb-Eval value: [("backer",3),("cooper",2),("fletcher",4),("miller",5),("smith",1)] ;;; Amb-Eval input: try-again ;;; There are no more values.
結構すんなりと。
ついでに練習問題でも解いてみる。
問題4.38 SmithとFletcherが隣り合う階に住まないという制限を取り除いたときの解
(書き換えて実行するだけなので、略)
問題4.39 制限の順序は解に影響するか?あるいは解を見出す時間に影響するか?
解そのものには影響しない。
(ベン図でも書けば自明か)
解を見出す時間は、多くの候補が削られる制限を先においたほうが短くなる。
(証明は…ここは余白が少なすぎる)
問題4.40 人の階への割り当ての組は、階の割り当てが相異なるという制約を課す前と後ではいくつか?および、制約での候補の除外を行わない、はるかに高効率な非決定性計算を示せ。
制約を課す前……5^5=3125個
制約を課した後…5P5=120個
(結構違うのね)
高効率な計算
multipleDwelling2 = do backer <- [1,2,3,4] cooper <- [2,3,4,5] \\ [backer] fletcher <- [2,3,4] \\ [backer,cooper] guard $ abs (fletcher - cooper) /= 1 miller <- [1,2,3,4,5] \\ [backer,cooper,fletcher] guard $ miller > cooper smith <- [1,2,3,4,5] \\ [backer,cooper,fletcher,miller] guard $ abs (smith - fletcher) /= 1 return [("backer" , backer) ,("cooper" , cooper) ,("fletcher",fletcher) ,("miller" , miller) ,("smith" , smith)]
(こうかな)
問題4.41 上記問題を解く通常のSchemeプログラムを示せ
(略…順列生成してフィルタでもすりゃいいでしょう)
問題4.42 次の「うそつきパズル」を解け
5人の女子生徒が試験を受けている。
(…略…)
それぞれ正しいことと正しくないことを一つずつ述べている。
それぞれの順位は?
・Betty 「Kittyは試験が二番で、私は三番でした」
・Ethel 「私がトップと聞いて嬉しいでしょう。Joanが二位でした。」
・Joan 「私は三番でした。かわいそうなEthelはびりでした。」
・Kitty 「私は二番になりました。Maryは四番でしかありませんでした。」
・Mary 「私は四番でした。トップの座はBettyが取りました。」
プログラムは素直に書いて、
phillips = do betty <- [1,2,3,4,5] ethel <- [1,2,3,4,5] joan <- [1,2,3,4,5] kitty <- [1,2,3,4,5] mary <- [1,2,3,4,5] guard $ distinct [betty,ethel,joan,kitty,mary] guardOne (kitty==2) (betty==3) guardOne (ethel==1) (joan ==2) guardOne (joan ==3) (ethel==5) guardOne (kitty==2) (mary ==4) guardOne (mary ==4) (betty==1) return [("betty",betty) ,("ethel",ethel) ,("joan" , joan) ,("kitty",kitty) ,("mary" , mary)] guardOne a b = guard $ a && not b || not a && b
実行結果
;;; Amb-Eval value: [("betty",3),("ethel",5),("joan",2),("kitty",1),("mary",4)] ;;; Amb-Eval input: try-again ;;; There are no more values.
うむむ…かわいそうなEthel…
そろそろ疲れてきたので、この辺で。
*1:a (list-element-of list1) (b (list-element-of list2))) (require (prime? (+ a b))) (list a b