1.7 練習問題
- double (double 2)の結果を算出する別の計算方法を考える
double (double 2)
= double (2 + 2)
= (2 + 2) + (2 + 2)
= 4 + (2 + 2)
= 4 + 4
= 8- xの値によらず sum [x] = x であることを示す
-- 関数sumの定義
sum [] = 0 ... ①
sum (n:ns) = n + sum ns ... ②
-- 問２の解
sum [x]
= x + sum []
= x + 0
= x- 数値のリストに対し積を計算する関数productを定義し、product [2, 3, 4] = 24 となることを示す
-- 関数productの定義
product [] = 1
product (n:ns) = n * product ns
-- 一応型も定義（sum関数を真似してみた）
product :: Num a => [a] -> a
product [2, 3, 4]
= 2 * product [3, 4]
= 2 * (3 * product [4])
= 2 * (3 * (4 * product []))
= 2 * (3 * (4 * 1))
= 24- リストを降順に整列するに関数qsortの定義を変えるにはどうすれば良いか
-- リストを降順に整列するqsort
qsort [] = []
qsort(x:xs) = qsort larger ++ [x] ++ qsort smaller
where
smaller = [a | a <- xs, a <= x]
larger = [b | b <- xs, b > x]
-- 具体的な値で降順ソートしてみる
qsort [3, 5, 1, 4, 2]
= qsort [5, 4] ++ [3] ++ qsort [1, 2]
= (qsort [] ++ [5] ++ qsort [4]) ++ [3] ++ (qsort [2] ++ [1] ++ qsort [])
= [5, 4] ++ [3] ++ [2, 1]
= [5, 4, 3, 2, 1]- qsortの定義で、≤を<に置き換えるとどのような影響があるか
-- 本書で与えられているqsortの定義（数値リストを昇順に並べ変える）
qsort [] = []
qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
where
smaller = [a | a <- xs, a <= x]
larger = [b | b <- xs, b > x]
-- <=を<に置き換えたqsortの定義
qsort [] = []
qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
where
smaller = [a | a <- xs, a < x]
larger = [b | b <- xs, b > x]
-- <=を<に置き換えたqsortで[2, 2, 3, 1, 1]をソートしてみる
qsort [2, 2, 3, 1, 1]
= qsort [1, 1] ++ [2] ++ qsort [3] -- 残ったリストの中の要素2が、larger, smallerのどちらにも該当しないため消えてしまう
= (qsort [] ++ [1] ++ qsort []) ++ [2] ++ qsort [3] -- 同上の理由で1が消える
= [1] ++ [2] ++ [3]
= [1, 2, 3]
-- 解
-- qsortの定義で<=を<に置き換えると、与えられたリストの要素として同一の数値が複数存在する場合、
-- 重複した値が解のリストから消えてしまうという影響がある。2.7 練習問題
- この章の例題の実行（やった）
- 結合順位を示す括弧をつける
2^3*4
= (2^3)*4
2*3+4*5
= (2*3)+(4*5)
2+3*4^5
= 2+(3*(4^5))- 3つのエラーを修正してGHCiで正しく動くようにする
-- 修正前
N = a 'div' length xs
where
a = 10
xs = [1, 2, 3, 4, 5]
-- 修正後
-- 1.新しく関数を定義する場合、関数の引数と名前は先頭を小文字にしなければならない
-- 2.レイアウト規則より、レベルが同じ定義（今回の例だと`a = 10`と`xs = [1, 2, 3, 4, 5]`）は、
-- プログラム中で先頭を完全に同じ列に揃えなければならない
-- 3.引数を2つ取る関数は、関数名をバッククォートで囲むことで引数の間に書けるようになる
n = a `div` length xs
where
a = 10
xs = [1, 2, 3, 4, 5]メモ: GHCiで複数行を入力する方法
https://tnomura9.exblog.jp/23586727/
- プレリュード関数last（空でないリストの最後の要素を取り出す）をこの章で紹介されたプレリュード関数を使って定義する
-- 解1. リストを逆順にしてから先頭の要素を取り出す
-- (reverse xs)のように括弧をつけないと、関数適用は優先順位がもっとも高いのでheadの引数がreverseと
-- 解釈してパースエラーを起こしてしまう
last xs = head (reverse xs)
-- 解2. (リストの要素数 - 1)を先頭から取り除いて残った要素を取り出す
last xs = head (drop (length xs - 1) xs)
-- 解3. リストの(要素数 - 1)番目の要素を取り出す
last xs = xs !! (length xs - 1)- プレリュード関数init（空でないリストから最後の要素を取り除いたリストを返す）の定義を２通り示す
-- 解1. 要素を逆順にしてから先頭の要素を取り除いたあと、要素を再度逆順にして元の順番に戻す
init xs = reverse(tail (reverse xs))
-- 解2. リストの先頭から(要素数 - 1)個の要素を取り出す
init xs = take (length xs - 1) xs3.11 練習問題
- 以下の型は何でしょう？
['a', 'b', 'c'] :: [Char]
('a', 'b', 'c') :: (Char, Char, Char)
[(False, '0'), (True, '1')] :: [(Bool, Char)]
([False, True], ['0', '1']) :: ([Bool], [Char])
[tail, init, reverse] :: [[a] -> [a]]- 以下の関数の定義を書き下してください。型が正しい限り、どのように実装してもかまいません。
-- 1
bools :: [Bool]
bools = [True, False]
-- 2
nums :: [[Int]]
nums = [[1, 2, 3], [4, 5, 6]] -- 別解 [[100]]
-- 3
add :: Int -> Int -> Int -> Int
add x y z = x + y + z -- メモ `->`は右結合なので、型定義を明示的にすると、 add :: Int -> (Int -> (Int -> Int))
-- 4
copy :: a -> (a, a)
copy x = (x, x)
-- 5
apply :: (a -> b) -> a -> b
apply f x = f x-
- 以下の関数の型は何でしょう？ また、その結果をGHCiで確かめてください。
-- 1
second xs = head (tail xs)
second :: [a] -> a
-- 2
swap (x, y) = (y, x)
swap :: (a, b) -> (b, a)
-- 3
pair x y = (x, y)
pair :: a -> b -> (a, b)
-- 4
double x = x * 2
double :: Num a => a -> a
-- 5
palindrome xs = reverse xs == xs
palindrome Eq [a] => [a] -> Bool -- 同等と不等を比較できれば良いので、Eqクラス。Eqクラスのインスタンスであることに加えて、線型的に順序づけられる型である必要がある場合に、Ordクラスを使用することになる
-- 6
twice f x = f (f x)
twice :: (t -> t) -> t -> t
5. 一般的に、関数の型をEqクラスのインスタンスにするのが実現不可能な理由は何でしょうか？実現可能なのはどういった場合でしょうか？
ヒント. 同じ型の二つの関数が同等であるのは、同等な引数に対して同等な結果を返す時です。
-- 実現不可能な理由: 2つの関数が等しいかどうかを比較することが一般的に実現不可能であるため。
-- 実現可能な場合: 2つの関数が同等の型であり、その返り値がEqクラスのインスタンスである場合。
-- 引数が同じで返り値が異なるのであれば返り値を比較して関数の比較とすることができると考えた。4.8 練習問題
- 長さが偶数のリストを半分ずつに分割する関数を定義する
halve :: [a] -> ([a], [a])
halve xs = (take n xs, drop n xs)
where n = length xs `div` 2
- リストの3つ目の要素を返す関数を定義する。リストには3つ以上要素が格納されているものとする
third :: [a] -> a
-- a. headとtail
third xs = head (tail (tail xs))
-- b. リストのインデックス演算子!!
third xs = xs !! 2
-- c. パターンマッチ
third (_:_:x:_) = x
- tailのように振る舞う関数を考える。ただし空リストが与えられてもエラーとせず、空リストを返す。
safetail :: [a] -> [a]
-- a. 条件式
safetail xs = if null xs then [] else tail xs
-- b. ガード付きの等式
safetail xs | null xs = []
| otherwise = tail xs
-- c. パターンマッチ
safetail [] = []
safetail (_:xs) = xs
- パターンマッチを使って、論理和演算子||を４通りの方法で定義する
(||) :: Bool -> Bool -> Bool
--1.
True || True = True
True || False = True
False || True = True
False || False = False
--
--2.
False || False = False
_ || _ = True
--
--3.
False || b = b
True || _ = True
--
--4.
b || c | b == c = b
| otherwise = True
- 他のプレリュード関数や演算子を使わずに論理積&&に対する以下の定義を条件式を用いて形式化する
True && True = True
_ && _ = False
(&&) x y = if x == True then if y == True then True else False else False
- 以下についても5.と同じことをする
True && b = b
False && _ = False
(&&) x y = if x == True then y else False
- 以下のカリー化された関数の定義の意味をラムダ式を用いて形式化する
mult :: Int -> Int -> Int -> Int
mult x y z = x * y * z
mult = \x -> (\y -> (\z -> x * y * z))
- 数を２倍して、その結果が９より大きいなら９を引く関数luhnDouble :: Int -> Intを定義する
luhnDouble :: Int -> Int
luhnDouble n = if n * 2 > 9 then n * 2 - 9
else n * 2
- luhnDoubleと正数の剰余を求める関数modを使って、４桁の銀行のカード番号が正しいかどうかを判定する関数luhnを定義する
luhn :: Int -> Int -> Int -> Int -> Bool
luhn n4 n3 n2 n1 = if (luhnDouble n4 + n3 + luhnDouble n2 + n1) `mod` 10 == 0 then True else False
5.7 練習問題
- 1から100までの２乗の和
sum [x^2 | x <- [1..100]]grid :: Int -> Int -> [(Int, Int)]
grid m n = [(x, y) | x <- [0..m], y <- [0..n]]square :: Int -> [(Int, Int)]
square n = [(x, y) | (x, y) <- grid n n , x /= y]replicate :: Int -> a -> [a]
replicate n x = [x | _ <- [1..n]] -- `_`はxを適切な数だけ作るカウンターpyths :: Int -> [(Int, Int, Int)]
pyths n = [(x, y, z) | x <- [1..n], y <- [1..n], z <- [1..n], x^2 + y^2 == z^2]
perfects :: Int -> [Int]
perfects n = [x | x <- [1..n], sum (tail (reverse (factors x))) == head (reverse (factors x))]
concat [[(x, y) | y <- [4, 5, 6]] | x <- [1, 2, 3]]-- 教科書のpositionsの定義
positions :: Eq a => a -> [a] -> [Int]
positions x xs = [i | (x', i) <- zip xs [0..], x == x']
-- 教科書のfindの定義
find :: Eq a => a -> [(a, b)] -> [b]
find k t = [v | (k', v) <- t, k == k']
-- 自分の回答
positions x xs = find x (zip xs [0..])- ２つのリストから内積を計算する関数scalarproduct :: [Int] -> [Int] -> Intを示す
scalarproduct :: [Int] -> [Int] -> Int
scalarproduct xs ys = sum [x * y| (x, y) <- zip xs ys]- シーザー暗号のプログラムを変更して、大文字も扱えるようにする
-- 文字cをシフト数nだけずらす
shift :: Int -> Char -> Char
shift n c | isLower c = chr (ord 'a' + ((ord c - ord 'a' + n) `mod` 26))
| isUpper c = chr (ord 'A' + ((ord c - ord 'A' + n) `mod` 26))
| otherwise = c
encode :: Int -> String -> String
encode n xs = [shift n x | x <- xs]
-- 複合は教科書の関数をそのまま使うことができるはず6.8 練習問題
- 再帰的に定義された階乗関数が負の整数を与えられた場合の振る舞いは？また、再帰部にガードを追加して負の整数を禁止するように定義を変更する。
-- 永遠に基底部に収束せず、処理が終わらない。
-- 負の整数を禁止する
fac :: Int -> Int
fac 0 = 1
fac n | n > 0 = n * fac (n-1)
- 与えられた非負の整数から０までを足し合わせる関数sumdownを再帰的に定義する
sumdown :: Int -> Int
sumdown n | n == 0 = 0
| n > 0 = n + sumdown (n-1)
- 負でない整数に対するべき乗演算子^を定義する
(^) :: Int -> Int -> Int
m ^ 0 = 1
m ^ n = m * (m ^ (n-1))
- 2つの非負の整数に対する最大公約数を計算するためにユークリッドの互除法を実現する関数を再帰的に定義する
eu :: Int -> Int -> Int
eu 0 _ = 0
eu _ 0 = 0
eu m n | m == n = m
| m >= n = eu (m-n) n
| otherwise = eu m (n-m)
- この賞で与えられた再帰的定義を使って、
length [1, 2, 3],drop 3 [1, 2, 3, 4, 5],init [1, 2, 3]を簡約する。
length [1, 2, 3]
= 1 + length [2, 3]
= 1 + (1 + length [3])
= 1 + (1 + (1 + 0))
= 3
drop 3 [1, 2, 3, 4, 5]
= drop 2 [2, 3, 4, 5]
= drop 1 [3, 4, 5]
= drop 0 [4, 5]
= [4, 5]
init [1, 2, 3]
= 1 : init [2, 3]
= 1 : (2 : init [3])
= 1 : (2 : [])
= [1, 2]
- プレリュード関数を再帰を使って再定義する
-- リストの要素が全てTrueであるかを検査する
and :: [Bool] -> Bool
and [] = True
and (b:bs) | b == False = False
| otherwise = andd bs
-- リストのリストをとり、要素であるリストを連結する
concat :: [[a]] -> [a]
concat [] = []
concat (xs:xss) = xs ++ concat xss
-- 指定された要素をn個もつリストを生成する関数
replicate :: Int -> a -> [a]
replicate 0 _ = []
replicate n x = x : replicate (n-1) x
-- 空でないリストのn番目の要素を取り出す関数
(!!) :: [a] -> Int -> a
(!!) (x:xs) 0 = x
(!!) (x:xs) n | n > 0 = (!!) xs (n-1)
-- リストの要素に含まれているか検査する関数
elem :: Eq a => a -> [a] -> Bool
elem e [] = False
elem e (x:xs) | e == x = True
| otherwise = elem e xs
- 関数mergeを再帰を用いて定義する
merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) | x >= y = y : merge (x:xs) ys
| x < y = x : merge xs (y:ys)- マージソートを実行する関数msortを定義する
-- リストを２つに分割する関数
halve :: [a] -> ([a], [a])
halve xs = splitAt (length xs `div` 2) xs
-- マージソートを実行する関数
msort :: Ord a => [a] -> [a]
msort [] = []
msort (x:xs) | length (x:xs) == 1 = [x]
| otherwise = merge (msort.fst $ halve (x:xs)) (msort.snd $ halve (x:xs))
-- 関数の合成を使う！- プレリュードを定義する
-- 数値のリストに対し、要素の和を計算する関数sum
sum :: [Int] -> Int
sum [] = 0
sum (x:xs) = x + sum xs
-- リストの先頭からn個の要素を取り出すtake
take :: Int -> [a] -> [a]
take n [] = []
take 0 _ = []
take n (x:xs) = x : (take (n-1) xs)
-- 空でないリストの末尾の要素を取り出す関数last
last :: [a] -> a
last (x:xs) | null xs = x
| otherwise = last xs7.9 練習問題
[f x | x <- xs, p x]をmapとfilterで書き直す (メモ: 要素はxsに含まれて、p xがTrueなものに関数fを適用した要素のリスト)
map f (filter p xs)
-- a
all :: (a -> Bool) -> [a] -> Bool
all f [] = True
all f (x:xs) | f x == False = False
| otherwise = all f xs
-- ↑ all p = and . map p でめっちゃ簡単に定義できた。。
-- b
any p = or . map p
-- c
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile _ [] = []
takeWhile f (x:xs) | f x = x : takeWhile f xs
| otherwise = []
-- d
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile _ [] = []
dropWhile f (x:xs) | f x = dropWhile f xs
| otherwise = x : dropWhile f xs
-- map f
map :: (a -> b) -> [a] -> [b]
map f = foldr (\x xs -> f x : xs) []
-- filter f
filter :: (a -> Bool) -> [a] -> [a]
filter f = foldr (\x xs -> if f x then x : xs else xs) []
dec2int :: (Foldable t, Num a) => t a -> a
dec2int = foldl (\x y -> 10 * x + y) 0
- 2つの高階関数を定義する
-- a. 「引数に組を取る関数」を「カリー化された関数」へ変換する関数curry
curry :: ((a, b) -> c) -> (a -> b -> c)
curry f = \x y -> f(x, y)
-- b. 「引数が二つのカリー化された関数」を「引数に組を取る関数」へ変換する関数uncurry
uncurry :: (a -> b -> c) -> ((a, b) -> c)
uncurry f = \(x, y) -> f x y
-- メモ
add' = uncurry (+)
add' (1, 2) = 3
- 関数unfoldを用いて、関数chop8, map f, iterate fを再定義する
-- unfold p h t x | p x = []
-- | otherwise = h x : unfold p h t (t x)
-- int2bin = unfold (== 0) (`mod` 2) (`div` 2)
int2bin
--a. chop8 (数値のリストを8個ずつにまとめてリストのリストを作る関数)
chop8 :: [Int] -> [[Int]]
chop8 = unfold null (take 8) (drop 8)
--b. map f
map f = unfold null (f.head) tail
--c. iterate f
iterate f = unfold (\x -> False) id f
- パリティビットの追加
-- エンコード
filterFlag :: [Bit] -> [Bit]
filterFlag = filter (==1)
calculateParity :: [Bit] -> Bool
calculateParity bs = (odd (length (filterFlag bs)))
addParity :: [Bit] -> [Bit]
addParity bits | calculateParity bits = bits ++ [1]
| otherwise = bits ++ [0]
encode :: String -> [Bit]
encode = addParity . concat . map (make8.int2bin.ord)
-- デコード
parityCheck :: [Bit] -> Bool
parityCheck bits = even ( length (filter (==1) bits))
-- 任意の文字列取るとこまでできなかった..
decode bits | parityCheck bits = init bits
| otherwise = error "parity error."
- 上の動作チェック
decode (tail (encode "a")) #=> "parity error."
- 関数altMapを定義する
listWithIndex :: [a] -> [(Int, a)]
listWithIndex xs = zip [0..] xs
funcSwitcher :: (a -> b) -> (a -> b) -> (Int, a) -> b
funcSwitcher f g (i, a) | even i = f a
| otherwise = g a
altMapWithIndex :: (a -> b) -> (a -> b) -> [(Int, a)] -> [b]
altMapWithIndex f g = map (funcSwitcher f g)
altMap :: (a -> b) -> (a -> b) -> [a] -> [b]
altMap f g = altMapWithIndex f g . listWithIndex
- luhnの引数を任意長に
luhnDouble = altMap id (*2) . reverse
luhnNine :: [Int] -> [Int]
luhnNine [] = []
luhnNine (x:xs) | x > 9 = (x-9) : luhnNine xs
| otherwise = x : luhnNine xs
luhn :: [Int] -> Bool
luhn xs = sum (luhnNine (luhnDouble xs)) `mod` 10 == 0
8.9 練習問題
- 自然数の乗算関数multを再帰的に定義する
data Nat = Zero | Succ Nat
add :: Nat -> Nat -> Nat
add Zero n = n
add (Succ m) n = Succ (add m n)
mult :: Nat -> Nat -> Nat
mult Zero n = Zero
mult (Succ m) n = add n (mult m n)
- 探索木用の関数occursを再定義して、元の実装よりも効率的である理由を説明する
-- プレリュード
data Ordering = LT | EQ | GT
compare :: Ord a => a -> a -> Ordering
occurs x (Leaf y) = x == y
occurs x (Node l y r) | compare x y == LT = occurs x l
| compare x y == EQ = True
| compare x y == GT = occurs x r
-- 答え見る前は、上記のように書いていたで、なぜ効率的なのかわからなかった。。。
-- case使うと比較が１回で済むので効率的ということらしい
occurs x (Leaf y) = x == y
occurs x (Node l y r) = case compare x y of
LT -> occurs x l
EQ -> True
GT -> occurs x r
- 二分木が平衡しているか調べる関数balanced :: Tree a -> Bool を定義する
data Tree a = Leaf a | Node (Tree a) (Tree a)
-- 木の中の葉の数を返す関数
leaves :: Tree a -> Int
leaves (Leaf) _ = 1
leaves (Node l r) = leaves l + leaves r
-- 二分木が平衡しているかどうか調べる関数
balanced :: Tree a -> Bool
-- 現在の節において、左右の木の葉の数がプラマイ1に収まっていることを確認してから、どんどん節を下に降りていく
balanced (Leaf _) = True
balanced (Node l r) = (-1 <= (leaves l - leaves r) <= 1) && balanced l && balanced r
- 空でない整数のリストを平衡木に変換する関数balance :: [a] -> Tree aを定義する
-- 与えられたリストを要素数の差1以内になるような2つのリストに分割する
divide :: [a] -> ([a], [a])
divide ns = splitAt (length ns `div` 2) ns
-- リストを平衡木に変換する関数
balance :: [a] -> Tree a
balance [n] = Leaf n
balance ns = Node (balance ls) (balance rs)
where (ls, rs) = divide ns
以下の型が宣言されている時 data Expr = Val Int | Add Expr Expr 以下の高階関数を定義しなさい。 ただし、folde f gは、式の中のそれぞれのValをfで置き換え、それぞれのAddをgで置き換えるとする。
folde :: (Int -> a) -> (a -> a -> a) -> Expr -> a
folde f g (Val n) = f n
folde f g (Add x y) = g (folde f g x) (folde f g y)
- foldeを使って、式を整数に変換する関数eval :: Expr -> Intを定義する。また、foldeを使って、式の中に整数がいくつあるか数える関数 size :: Expr -> Intを定義する。
eval :: Expr -> Int
eval = folde (+0) (+)
size :: Expr -> Int
size = folde (+1) (+)
- 以下のインスタンス宣言を完成させる
-- `Duplicate instance declarations`というエラーが出てコンパイルできない、、
instance Eq a => Eq (Maybe a) where
Nothing == Nothing = True
Nothing == _ = False
_ == Nothing = False
Just x == Just y = x == y
instance Eq a => Eq [a] where
[] == [] = True
[] == _ = False
_ == [] = False
(x:xs) == (y:ys) = x == y && xs == ys
- 恒等式の検査器を拡張して、命題の中で「論理和」と「同値」を扱えるようにする
data Prop = Const Bool
| Var Char
| Not Prop
| And Prop Prop
| Imply Prop Prop
| Or Prop Prop
| Iff Prop Prop
type Assoc k v = [(k, v)]
-- 変数名を真理値に対応づける置換表
type Subst = Assoc Char Bool
-- 与えられた置換表のもとで、命題を評価する
eval :: Subst -> Prop -> Bool
eval _ (Const b) = b
eval s (Var x) = find x s
eval s (Not p) = not (eval s p)
eval s (And p q) = eval s p && eval s q
eval s (Imply p q) = eval s p <= eval s q
eval s (Or p q) = eval s p || eval s q
eval s (Iff p q) = eval s p == eval s q
-- 命題の中にある全ての変数をリストとして返す
vars :: Prop -> [Char]
vars (Const _) = []
vars (Var x) = [x]
vars (Not p) = vars p
vars (And p q) = vars p ++ vars q
vars (Imply p q) = vars p ++ vars q
vars (Or p q) = vars p ++ vars q
vars (Iff p q) = vars p ++ vars q
- 抽象機械を拡張して、乗算を扱えるようにする
data Expr = Val Int | Add Expr Expr | Mul Expr Expr
-- Expr型の数式を評価して整数にする関数value
value :: Expr -> Int
value (Val n) = n
value (Add x y) = value x + value y
value (Mul x y) = (value x) * (value y)
-- 現在の評価が終わった後に実行すべき命令のリスト
type Cont = [Op]
data Op = EVAL Expr | Add Int | Mul Int
eval :: Expr -> Cont -> Int
eval (Val n) c = exec c n
eval (Add x y) c = eval x (EVAL y : c)
eval (Mul x y) c = eval x (Eval y : c)
exec :: Cont -> Int -> Int
exec [] n = n
exec (EVAL y : c) n = eval y (Add n : c)
exec (ADD n : c) m = exec c (n+m)
exec (MUL n : c) m = exec c (n*m)
value :: Expr -> Int
value e = eval e []
9.11 練習問題 1. 関数choicesは、リストの要素を0個以上取り出す&それぞれの順列を求めて全て返す
-- 関数合成でやっていることを、そのままリスト内包表記に起こしただけ
choices :: [a] -> [[a]]
choices xs = [zs : ys <- subs xs, zs <- perms ys]
-- あるリストから最初に見つかった特定の値を取り除く関数
removeFirstMatch :: Eq a => a -> [a] -> [a]
removeFirstMatch _ [] = []
removeFirstMatch x (y:ys) | x == y = ys
| otherwise = y : removeFirstMatch x ys
-- isChoice
-- リスト(x:xs)がリストysから選択されたものなのか検証する
-- elemは指定した要素がリストに含まれているかどうか調べる関数
isChoice :: Eq a => [a] -> [a] -> Bool
isChoice [] _ = True
isChoice _ [] = False
isChoice (x:xs) ys = elem x ys && isChoice xs (removeFirstMatch x ys)
関数splitは、あるリストを2つの空でないリストに分割するすべての方法を組にして返す
-- splitを拡張して、組の中に空リストを許す
split' :: [a] -> [([a], [a])]
split' [] = []
split' [_] = []
split' (x:xs) = ([], (x:xs)) : ([x], xs) : [(x:ls, rs) | (ls, rs) <- split' xs]
回答：
仮に split [1, 2, 3] = [([], [1, 2, 3])]と分割された場合、関数exprsの再帰呼び出し部分で
r <- exprs [1, 2, 3]となり、いつまでたってもリストが短くならず無限ループしてしまうようになる。
-- 定義域は0を除く自然数
length (concat (map exprs (choices [1, 3, 7, 10, 25, 50])))
> 33665406
-- 取りうる全ての式にevalを適用して、validである（1つ値の入ったリストが返る）かinvalidである（空リストが返る）を判別し、
-- 結果のリストを連結して要素数を計算する（invalidな式は空リストを返すので、要素数としてカウントされないことを利用する）
length (concat (map eval ( concat (map exprs (choices [1, 3, 7, 10, 25, 50])))))
4672540
validの定義を整数に変更する（0以下の整数を取れるようにする）
valid'' :: Op -> Int -> Int -> Bool
valid'' Add _ _ = True
valid'' Sub _ _ = True
valid'' Mul _ _ = True
valid'' Div x y = y /= 0 && x `mod` y == 0
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]
length (concat (map eval'' ( concat (map exprs (choices [1, 3, 7, 10, 25, 50])))))
10839369
-- a. 式にべき乗演算子を使えるようにする
-- valid'がうまくきいてない？ zero divide errorやnegative exponentになってしまう。しかしvalid'が実行されてからcombine'内部でapply'されるはずだから、0や負の数が演算子になることはありえないのではないのか？？
-- 答え: オーバーフローしているから
data Op' = Add | Sub | Mul | Div | Ept
instance Show Op' where
show Add = "+"
show Sub = "-"
show Mul = "*"
show Div = "/"
show Ept = "^"
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' Ept x y = x > 1 && y > 1 && (x ^ y > 0)
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
apply' Ept x y = x ^ y
data Expr = Val Int | App Op' Expr Expr
instance Show Expr where
show (Val n) = show n
show (App o l r) = brak l ++ show o ++ brak r
where
brak (Val n) = show n
brak e = "(" ++ show e ++ ")"
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 :: [a] -> [[a]]
subs [] = [[]]
subs (x:xs) = yss ++ map (x:) yss
where yss = subs xs
interleave :: a -> [a] -> [[a]]
interleave x [] = [[x]]
interleave x (y:ys) = (x:y:ys) : map (y:) (interleave x ys)
perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = concat (map (interleave x) (perms xs))
choices :: [a] -> [[a]]
choices = concat . map perms . subs
split :: [a] -> [([a], [a])]
split [] = []
split [_] = []
split (x:xs) = ([x], xs) : [(x:ls, rs) | (ls, rs) <- split xs]
ops' :: [Op']
ops' = [Add, Sub, Mul, Div, Ept]
type Result = (Expr, Int)
combine' :: Result -> Result -> [Result]
combine' (l, x) (r, y) = [(App o l r, apply' o x y) | o <- ops', valid' o x y]
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]
solutions'' :: [Int] -> Int -> [Expr]
solutions'' ns n = [e | ns' <- choices ns, (e, m) <- results ns', m == n]