数日かけて写経したのでまとめて更新。
11.1 導入
切符番号遊びは、切符の端に書いてある四つの数字を使って、10になるように数式を組み立てる遊びである。 （中略）この章では、ゲームのルールを少し変更する。利用する数は任意の大きさで、全部を使わなくてもよく、目標も任意の数として与えられる。また、計算途中に出てくる数は、自然数 {1, 2, 3, ...}でなければならず、負の数や0、自然数に直せない分数は許されない。
11.2 問題の形式化
四つの演算子に対する型。
data Op = Add | Sub | Mul | Div deriving Show
二つの自然数に演算子を適用すると自然数を生成するかを調べる関数 valid。
valid :: Op -> Int -> Int -> Bool valid Add _ _ = True valid Sub x y = x > y valid Mul _ _ = True valid Div x y = x `mod` y == 0
有効な演算子適用を実行する関数 apply。
apply :: Op -> Int -> Int -> Int apply Add x y = x + y apply Sub x y = x - y apply Mul x y = x * y apply Div x y = x `div` y
数式の型。
data Expr = Val Int | App Op Expr Expr deriving Show
式の中の数値をリストとして返す関数 values と、式全体の値を返す関数 eval。
失敗するかもしれない関数 eval の型は、Maybe 型を使って表現してもいいが、リストならリスト内包が使えるので、今回はそうしているそうだ。
values :: Expr -> [Int] values (Val n) = [n] values (App _ l r) = values l ++ values r eval :: Expr -> [Int] eval (Val n) = [n | n > 0] eval (App o l r) = [apply o x y | x <- eval l, y <- eval r, valid o x y]
続いて、便利関数。
リストの部分リストを返す関数 subs。
subs :: [a] -> [[a]] subs [] = [[]] subs (x:xs) = yss ++ map (x:) yss where yss = subs xs
新たな要素をリストへ挿入して返す関数 interleave。
interleave :: a -> [a] -> [[a]] interleave x [] = [[x]] interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)
リストの要素に対する順列を返す関数 perms。
perms :: [a] -> [[a]] perms [] = [[]] perms (x:xs) = concat (map (interleave x) (perms xs))
これらは再帰的定義になっているのがポイント。
リストから選択肢を返す関数 choices。
choices :: [a] -> [[a]] choices xs = concat (map perms (subs xs))
与えられた式が切符番号遊びの解となっているか調べる関数 solution。
solution :: Expr -> [Int] -> Int -> Bool solution e ns n = elem (values e) (choices ns) && eval e == [n]
11.3 総当たり法
あるリストを二つの空でないリストに分割して組にする方法すべてを算出する関数 split。
split :: [a] -> [([a],[a])] split [] = [] split [_] = [] split (x:xs) = ([x],xs) : [(x:ls,rs) | (ls,rs) <- split xs]
これも再帰的定義。
与えられたそれぞれの数値が一回だけ使われている式すべてを返す関数 exprs。
exprs :: [int] -> [Expr] exprs [] = [] exprs [n] = [Val n] exprs ns = [e | (ls, rs) <- split ns, l <- exprs ls, r <- exprs rs, e <- combine l r]
二つの式を四つの演算子それぞれで組み合わせる関数 combine。
combine :: Expr -> Expr -> [Expr] combine l r = [App o l r | o <- ops] ops :: [Op] ops = [Add, Sub, Mul, Div]
切符番号遊びの一問題を満たす式すべてを返す関数 solutions。
solutions :: [Int] -> Int -> [Expr] solutions ns n = [e | ns' <- choices ns, e <- exprs ns', eval e == [n]]
総当りなので遅い。
11.4 生成と評価の方法を変える
総当たり法を使った切符番号遊びのプログラムの性能を向上させる。 評価に失敗する式は早い段階でふるい落とし、以降はそれらの式から他の式を生成しないようにする。
式とその式全体を評価した値の組 Result。
type Result = (Expr, Int)
与えられたそれぞれの数値が一回だけ使われている式すべてを返す関数 results。
results :: [Int] -> [Result] results [] = [] results [n] = [(Val n, n) | n > 0] results ns = [res | (ls, rs) <- split ns, lx <- results ls, ry <- results rs, res <- combine' lx ry]
これも再帰的定義。
二つの式を四つの演算子それぞれで組み合わせる関数 combine' (効率化版)。
combine' :: Result -> Result -> [Result] combine' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops, valid o x y]
有効な結果のみを残す。
切符番号遊びの一問題を満たす式すべてを返す関数 solutions' (効率化版)。
solutions' :: [Int] -> Int -> [Expr] solutions' ns n = [e | ns' <- choices ns, (e,m) <- results ns', m == n]
11.5 代数的な性質をいかす
交換法則と単位元の性質を利用して、有効な式の数を減らす。 交換法則で式を減らすのはいいとして、単位元で式を減らすのは、“数は全部を使わなくても良い”というルールを反映したものである。
演算子の適用が有効かを調べる関数 valid' (数を減らした版)。
valid' :: Op -> Int -> Int -> Bool valid' Add x y = x <= y valid' Sub x y = x > y valid' Mul x y = x /= 1 && y /= 1 && x <= y valid' Div x y = y /= 1 && x `mod` y == 0
あとは、valid'関数を使うように、他の関数も置き換えていく。
results' :: [Int] -> [Result] results' [] = [] results' [n] = [(Val n, n) | n > 0] results' ns = [res | (ls, rs) <- split ns, lx <- results' ls, ry <- results' rs, res <- combine'' lx ry] combine'' :: Result -> Result -> [Result] combine'' (l,x) (r,y) = [(App o l r, apply o x y) | o <- ops, valid' o x y] solutions'' :: [Int] -> Int -> [Expr] solutions'' ns n = [e | ns' <- choices ns, (e,m) <- results' ns', m == n]
実行結果にかかった時間を計測する。
11.3.hs
import ElevenThree main :: IO () main = do putStrLn $ show (length $ solutions [1,3,7,10,25,50] 765)
11.4.hs
import ElevenFour main :: IO () main = do putStrLn $ show (length $ solutions' [1,3,7,10,25,50] 765)
11.5.hs
import ElevenFive main :: IO () main = do putStrLn $ show (length $ solutions'' [1,3,7,10,25,50] 765)
$ ghc -odir bin -hidir bin -o bin/11.3.exe 11.3.hs $ ghc -odir bin -hidir bin -o bin/11.4.exe 11.4.hs $ ghc -odir bin -hidir bin -o bin/11.5.exe 11.5.hs
$ time bin/11.3.exe 780 real 0m20.731s user 0m0.000s sys 0m0.000s $ time bin/11.4.exe 780 real 0m1.729s user 0m0.000s sys 0m0.031s $ time bin/11.5.exe 49 real 0m0.327s user 0m0.000s sys 0m0.015s
