要素 x を n 個持つリストを生成する関数 make_list x n と、整数 n から m までの値に関数 f を適用した結果をリストに格納して返す関数 tabulate f n m を定義してください。なお、Haskell には make_list と同じ働きをする関数 replicate が用意されています。
make_list :: a -> Int -> [a] tabulate :: (Int -> a) -> Int -> Int -> [a]
*Main> make_list 1 10 [1,1,1,1,1,1,1,1,1,1] *Main> make_list 'a' 10 "aaaaaaaaaa" *Main> make_list [1,2] 10 [[1,2],[1,2],[1,2],[1,2],[1,2],[1,2],[1,2],[1,2],[1,2],[1,2]] *Main> tabulate id 1 5 [1,2,3,4,5] *Main> tabulate (^2) 1 5 [1,4,9,16,25] *Main> tabulate (*10) 1 5 [10,20,30,40,50]
リスト xs から要素 x を削除する関数 remove x xs と、述語 p が真を返す要素を削除する関数 remove_if p xs を定義してください。なお、Haskell には述語 p が真を返す要素を取り出す関数 filter が用意されています。
remove :: Eq a => a -> [a] -> [a] remove_if :: (a -> Bool) -> [a] -> [a]
*Main> remove 2 [1,2,3,1,2,3,4,1,2,3,4,5] [1,3,1,3,4,1,3,4,5] *Main> remove_if even [1..10] [1,3,5,7,9] *Main> remove_if odd [1..10] [2,4,6,8,10]
2 つのリスト xs, ys を受け取り、各々の要素に対して関数 f を適用し、その結果をリストに格納して返すマップ関数 map2 f xs ys を定義してください。リストの長さが異なる場合、短いほうのリストに合わせるものとします。なお、Haskell には同じ働きをする関数 zipWith が用意されています。
map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
*Main> map2 (+) [1,2,3,4] [10,20,30,40]
[11,22,33,44]
*Main> map2 (,) [1,2,3,4] [10,20,30,40]
[(1,10),(2,20),(3,30),(4,40)]
*Main> map2 (,) ['a' .. 'h'] [1..]
[('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7),('h',8)]
2 つのリスト xs, ys を畳み込む関数 foldl2 f a xs ys と foldr2 f a xs ys を定義してください。foldl2 はリストの左側 (先頭) から、foldr2 はリストの右側 (末尾) から畳み込みを行います。リストの長さが異なる場合、短いほうのリストに合わせるものとします。
foldl2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
*Main> foldl2 (\x y z -> x * y + z) 0 [1,2,3,4,5] [11,12,13,14,15] 205 *Main> foldr2 (\x y z -> x * y + z) 0 [1,2,3,4,5] [11,12,13,14,15] 205 *Main> foldl2 (\x y z -> x * y : z) [] [1,2,3,4,5] [11,12,13,14,15] [75,56,39,24,11] *Main> foldr2 (\x y z -> x * y : z) [] [1,2,3,4,5] [11,12,13,14,15] [11,24,39,56,75]
map f xs はリスト xs の要素に関数 f を適用します。関数 maplist は関数 f にリストそのものを渡します。ただし、繰り返すたびにリストの先頭要素は取り除かれていきます。関数 maplist を定義してください。
maplist :: ([a] -> b) -> [a] -> [b]
*Main> maplist id [1 .. 5] [[1,2,3,4,5],[2,3,4,5],[3,4,5],[4,5],[5]] *Main> maplist sum [1 .. 5] [15,14,12,9,5]
畳み込みを行う関数 foldl, foldr はリストの要素に関数が適用されますが、リストそのものを関数に渡して畳み込みを行う方法も考えられます。リストの先頭から畳み込みを行う関数 pair_foldl と、末尾から畳み込みを行う関数 pair_foldr を定義してください。
pair_foldl :: ([a] -> b -> b) -> b -> [a] -> b pair_foldr :: ([a] -> b -> b) -> b -> [a] -> b
*Main> pair_foldl (:) [] [1..5] [[5],[4,5],[3,4,5],[2,3,4,5],[1,2,3,4,5]] *Main> pair_foldr (:) [] [1..5] [[1,2,3,4,5],[2,3,4,5],[3,4,5],[4,5],[5]] *Main> pair_foldl (\x a -> (take 3 x) : a) [] [1..10] [[10],[9,10],[8,9,10],[7,8,9],[6,7,8],[5,6,7],[4,5,6],[3,4,5],[2,3,4],[1,2,3]] *Main> pair_foldr (\x a -> (take 3 x) : a) [] [1..10] [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10],[9,10],[10]] *Main> take 10 $ pair_foldr (\x a -> (take 3 x) : a) [] [1..] [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10],[9,10,11],[10,11,12]]
リストを平坦化する関数 flatten を定義してください。なお、Haskell には同じ働きをする関数 concat が用意されています。
flatten :: [[a]] -> [a]
*Main> flatten [[1,2,3],[4,5,6],[7,8,9]] [1,2,3,4,5,6,7,8,9] *Main> flatten [[1,2,3],[],[4,5,6],[],[7,8,9]] [1,2,3,4,5,6,7,8,9]
リスト xs に格納されたリストに関数 f を適用し、その結果を連結する関数 flatmap f xs を定義してください。なお、Haskell には同じ働きをする関数 concatMap が用意されています。
flatmap :: (a -> [b]) -> [a] -> [b]
*Main> flatmap (0:) [[1,2,3],[4,5,6],[7,8,9]] [0,1,2,3,0,4,5,6,0,7,8,9]
集合を表すリスト xs, ys の直積集合を求める関数 product_set xs ys を定義してください。xs の要素を xi, ys 要素を yj とすると、直積集合の要素は (xi, yj) となります。たとえば、xs = [1, 2, 3], ys = [4, 5] とすると、直積集合は[(1, 4), (1, 5), (2, 4), (2, 5), (3, 4), (3, 5)] になります。
product_set :: [a] -> [b] -> [(a, b)]
*Main> product_set [1,2,3] [4,5,6] [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]
リスト xs のべき集合を求める関数 power_set xs を定義してください。たとえばリスト [1, 2, 3] のべき集合は [[], [1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]] になります。
power_set :: [a] -> [[a]]
*Main> power_set [] [[]] *Main> power_set [1] [[],[1]] *Main> power_set [1,2] [[],[2],[1],[1,2]] *Main> power_set [1,2,3] [[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]] *Main> power_set [1..4] [[],[4],[3],[3,4],[2],[2,4],[2,3],[2,3,4],[1],[1,4],[1,3],[1,3,4],[1,2],[1,2,4],[1,2,3],[1,2,3,4]]
リスト xs に x を挿入するパターンをすべて求めてリストに格納して返す関数 interleave x xs を定義してください。
interleave :: a -> [a] -> [[a]]
*Main> interleave 0 [] [[0]] *Main> interleave 0 [1] [[0,1],[1,0]] *Main> interleave 0 [1,2] [[0,1,2],[1,0,2],[1,2,0]] *Main> interleave 0 [1..5] [[0,1,2,3,4,5],[1,0,2,3,4,5],[1,2,0,3,4,5],[1,2,3,0,4,5],[1,2,3,4,0,5],[1,2,3,4,5,0]]
リストから n 個の要素を選ぶ順列を求める関数 permutation を定義してください。なお、生成した順列はリストに格納して返すものとします。
permutation :: Eq a => Int -> [a] -> [[a]]
*Main> permutation 3 [1,2,3] [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]] *Main> permutation 4 [1,2,3,4] [[1,2,3,4],[1,2,4,3],[1,3,2,4],[1,3,4,2],[1,4,2,3],[1,4,3,2],[2,1,3,4],[2,1,4,3] ,[2,3,1,4],[2,3,4,1],[2,4,1,3],[2,4,3,1],[3,1,2,4],[3,1,4,2],[3,2,1,4],[3,2,4,1] ,[3,4,1,2],[3,4,2,1],[4,1,2,3],[4,1,3,2],[4,2,1,3],[4,2,3,1],[4,3,1,2],[4,3,2,1] ]
リストからすべての要素を選ぶ順列を求める関数 permutation1 を interleave を使って定義してください。なお、生成した順列はリストに格納して返すものとします。また、Haskell のモジュール Data.List には同じ働きをする関数 permutations が用意されています。
permutation1 :: [a] -> [[a]]
*Main> permutation1 [1,2,3] [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]] *Main> permutation1 [1,2,3,4] [[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[1,3,2,4],[3,1,2,4],[3,2,1,4],[3,2,4,1] ,[1,3,4,2],[3,1,4,2],[3,4,1,2],[3,4,2,1],[1,2,4,3],[2,1,4,3],[2,4,1,3],[2,4,3,1] ,[1,4,2,3],[4,1,2,3],[4,2,1,3],[4,2,3,1],[1,4,3,2],[4,1,3,2],[4,3,1,2],[4,3,2,1] ]
リストから重複を許して n 個の要素を選ぶ順列を求める関数 repeat_perm を定義してください。なお、生成した順列はリストに格納して返すものとします。
repeat_perm :: Int -> [a] -> [[a]]
*Main> repeat_perm 2 [1..4] [[1,1],[1,2],[1,3],[1,4],[2,1],[2,2],[2,3],[2,4],[3,1],[3,2],[3,3],[3,4],[4,1],[4,2],[4,3],[4,4]] *Main> repeat_perm 3 [1..4] [[1,1,1],[1,1,2],[1,1,3],[1,1,4],[1,2,1],[1,2,2],[1,2,3],[1,2,4],[1,3,1],[1,3,2] ,[1,3,3],[1,3,4],[1,4,1],[1,4,2],[1,4,3],[1,4,4],[2,1,1],[2,1,2],[2,1,3],[2,1,4] ,[2,2,1],[2,2,2],[2,2,3],[2,2,4],[2,3,1],[2,3,2],[2,3,3],[2,3,4],[2,4,1],[2,4,2] ,[2,4,3],[2,4,4],[3,1,1],[3,1,2],[3,1,3],[3,1,4],[3,2,1],[3,2,2],[3,2,3],[3,2,4] ,[3,3,1],[3,3,2],[3,3,3],[3,3,4],[3,4,1],[3,4,2],[3,4,3],[3,4,4],[4,1,1],[4,1,2] ,[4,1,3],[4,1,4],[4,2,1],[4,2,2],[4,2,3],[4,2,4],[4,3,1],[4,3,2],[4,3,3],[4,3,4] ,[4,4,1],[4,4,2],[4,4,3],[4,4,4]]
リストから n 個の要素を選ぶ組み合わせを求める関数 combination を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
combination :: Int -> [a] -> [[a]]
*Main> combination 3 [1,2,3,4,5] [[1,2,3],[1,2,4],[1,2,5],[1,3,4],[1,3,5],[1,4,5],[2,3,4],[2,3,5],[2,4,5],[3,4,5]]
リストから重複を許して n 個の要素を選ぶ組み合わせを求める関数 repeat_comb を定義してください。なお、生成した組み合わせはリストに格納して返すものとします。
repeat_comb :: Int -> [a] -> [[a]]
*Main> repeat_comb 2 [1,2,3] [[1,1],[1,2],[1,3],[2,2],[2,3],[3,3]] *Main> repeat_comb 2 [1,2,3,4] [[1,1],[1,2],[1,3],[1,4],[2,2],[2,3],[2,4],[3,3],[3,4],[4,4]]
リストを n 番目の要素で二分割する関数 split_at を定義してください。なお、Haskell には同じ働きをする関数 splitAt が用意されています。
split_at :: Int -> [a] -> ([a], [a])
*Main> split_at 3 [1..6] ([1,2,3],[4,5,6]) *Main> split_at 3 [1..6] ([1,2,3],[4,5,6]) *Main> split_at 6 [1..6] ([1,2,3,4,5,6],[]) *Main> split_at 0 [1..6] ([],[1,2,3,4,5,6])
リストの要素に述語 p を適用し、一つでも真を返す要素があれば真を返す関数 any と、一つでも偽を返す要素があれば偽を返す (全てが真の場合に真を返す) 関数 every を定義してください。なお、Haskell には同名の関数 any があるので、ここでは関数名を any' としました。また、every と同じ働きをする関数 all も用意されています。
any' :: (a -> Bool) -> [a] -> Bool every :: (a -> Bool) -> [a] -> Bool
*Main> any' even [1,2,3,5,7,9] True *Main> any' even [1,3,5,7,9] False *Main> every odd [1,3,5,7,9] True *Main> every odd [1,2,3,5,7,9] False
y と等しいリスト xs の要素を全て x に置換する関数 substitute x y xs と、述語 p が真を返す要素を全て x に置換する関数 substitute_if p x xs を定義してください。
substitute :: Eq a => a -> a -> [a] -> [a] substitute_if :: (a -> Bool) -> a -> [a] -> [a]
*Main> substitute 1 2 [1,2,3,1,2,3,1,2,3] [1,1,3,1,1,3,1,1,3] *Main> substitute_if even 0 [1,2,3,1,2,3,1,2,3] [1,0,3,1,0,3,1,0,3] *Main> substitute_if odd 0 [1,2,3,1,2,3,1,2,3] [0,2,0,0,2,0,0,2,0]
リスト xs の中で連続した等しい要素を部分リストにまとめる関数 pack を定義してください。なお、Haskell のモジュール Data.List には同じ働きをする関数 group が用意されています。
pack :: Eq a => [a] -> [[a]]
*Main> pack [1,1,1,2,3,3,4,4,4,4,5,5,5,5,5] [[1,1,1],[2],[3,3],[4,4,4,4],[5,5,5,5,5]]
整列済みの整数を表すリストで、連続している部分列を (start, end) に置き換える関数 pack_num_list を定義してください。start は部分列の始点、end は部分列の終点を表します。
pack_num_list :: [Integer] -> [(Integer, Integer)]
*Main> pack_num_list [1,2,3,4,6,8,9,11,13,14,15,16] [(1,4),(6,6),(8,9),(11,11),(13,16)]
なお、この問題は下記サイトを参考にさせていただきました。関係各位に感謝いたします。
問題 46 の逆変換を行う関数 expand_num_list を定義してください。
expand_num_list :: [(Integer, Integer)] -> [Integer]
*Main> expand_num_list [(1, 4), (6, 6), (8, 10)] [1,2,3,4,6,8,9,10]
連続している同じ記号を (code, num) に変換する関数 encode を定義してください。code は記号、num は個数を表します。このような変換を「ランレングス符号化」といいます。
encode :: Eq a => [a] -> [(a, Int)]
*Main> encode [1,1,1,1,2,2,3,4,4,4,4,5,1,1] [(1,4),(2,2),(3,1),(4,4),(5,1),(1,2)]
問題 48 の逆変換を行う関数 decode を定義してください。
decode :: Eq a => [(a, Int)] -> [a]
*Main> decode [(1,4),(2,2),(3,1),(4,4),(5,1),(1,2)] [1,1,1,1,2,2,3,4,4,4,4,5,1,1]
自然数 n 以下の素数をすべて求める関数 sieve を作ってください。
sieve :: Integer -> [Integer]
*Main> sieve 100 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97] *Main> sieve 500 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103, 107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211, 223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331, 337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449, 457,461,463,467,479,487,491,499]
リスト : リストの生成 make_list :: a -> Int -> [a] make_list x 0 = [] make_list x n = x : make_list x (n - 1) -- 別解 make_list' :: a -> Int -> [a] make_list' x n = take n $ repeat x
make_list は単純な再帰呼び出しで x を n 個格納したリストを生成します。別解は repeat x で無限リストを生成し、そこから n 個の要素を take で取り出します。
リスト : リストの生成 (2) tabulate :: (Int -> a) -> Int -> Int -> [a] tabulate f s e | s > e = [] | otherwise = f s : tabulate f (s + 1) e -- 別解 tabulate' :: (Int -> a) -> Int -> Int -> [a] tabulate' f s e = map f [s .. e]
tabulate は単純な再帰呼び出しでリストを生成します。別解は map でプログラムしたものです。
リスト : リストの要素を削除する remove :: Eq a => a -> [a] -> [a] remove _ [] = [] remove p (x:xs) | p == x = remove p xs | otherwise = x : remove p xs remove_if :: (a -> Bool) -> [a] -> [a] remove_if _ [] = [] remove_if p (x:xs) | p x = remove_if p xs | otherwise = x : remove_if p xs -- 別解 remove' :: Eq a => a -> [a] -> [a] remove' p xs = [x | x <- xs, p /= x] remove_if' :: (a -> Bool) -> [a] -> [a] remove_if' p xs = [x | x <- xs, not (p x)]
remove と remove_if も簡単です。remove は引数 p と等しい要素を、remove_if は述語 p が真となる要素をリストに追加しません。そのほかの要素をリストに追加します。別解はリスト内包表記を使ってプログラムしたものです。
リスト : マッピング map2 :: (a -> b -> c) -> [a] -> [b] -> [c] map2 f (x:xs) (y:ys) = f x y : map2 f xs ys map2 _ _ _ = [] -- 別解 map2' :: (a -> b -> c) -> [a] -> [b] -> [c] map2' f xs ys = map (uncurry f) $ zip xs ys
map2 は 2 つのリストの先頭要素 x, y を取り出し、f x y を呼び出してその返り値をリストに追加していくだけです。どちらかのリストが空リストになったときが再帰呼び出しの停止条件になります。別解は map と zip を使ったバージョンです。関数 f はカリー化関数ですが、zip を使うと引数がタプルになるので、uncurry で f の型を (a -> b -> c) から ((a, b) -> c) に変換しています。
リスト : 畳み込み foldl2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldl2 f acc (x:xs) (y:ys) = foldl2 f (f x y acc) xs ys foldl2 _ acc _ _ = acc foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 f acc (x:xs) (y:ys) = f x y $ foldr2 f acc xs ys foldr2 _ acc _ _ = acc
foldl2, foldr2 も簡単です。foldl2 は再帰呼び出しをするときに累積変数の値を関数 f で更新します。foldr2 は関数 f を呼び出すときに foldr2 を再帰呼び出しします。このとき、累積変数の値は更新しません。どちらかの引数が空リストになったときが再帰の停止条件です。
リスト : マッピング (2) maplist :: ([a] -> b) -> [a] -> [b] maplist _ [] = [] maplist f xs = f xs : maplist f (tail xs)
maplist も簡単です。関数 f に引数のリスト xs をそのまま渡すだけです。maplist を再帰呼び出しするときは、先頭の要素を取り除いたリスト (tail xs) を渡します。maplist を使うと map は次のように定義することができます。
リスト : map の定義 map' f xs = maplist (f . head) ls
リスト : 畳み込み (2) pair_foldl :: ([a] -> b -> b) -> b -> [a] -> b pair_foldl _ acc [] = acc pair_foldl f acc xs = pair_foldl f (f xs acc) (tail xs) pair_foldr :: ([a] -> b -> b) -> b -> [a] -> b pair_foldr _ acc [] = acc pair_foldr f acc xs = f xs $ pair_foldr f acc $ tail xs
pair_foldl と pair_foldr も簡単です。関数 f を呼び出すときリストの要素の代わりにリスト xs をそのまま渡すだけです。あとは普通の畳み込み foldl, foldr と同じです。
リスト : リストの平坦化
flatten :: [[a]] -> [a]
flatten [] = []
flatten (x:xs) = x ++ flatten xs
-- 別解
flatten' :: [[a]] -> [a]
flatten' xs = iter xs []
where
iter [] a = reverse a
iter (x:xs) a = iter xs (revAppend x a)
flatten はリストの先頭要素 x を取り出して、x と次の要素を演算子 ++ で結合すればいいわけです。別解は演算子 ++ を使わないで実装したものです。関数 revAppend は第 1 引数のリストを反転して第 2 引数のリストと連結します。動作は (rev xs) @ ys と同じですが、演算子 ++ を使わないで簡単に実装することができます。リスト x を反転して累積変数 a に連結するので、リスト a には要素が逆順にセットされます。最後に reverse a でリストを反転して返します。
ご参考までに関数 revAppend の実装例を示します。
リスト : リストを反転して連結する revAppend :: [a] -> [a] -> [a] revAppend [] ys = ys revAppend (x:xs) ys = revAppend xs (x:ys)
リスト : flatmap flatmap :: (a -> [b]) -> [a] -> [b] flatmap _ [] = [] flatmap f (x:xs) = f x ++ flatmap f xs -- 別解 flatmap' :: (a -> [b]) -> [a] -> [b] flatmap' f xs = flatten (map f xs)
flatmap はリストの要素 x に関数 f を適用するだけで、あとは flatten と同じです。別解でも同じ動作になりますが、map で余分なリストを生成するので、少しだけ効率が悪くなります。
リスト : 直積集合 product_set :: [a] -> [b] -> [(a, b)] product_set [] _ = [] product_set (x:xs) ys = (map (\y -> (x, y)) ys) ++ product_set xs ys -- 別解 product_set' :: [a] -> [b] -> [(a, b)] product_set' xs ys = [(x, y) | x <- xs, y <- ys]
product_set は map で x とリスト ys の要素 y の組を生成し、その結果と product_set xs ys の返り値を演算子 ++ で連結します。別解はリスト内包表記でプログラムしたものです。Haskell の場合、こちらの方が簡単ですね。
リスト : べき集合 power_set :: [a] -> [[a]] power_set [] = [[]] power_set (x:xs) = power_set xs ++ [x:ys | ys <- power_set xs] -- 別解 power_set' :: [a] -> [[a]] power_set' [] = [[]] power_set' (x:xs) = ys ++ map (x:) ys where ys = power_set' xs
べき集合を求める関数 power_set は簡単です。引数が空リストの場合は [ ] を格納したリストを返します。そうでなければ、引数を x:xs で分解します。 そして、power_set を再帰呼び出しして xs のべき集合を求め、その集合に先頭要素 x を追加します。そして、その集合と xs のべき集合を演算子 ++ で連結します。別解はリスト内包表記ではなく map を使ってプログラムしたものです。
リスト : データをひとつ挿入するパターンをすべて求める interleave :: a -> [a] -> [[a]] interleave x [] = [[x]] interleave x ks@(y:ys) = [x:ks] ++ map (y:) (interleave x ys) -- 別解 interleave' :: a -> [a] -> [[a]] interleave' x [] = [[x]] interleave' x ks@(y:ys) = [x:ks] ++ [y:zs | zs <- interleave' x ys]
interleave はリストの先頭に x を挿入する場合と、それ以外の場合に分けて考えます。先頭に追加するのは簡単ですね。それ以外の場合は、先頭要素を取り除いたリスト ys に x を挿入すればいいので、interleave を再帰呼び出しすることで求めることができます。そして、その返り値のリストに先頭要素 y を追加すればいいわけです。
プログラムは簡単です。引数のリストが空リストの場合は [[x]] を返します。そうでなければ、ks の先頭に x を追加したものと、interleave x ys の返り値に y を追加したものを演算子 ++ で連結して返します。別解は map のかわりにリスト内包表記でプログラムしたものです。
リスト : 順列の生成 permutation :: Eq a => Int -> [a] -> [[a]] permutation 0 _ = [[]] permutation n xs = [x:ys | x <- xs, ys <- permutation (n - 1) (remove x xs)]
関数 permutation は引数のリスト xs から n 個を選ぶ順列を生成し、それをリストに格納して返します。n = 0 が再帰の停止条件で、空リストを格納したリストを返します。このリストに対して要素を追加します。この処理はリスト内包表記を使うと簡単です。この中で permutation を再帰呼び出しをして、n - 1 個を選ぶ順列を生成します。そして、その返り値にリスト xs の要素 x を追加すれば、n 個を選ぶ順列を生成することができます。
リスト : 順列の生成 (2) permutation' :: [a] -> [[a]] permutation' [] = [[]] permutation' (x:xs) = flatmap (interleave x) (permutation' xs)
permutation' は簡単です。permutation' を再帰呼び出しして xs の順列を求め、順列を表す要素に interleave で x を挿入すればいいわけです。リストを平坦化するため flatmap を使っていることに注意してください。
リスト : 重複順列の生成 repeat_perm :: Int -> [a] -> [[a]] repeat_perm 0 _ = [[]] repeat_perm n xs = [x:ys | x <- xs, ys <- repeat_perm (n - 1) xs]
重複順列も簡単です。選んだ要素を取り除く必要がないので、repeat_perm を再帰呼び出しするとき、リスト xs をそのまま渡すだけです。
組み合わせの生成は、次に示す組み合わせの公式と同じ考え方でプログラムすることができます。
nＣ0 = nＣn = 1 nＣr = n-1Ｃr-1 + n-1Ｃr
プログラムは次のようになります。
リスト : 組み合わせの生成
combination :: Int -> [a] -> [[a]]
combination 0 _ = [[]]
combination _ [] = error "combination empty list"
combination n a@(x:xs)
| n == length a = [a]
| otherwise = [x:y | y <- ys1] ++ ys2
where
ys1 = combination (n - 1) xs
ys2 = combination n xs
最初の節は個数 n が 0 の場合です。選択する要素がないので空リストを格納したリストを返します。次の節で、選ぶ要素がなくなった場合はエラーを送出します。最後の節で、n とリスト a の要素数が同じ場合は、その要素を全て選択するのでリスト [a] を返します。
そうでなければ、先頭要素 x を選びます。残りのリスト xs から n - 1 個を選ぶ組み合わせを生成して、その先頭に x を追加します。あとは、xs から n 個を選ぶ組み合わせを combination で求めて、演算子 ++ で連結するだけです。
ところで、参考 URL には、もっと簡潔なプログラムが掲載されています。参考 URL よりプログラムを引用します。
リスト : 組み合わせの生成 (引用) comb :: [a] -> Int -> [[a]] comb _ 0 = [[]] comb [] _ = [] comb (x:xs) n = map (x:) (comb xs (n-1)) ++ comb xs n
引数のリストが空リストになったら、組み合わせを生成できないので空リストを返すところがポイントです。xs ++ [ ] や [ ] ++ xs は xs になるので、空リストを返しても正常に動作するわけです。とても参考になりました。山下伸夫さんに感謝いたします。
演算子 ++ を使わない場合は次のようになります。
リスト : 別解 combination' :: Int -> [a] -> [[a]] combination' n xs = comb n xs [] [] where comb 0 _ ys zs = reverse ys : zs comb _ [] _ zs = zs comb n (x:xs) ys zs = comb (n - 1) xs (x:ys) (comb n xs ys zs)
局所関数 comb は、第 3 引数のリストに要素を追加していき、生成した組み合わせを第 4 引数のリストに格納します。最初の節で、第 1 引数が 0 になったら組み合わせが一つ完成しました。reverse で ys を反転してから zs に追加して返します。comb を呼び出す場合、この返り値を第 3 引数に渡すことで、生成した順列を格納していくことができます。
次の節で、リストが空リストになったら組み合わせを生成できないので、今まで生成した組み合わせを格納したリスト zs をそのまま返します。最後の節で、x を選ばない組み合わせを comb n xs ys zs で生成し、その返り値を x を選ぶ組み合わせを求める comb の第 4 引数に渡します。これで生成した組み合わせをリストに格納することができます。
実行例を示します。
*Main> combination' 2 [1..5] [[1,2],[1,3],[1,4],[1,5],[2,3],[2,4],[2,5],[3,4],[3,5],[4,5]] *Main> combination' 3 [1..5] [[1,2,3],[1,2,4],[1,2,5],[1,3,4],[1,3,5],[1,4,5],[2,3,4],[2,3,5],[2,4,5],[3,4,5]]
リスト : 重複組み合わせの生成 repeat_comb :: Int -> [a] -> [[a]] repeat_comb 0 _ = [[]] repeat_comb _ [] = error "repeat_comb empty list" repeat_comb n [x] = [make_list x n] repeat_comb n a@(x:xs) = [x:y | y <- repeat_comb (n - 1) a] ++ repeat_comb n xs
重複組み合わせを求める repeat_comb も簡単です。3 番目の節で、リストに要素が一つしかない場合は、その要素 x を n 個選びます。make_list で x を n 個格納したリストを生成します。最後の節では、先頭要素 x を選んだあと、それを取り除かないで a から n - 1 個の要素を選びます。
リスト : リストの分割
split_at :: Int -> [a] -> ([a],[a])
split_at n xs = (take n xs, drop n xs)
-- 別解
split_at' :: Int -> [a] -> ([a],[a])
split_at' _ [] = ([], [])
split_at' n xs
| n <= 0 = ([], xs)
split_at' n (x:xs) = (x:a, b)
where (a, b) = split_at' (n - 1) xs
split_at は take と drop を使うと簡単です。take で先頭から n 個の要素を取り出し、drop で先頭から n 個の要素を取り除くだけです。別解は take, drop を使わずに再帰でプログラムしたものです。
リスト : any と every any' :: (a -> Bool) -> [a] -> Bool any' _ [] = False any1 p (x:xs) | p x = True | otherwise = any1 p xs every :: (a -> Bool) -> [a] -> Bool every _ [] = True every p (x:xs) | p x = every p xs | otherwise = False -- 別解 any'' :: (a -> Bool) -> [a] -> Bool any'' p xs = foldl (\a x -> p x || a) False xs every' :: (a -> Bool) -> [a] -> Bool every' p xs = foldl (\a x -> p x && a) True xs
any' と every は簡単です。リストを x と xs に分解して、p x が真を返す場合、any' は True を返します。逆に偽を返す場合、every は False を返します。それ以外の場合は再帰呼び出しして次の要素をチェックします。引数のリストが空リストになった場合、any' は False を返し、every は True を返します。別解は foldl を使ってプログラムしたものです。この場合、リストの要素をすべてチェックすることに注意してください。
リスト : リストの置換 substitute :: Eq a => a -> a -> [a] -> [a] substitute _ _ [] = [] substitute x y (z:zs) = (if y == z then x else z) : substitute x y zs substitute_if :: (a -> Bool) -> a -> [a] -> [a] substitute_if _ _ [] = [] substitute_if p x (z:zs) = (if p z then x else z) : substitute_if p x zs -- 別解 substitute' :: Eq a => a -> a -> [a] -> [a] substitute' x y zs = foldr (\z a -> (if y == z then x else z) : a) [] zs substitute_if' :: (a -> Bool) -> a -> [a] -> [a] substitute_if' p x zs = foldr (\z a -> (if p z then x else z) : a) [] zs
substitute はリストの要素 z が引数 y と等しい場合、その要素を引数 x に置き換えます。substitute_if は p z が真を返す場合、その要素を引数 x に置き換えます。そうでなければ、要素 y をそのままリストに追加します。別解は foldr を使ってプログラムしたものです。
リスト : 連続した同じデータを部分リストにまとめる
pack :: Eq a => [a] -> [[a]]
pack [] = error "pack empty list"
pack (x:xs) = iter xs [x] [] where
iter [] ys zs = reverse (ys:zs)
iter (x:xs) ys@(y:_) zs
| x == y = iter xs (x:ys) zs
| otherwise = iter xs [x] (ys:zs)
実際の処理は局所関数 iter で行います。引数 ys と zs は累積変数です。ys は連続したデータを格納するリストで、そのリストを zs に格納します。最初の節で、引数のリストが空リストの場合は ys を zs に格納し、そのリストを reverse で反転して返します。
最後の節で、リストを x と xs に、ys を y と _ に分解します。x と y が等しい場合は同じ記号が続いているので x を ys に追加します。そうでなければ、iter を再帰呼び出しして次の記号を調べます。このとき、ys を zs に追加して、x をリストに格納して第 2 引数に渡します。
リスト : 連続している数列を (s, e) で表す
pack_num_list :: [Integer] -> [(Integer,Integer)]
pack_num_list [] = error "pack_num_list empty list"
pack_num_list (x:xs) = iter xs [(x, x)] where
iter [] a = reverse a
iter (x:xs) a@((s, e):ys)
| x == e + 1 = iter xs ((s, x):ys)
| otherwise = iter xs ((x, x):a)
実際の処理は局所関数 iter で行います。引数 a を累積変数として使います。最初の節で引数が空リストの場合は a を反転して返します。最後の節で、リストを x と xs に、a を (s, e) と ys に分解します。x = e + 1 ならば x は連続した数字です。リスト a の (s, e) を (s, x) に置き換えます。そうでなければ、x は連続していないので、リスト a に (x, x) を追加します。あとは iter を再帰呼び出しして次の数字を調べます。
連続していない数字 x をタプル (x, x) ではなく数字だけで表す場合は、次のようにデータ型を定義する必要があります。
リスト : 別解
data PackNum = Int Integer | Pack Integer Integer
deriving Show
pack_num_list' :: [Integer] -> [PackNum]
pack_num_list' [] = error "pack_num_list' empty list"
pack_num_list' (x:xs) = iter xs [Int x] where
iter [] a = reverse a
iter (x:xs) a@(Int n : ys)
| x == n + 1 = iter xs (Pack n x : ys)
| otherwise = iter xs (Int x : a)
iter (x:xs) a@(Pack s e : ys)
| x == e + 1 = iter xs (Pack s x : ys)
| otherwise = iter xs (Int x : a)
PackNum はタプルと数値を表すデータ型です。pack_num_list' は [PackNum] を返します。実行例を示します。
*Main> pack_num_list' [1,2,3,4,6,8,9,11,13,14,15,16] [Pack 1 4,Int 6,Pack 8 9,Int 11,Pack 13 16]
リスト : (s, e) を数列に戻す expand_num_list :: [(Integer, Integer)] -> [Integer] expand_num_list [] = [] expand_num_list ((s, e):xs) = [s .. e] ++ expand_num_list xs -- 別解 expand_num_list' :: [PackNum] -> [Integer] expand_num_list' [] = [] expand_num_list' (Int x : xs) = x : expand_num_list' xs expand_num_list' (Pack s e : xs) = [s .. e] ++ expand_num_list' xs
expand_num_list は簡単です。最初の節が再帰の停止条件です。次の節で、(s, e) を [s .. e] で数列に変換します。expand_num_list を再帰呼び出しして残りのリスト xs を数列に戻し、その返り値に [s .. e] で変換したリストを演算子 ++ で連結します。
別解の expand_num_list' は [PackNum] を [Integer] に変換します。実行例を示します。
*Main> expand_num_list' [Pack 1 4, Int 6, Pack 8 10] [1,2,3,4,6,8,9,10]
リスト : ランレングス符号化
encode :: Eq a => [a] -> [(a, Int)]
encode xs = zip (map head ys) (map length ys)
where ys = pack xs
-- 別解
encode' :: Eq a => [a] -> [(a, Int)]
encode' [] = []
encode' (x:xs) = (x, n) : encode' ys where
(n, ys) = count_same_code x xs 1
count_same_code x [] c = (c, [])
count_same_code x (z:zs) c
| x == z = count_same_code x zs (c + 1)
| otherwise = (c, z:zs)
encode は pack を使うと簡単です。変数 ys は pack で連続しているコードをまとめたリストです。あとは、map head で先頭コードを取り出し、map length で個数を数え、2 つのリストを zip でまとめればいいわけです。別解は再帰呼び出しでプログラムしたものです。局所関数 count_same_code で連続している同じコードの個数をカウントします。返り値は個数と残りのリストです。
リスト : ランレングス復号 decode :: Eq a => [(a, Int)] -> [a] decode [] = [] decode ((x, n):xs) = make_list x n ++ decode xs
関数 decode は make_list を使うと簡単です。(x, n) を make_list でリストに展開して、その結果と decode xs の返り値を演算子 ++ で連結するだけです。
素数を求める基本的な考え方は簡単です。最初に、2 から n までの整数列を生成します。先頭の 2 は素数なので、この整数列から 2 で割り切れる整数を取り除き除きます。2 で割り切れる整数が取り除かれたので、残った要素の先頭が素数になります。先頭要素は 3 になるので、今度は 3 で割り切れる整数を取り除けばいいのです。このように、素数を見つけたらそれで割り切れる整数を取り除いていくアルゴリズムを「エラトステネスの篩 (ふるい) 」といいます。
プログラムは次のようになります。
リスト : 素数 (エラトステネスの篩)
sieve :: Integer -> [Integer]
sieve n = sieve_sub [3, 5 .. n] [2] where
sieve_sub [] ps = reverse ps
sieve_sub (x:xs) ps
| x * x < n = sieve_sub [y | y <- xs, y `mod` x /= 0] (x:ps)
| otherwise = reverse (revAppend xs (x:ps))
実際の処理は局所関数 sieve で行います。引数 ps は素数を格納するリストです。[3, 5, ..] で奇数列を生成し、それを sieve_sub に渡します。sieve_sub はリストの先頭要素 x が x * x < n のとき、 x で割り切れる要素をリスト内包表記で取り除き、sieve_sub を再帰呼び出しします。このとき、累積変数 ps に素数 x を追加します。そうでなければ、引数のリストには素数しかないので、x:ps とリスト xs を revAppend で連結して返します。