├── Answer ├── Chapter1.hs ├── Chapter3.hs ├── Chapter4.hs ├── Chapter5.hs └── Chapter6.hs ├── README.md ├── Src ├── Chapter1.hs ├── Chapter3.hs ├── Chapter4.hs ├── Chapter5.hs └── Chapter6.hs ├── Test ├── Chapter1.hs ├── Chapter3.hs ├── Chapter4.hs ├── Chapter5.hs ├── Chapter6.hs └── Util.hs ├── chapter1.md ├── chapter3.md ├── chapter4.md ├── chapter5.md └── chapter6.md /Answer/Chapter1.hs: -------------------------------------------------------------------------------- 1 | module Answer.Chapter1 2 | ( 3 | manlen 4 | , points 5 | , mancircle 6 | ) where 7 | 8 | -- (1) 9 | manlen :: (Int, Int) -> (Int, Int) -> Int 10 | manlen p1 p2 = abs(fst p1 - fst p2) + abs(snd p1 - snd p2) 11 | 12 | -- (2) 13 | points :: Int -> [(Int, Int)] 14 | points n = [(x,y) | x <- [-n .. n], y <- [-n .. n]] 15 | 16 | -- (3) 17 | mancircle :: Int -> [(Int, Int)] 18 | mancircle n = [p | p <- points n, manlen (0,0) p == n] 19 | -------------------------------------------------------------------------------- /Answer/Chapter3.hs: -------------------------------------------------------------------------------- 1 | module Answer.Chapter3 2 | ( 3 | tri_pattern 4 | , tri_guard 5 | , tri_case 6 | , qadd 7 | , qequal 8 | , qlist 9 | ) where 10 | 11 | -- (1.1) 12 | tri_pattern :: Int -> Int 13 | tri_pattern 0 = 0 14 | tri_pattern 1 = 0 15 | tri_pattern 2 = 1 16 | tri_pattern n = tri_pattern (n-1) + tri_pattern (n-2) + tri_pattern (n-3) 17 | 18 | -- (1.2) 19 | tri_guard :: Int -> Int 20 | tri_guard n 21 | | n == 0 = 0 22 | | n == 1 = 0 23 | | n == 2 = 1 24 | | otherwise = tri_guard (n-1) + tri_guard (n-2) + tri_guard (n-3) 25 | 26 | -- (1.3) 27 | tri_case :: Int -> Int 28 | tri_case n = case n of 29 | 0 -> 0 30 | 1 -> 0 31 | 2 -> 1 32 | _ -> tri_case (n-1) + tri_case (n-2) + tri_case (n-3) 33 | 34 | -- (2.1) 35 | qadd :: (Int, Int) -> (Int, Int) -> (Int, Int) 36 | qadd (_,0) (_,_) = error "second of tuple number is 0" 37 | qadd (_,_) (_,0) = error "second of tuple number is 0" 38 | qadd (a,b) (c,d) = (a * d + b * c, b * d) 39 | 40 | -- (2.2) 41 | qequal :: (Int, Int) -> (Int, Int) -> Bool 42 | qequal (_,0) (_,_) = error "second of tuple number is 0" 43 | qequal (_,_) (_,0) = error "second of tuple number is 0" 44 | qequal (a,b) (c,d) = a * d == b * c 45 | 46 | -- (2.3) 47 | qlist :: (Int, Int) -> [(Int, Int)] 48 | qlist (_,0) = error "second of tuple number is 0" 49 | qlist (a,b) | b < 0 = qlist (-a,-b) 50 | qlist (a,b) = 51 | let g = gcd a b 52 | a' = a `div` g 53 | b' = b `div` g 54 | in [(s * a' * n, s * b' * n) | n <- [1..], s <- [1,-1]] 55 | -------------------------------------------------------------------------------- /Answer/Chapter4.hs: -------------------------------------------------------------------------------- 1 | module Answer.Chapter4 2 | ( 3 | tri_number 4 | , tetration 5 | , index 6 | , even_odd 7 | , insert 8 | , isort 9 | , part_num 10 | ) where 11 | 12 | -- (1.1) 13 | tri_number :: Int -> Int 14 | tri_number 0 = 0 15 | tri_number n = n + tri_number (n-1) 16 | 17 | -- (1.2) 18 | tetration :: Integer -> Integer -> Integer 19 | tetration _ 0 = 1 20 | tetration x n = x^(tetration x (n-1)) 21 | 22 | -- (1.3) 23 | index :: Int -> [a] -> a 24 | index _ [] = error "index outbounded" 25 | index 0 (x:_) = x 26 | index n (_:xs) = index (n-1) xs 27 | 28 | -- (1.4) 29 | even_odd :: [Int] -> ([Int], [Int]) 30 | even_odd [] = ([], []) 31 | even_odd (x:xs) 32 | | x `mod` 2 == 0 = (odds, x:evens) 33 | | otherwise = (x:odds, evens) 34 | where (odds, evens) = even_odd xs 35 | 36 | -- (2.1) 37 | insert :: Ord a => [a] -> a -> [a] 38 | insert [] y = [y] 39 | insert xs@(x:_) y | y < x = y:xs 40 | insert (x:xs) y = x:(insert xs y) 41 | 42 | -- (2.2) 43 | isort :: Ord a => [a] -> [a] 44 | isort [] = [] 45 | isort (x:xs) = insert (isort xs) x 46 | 47 | --- (3) 48 | part_num :: Int -> Int 49 | part_num n = part_num' n 1 50 | where part_num' n m 51 | | n == m = 1 52 | | n < m = 0 53 | | otherwise = part_num' (n-m) m + part_num' n (m+1) 54 | -------------------------------------------------------------------------------- /Answer/Chapter5.hs: -------------------------------------------------------------------------------- 1 | module Answer.Chapter5 2 | ( 3 | applyPair 4 | , applyN 5 | , squares 6 | , fromBinary 7 | , tails 8 | , powerSet 9 | , pointed1 10 | , pointFree1 11 | , pointed2 12 | , pointFree2 13 | , pointed3 14 | , pointFree3 15 | , pointed4 16 | , pointFree4 17 | , pointed5 18 | , pointFree5 19 | , church 20 | , unchurch 21 | , csucc 22 | , cadd 23 | , cmul 24 | , cpred 25 | , cTrue 26 | , cFalse 27 | , churchb 28 | , unchurchb 29 | , cnot 30 | , cand 31 | , cor 32 | , cif 33 | , cis0 34 | , ceven 35 | , cevennot0 36 | , clte2 37 | ) where 38 | 39 | -- (1.1) 40 | applyPair :: (a -> b) -> (a, a) -> (b, b) 41 | applyPair f (x,y) = (f x, f y) 42 | 43 | -- (1.2) 44 | applyN :: (a -> a) -> Int -> a -> a 45 | applyN _ 0 = id 46 | applyN f n = (f.) $ applyN f $ n - 1 47 | 48 | -- (1.3) 49 | squares :: Int -> [Int] 50 | squares n = takeWhile (<= n) $ map (^2) [1..] 51 | 52 | -- (2.1) 53 | fromBinary :: [Int] -> Int 54 | fromBinary = foldl ((+) . (*2)) 0 55 | 56 | -- (2.2) 57 | tails :: [a] -> [[a]] 58 | tails = scanr (:) [] 59 | 60 | -- (2.3) 61 | powerSet :: [a] -> [[a]] 62 | powerSet = foldr (\x acc -> map (x:) acc ++ acc) [[]] 63 | 64 | -- (3.1) 65 | pointed1 :: [Int] -> [Int] 66 | pointed1 xs = map negate (map (+10) (filter (>0) xs)) 67 | 68 | pointFree1 :: [Int] -> [Int] 69 | pointFree1 = map (negate . (+10)) . filter (>0) 70 | 71 | -- (3.2) 72 | pointed2 :: [[Int]] -> [Int] 73 | pointed2 xss = scanl (+) 0 (map (foldl (*) 1) (filter (\xs -> length xs >= 2) xss)) 74 | 75 | pointFree2 :: [[Int]] -> [Int] 76 | pointFree2 = scanl (+) 0 . map (foldl (*) 1) . filter ((>=2) . length) 77 | 78 | -- (3.3) 79 | pointed3 :: [a -> a] -> a -> a 80 | pointed3 fs x = foldl (\x f -> f x) x fs 81 | 82 | pointFree3 :: [a -> a] -> a -> a 83 | pointFree3 = flip $ foldl $ flip ($) 84 | 85 | -- (3.4) 86 | pointed4 :: (a -> [b]) -> [a] -> [b] 87 | pointed4 f xs = concat (map f xs) 88 | 89 | pointFree4 :: (a -> [b]) -> [a] -> [b] 90 | pointFree4 = (concat.) . map 91 | 92 | -- (3.5) 93 | pointed5 :: (Int -> [Int]) -> [Int] -> [Int] 94 | pointed5 f xs = foldl (\ys g -> g ys) xs (replicate 3 (\zs -> concat (map f zs))) 95 | 96 | pointFree5 :: (Int -> [Int]) -> [Int] -> [Int] 97 | pointFree5 = (flip $ foldl $ flip ($)) . replicate 3 . ((concat.) . map) 98 | 99 | -- (4.1.1) 100 | church 0 _ z = z 101 | church n f z = f $ church (n-1) f z 102 | 103 | -- (4.1.2) 104 | unchurch c = c (+1) 0 105 | 106 | -- (4.1.3) 107 | csucc c f z = f $ c f z 108 | 109 | -- (4.1.4) 110 | cadd c1 c2 f z = c1 f (c2 f z) 111 | 112 | -- (4.1.5) 113 | cmul c1 c2 f z = c1 (c2 f) z 114 | 115 | -- (4.1.6) 116 | cpred c f z = c (\g h -> h (g f)) (\u -> z) (\u -> u) 117 | 118 | -- (4.2 pre-defined) 119 | cTrue :: t -> t -> t 120 | cTrue = \t f -> t 121 | 122 | cFalse :: t -> t -> t 123 | cFalse = \t f -> f 124 | 125 | -- (4.2.1) 126 | churchb True = cTrue 127 | churchb False = cFalse 128 | 129 | -- (4.2.2) 130 | unchurchb cb = cb True False 131 | 132 | -- (4.2.3) 133 | cnot cb = cb cFalse cTrue 134 | 135 | -- (4.2.4) 136 | cand cb1 cb2 = cb1 cb2 cFalse 137 | 138 | -- (4.2.5) 139 | cor cb1 cb2 = cb1 cTrue cb2 140 | 141 | -- (4.3 pre-defined) 142 | cif :: (Bool -> Bool -> Bool) -> t -> t -> t 143 | cif cb t f = if unchurchb cb then t else f 144 | 145 | -- (4.3.1) 146 | cand' cb1 cb2 = cif cb1 cb2 cFalse 147 | cis0 c = c (cand' cFalse) cTrue 148 | 149 | -- (4.3.2) 150 | cnot' cb = cif cb cFalse cTrue 151 | ceven c = c cnot' cTrue 152 | 153 | -- (4.3.3) 154 | cevennot0 c = ceven c `cand'` (cnot' $ cis0 c) 155 | 156 | -- (4.3.4) 157 | clte2 c = cis0 $ cpred $ cpred c 158 | -------------------------------------------------------------------------------- /Answer/Chapter6.hs: -------------------------------------------------------------------------------- 1 | module Answer.Chapter6 2 | ( 3 | sortByFrequency 4 | , initialMap 5 | , infixPalindromicNumber 6 | , vernam 7 | ) where 8 | import Data.Ord 9 | import Data.List 10 | import qualified Data.Map as Map 11 | import Data.Char 12 | import Data.Bits 13 | 14 | -- (1.1) 15 | sortByFrequency :: Ord a => [a] -> [a] 16 | sortByFrequency = map head . sortBy (comparing $ Down . length) . group . sort 17 | 18 | -- (1.2) 19 | initialMap :: [String] -> Map.Map Char [String] 20 | initialMap = Map.fromListWith (++) . map (\s -> (head s, [s])) . filter (not . null) 21 | 22 | -- (1.3) 23 | infixPalindromicNumber :: Int -> Int 24 | infixPalindromicNumber n = head [m | m <- [0..], let m' = show m, reverse m' == m', show n `isInfixOf` m'] 25 | 26 | -- (2) 27 | vernam :: String -> String -> String 28 | vernam k s = map chr $ zipWith xor (map ord $ cycle k) (map ord s) 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | すごいHaskell楽しく演習！ 2 | ================= 3 | 4 | 「すごいHaskell楽しく学ぼう！」の自作章末演習問題です。 5 | 社内勉強会のために作っているものを公開します。 6 | 7 | 章番号については、オーム社から出ている日本語訳版と対応しています。([Amazon](http://amzn.to/1uS2ja1)) 8 | 原文をオンラインで読むことが出来ますが、こちらは章番号がずれていますのでご注意ください。([英語サイト](http://learnyouahaskell.com/chapters)) 9 | 10 | ## 章リンク 11 | 12 | - [第1章 はじめの第一歩](https://github.com/kokuyouwind/haskell-exercises/blob/master/chapter1.md) 13 | - 第2章 型を信じろ!(演習なし) 14 | - [第3章 関数の構文](https://github.com/kokuyouwind/haskell-exercises/blob/master/chapter3.md) 15 | - [第4章 Hello再帰!](https://github.com/kokuyouwind/haskell-exercises/blob/master/chapter4.md) 16 | - [第5章 高階関数](https://github.com/kokuyouwind/haskell-exercises/blob/master/chapter5.md) 17 | - [第6章 モジュール](https://github.com/kokuyouwind/haskell-exercises/blob/master/chapter6.md) 18 | - 第7章 型や型クラスを自分で作ろう 19 | - 第8章 入出力 20 | - 第9章 もっと入力、もっと出力 21 | - 第10章 関数型問題解決法 22 | - 第11章 ファンクターからアプリティカティブファンクターへ 23 | - 第12章 モノイド 24 | - 第13章 モナドがいっぱい 25 | - 第14章 もうちょっとだけモナド 26 | 27 | ## ディレクトリ構成 28 | 29 | - `Src` : 問題を解くためのテンプレートが格納されています。こちらのファイルを直接編集してください。 30 | - `Answer` : 解答が格納されています。どうしても解けない場合に参照してください。 31 | - `Test` : 自分の解答が正しいかを格納するための自動テストが格納されています。 32 | 33 | ## テスト方法 34 | 35 | テストには`QuickCheck`を利用しているため、`QuickCheck`をインストールしてください。`cabal`コマンドが使える場合には、 36 | ```shell 37 | $ cabal install QuickCheck 38 | ``` 39 | でインストールできます。 40 | 41 | 章ごとの問題を全てテスト時には、`ghci`をプロジェクトルートで起動した後、該当のテストファイルを読み込み、`test`を実行します。 42 | また、特定の関数のみテストする場合には、同様にテストファイルを読み込んだ後、`test_(関数名)`を実行します。 43 | 例えば、第1章のテストを実行する場合は以下のようになります。 44 | ```haskell 45 | > :l Test/Chapter1.hs 46 | > test -- 第1章のテストを全て実行 47 | === prop_manlen from Test/Chapter1.hs:7 === 48 | *** Failed! Exception: 'Prelude.undefined' (after 1 test): 49 | ((0,0),(0,0)) 50 | 51 | === prop_points from Test/Chapter1.hs:10 === 52 | *** Failed! Exception: 'Prelude.undefined' (after 1 test): 53 | 0 54 | 55 | === prop_mancircle from Test/Chapter1.hs:13 === 56 | *** Failed! Exception: 'Prelude.undefined' (after 1 test): 57 | 0 58 | 59 | False 60 | > test_manlen -- manlen関数のテストのみ実行 61 | *** Failed! Exception: 'Prelude.undefined' (after 1 test): 62 | ``` 63 | 64 | なお`:l Test/Chapter1.hs`を実行した後に`:e Src/ChapterX.hs`で回答を編集した場合、最新の回答でテストが実行されます。 65 | このため、問題を解く際には以下のようなワークフローをおすすめします。 66 | ```haskell 67 | > :l Test/Chapter1.hs -- 初めにテストファイルを読み込む 68 | Ok, modules loaded: Src.Chapter1, Answer.Chapter1, Main. 69 | > test_manlen -- これから実装する関数のテストが失敗することを確認する 70 | *** Failed! Exception: 'Prelude.undefined' (after 1 test): 71 | ((0,0),(0,0)) 72 | > :e Src/Chapter1.hs -- 問題を解く 73 | > test_manlen -- 再度テストを実行し、成功するか確認する 74 | +++ OK, passed 100 tests. 75 | ``` 76 | -------------------------------------------------------------------------------- /Src/Chapter1.hs: -------------------------------------------------------------------------------- 1 | module Src.Chapter1 2 | ( 3 | manlen 4 | , points 5 | , mancircle 6 | ) where 7 | 8 | -- (1) 9 | manlen :: (Int, Int) -> (Int, Int) -> Int 10 | manlen p1 p2 = undefined {- Rewrite HERE! -} 11 | 12 | -- (2) 13 | points :: Int -> [(Int, Int)] 14 | points n = undefined {- Rewrite HERE! -} 15 | 16 | -- (3) 17 | mancircle :: Int -> [(Int, Int)] 18 | mancircle n = undefined {- Rewrite HERE! -} 19 | -------------------------------------------------------------------------------- /Src/Chapter3.hs: -------------------------------------------------------------------------------- 1 | module Src.Chapter3 2 | ( 3 | tri_pattern 4 | , tri_guard 5 | , tri_case 6 | , qadd 7 | , qequal 8 | , qlist 9 | ) where 10 | 11 | -- (1.1) 12 | tri_pattern :: Int -> Int 13 | tri_pattern n = undefined {- Rewrite HERE! -} 14 | 15 | -- (1.2) 16 | tri_guard :: Int -> Int 17 | tri_guard n = undefined {- Rewrite HERE! -} 18 | 19 | -- (1.3) 20 | tri_case :: Int -> Int 21 | tri_case n = undefined {- Rewrite HERE! -} 22 | 23 | -- (2.1) 24 | qadd :: (Int, Int) -> (Int, Int) -> (Int, Int) 25 | qadd q1 q2 = undefined {- Rewrite HERE! -} 26 | 27 | -- (2.2) 28 | qequal :: (Int, Int) -> (Int, Int) -> Bool 29 | qequal q1 q2 = undefined {- Rewrite HERE! -} 30 | 31 | -- (2.3) 32 | qlist :: (Int, Int) -> [(Int, Int)] 33 | qlist q = undefined {- Rewrite HERE! -} 34 | -------------------------------------------------------------------------------- /Src/Chapter4.hs: -------------------------------------------------------------------------------- 1 | module Src.Chapter4 2 | ( 3 | tri_number 4 | , tetration 5 | , index 6 | , even_odd 7 | , insert 8 | , isort 9 | , part_num 10 | ) where 11 | 12 | -- (1.1) 13 | tri_number :: Int -> Int 14 | tri_number n = undefined {- Rewrite HERE! -} 15 | 16 | -- (1.2) 17 | tetration :: Integer -> Integer -> Integer 18 | tetration x n = undefined {- Rewrite HERE! -} 19 | 20 | -- (1.3) 21 | index :: Int -> [a] -> a 22 | index n (x:_) = undefined {- Rewrite HERE! -} 23 | 24 | -- (1.4) 25 | even_odd :: [Int] -> ([Int], [Int]) 26 | even_odd [] = undefined {- Rewrite HERE! -} 27 | 28 | -- (2.1) 29 | insert :: Ord a => [a] -> a -> [a] 30 | insert [] y = undefined {- Rewrite HERE! -} 31 | 32 | -- (2.2) 33 | isort :: Ord a => [a] -> [a] 34 | isort [] = undefined {- Rewrite HERE! -} 35 | 36 | --- (3) 37 | part_num :: Int -> Int 38 | part_num n = undefined {- Rewrite HERE! -} 39 | -------------------------------------------------------------------------------- /Src/Chapter5.hs: -------------------------------------------------------------------------------- 1 | module Src.Chapter5 2 | ( 3 | applyPair 4 | , applyN 5 | , squares 6 | , fromBinary 7 | , tails 8 | , powerSet 9 | , pointed1 10 | , pointFree1 11 | , pointed2 12 | , pointFree2 13 | , pointed3 14 | , pointFree3 15 | , pointed4 16 | , pointFree4 17 | , pointed5 18 | , pointFree5 19 | , church 20 | , unchurch 21 | , csucc 22 | , cadd 23 | , cmul 24 | , cpred 25 | , cTrue 26 | , cFalse 27 | , churchb 28 | , unchurchb 29 | , cnot 30 | , cand 31 | , cor 32 | , cif 33 | , cis0 34 | , ceven 35 | , cevennot0 36 | , clte2 37 | ) where 38 | 39 | -- (1.1) 40 | applyPair :: (a -> b) -> (a, a) -> (b, b) 41 | applyPair f (x,y) = undefined {- Rewrite HERE! -} 42 | 43 | -- (1.2) 44 | applyN :: (a -> a) -> Int -> a -> a 45 | applyN f n = undefined {- Rewrite HERE! -} 46 | 47 | -- (1.3) 48 | squares :: Int -> [Int] 49 | squares n = undefined {- Rewrite HERE! -} 50 | 51 | -- (2.1) 52 | fromBinary :: [Int] -> Int 53 | fromBinary xs = undefined {- Rewrite HERE! -} 54 | 55 | -- (2.2) 56 | tails :: [a] -> [[a]] 57 | tails xs = undefined {- Rewrite HERE! -} 58 | 59 | -- (2.3) 60 | powerSet :: [a] -> [[a]] 61 | powerSet xs = undefined {- Rewrite HERE! -} 62 | 63 | -- (3.1) 64 | pointed1 :: [Int] -> [Int] 65 | pointed1 xs = map negate (map (+10) (filter (>0) xs)) 66 | 67 | pointFree1 :: [Int] -> [Int] 68 | pointFree1 = undefined {- Rewrite HERE! -} 69 | 70 | -- (3.2) 71 | pointed2 :: [[Int]] -> [Int] 72 | pointed2 xss = scanl (+) 0 (map (foldl (*) 1) (filter (\xs -> length xs >= 2) xss)) 73 | 74 | pointFree2 :: [[Int]] -> [Int] 75 | pointFree2 = undefined {- Rewrite HERE! -} 76 | 77 | -- (3.3) 78 | pointed3 :: [a -> a] -> a -> a 79 | pointed3 fs x = foldl (\x f -> f x) x fs 80 | 81 | pointFree3 :: [a -> a] -> a -> a 82 | pointFree3 = undefined {- Rewrite HERE! -} 83 | 84 | -- (3.4) 85 | pointed4 :: (a -> [b]) -> [a] -> [b] 86 | pointed4 f xs = concat (map f xs) 87 | 88 | pointFree4 :: (a -> [b]) -> [a] -> [b] 89 | pointFree4 = undefined {- Rewrite HERE! -} 90 | 91 | -- (3.5) 92 | pointed5 :: (Int -> [Int]) -> [Int] -> [Int] 93 | pointed5 f xs = foldl (\ys g -> g ys) xs (replicate 3 (\zs -> concat (map f zs))) 94 | 95 | pointFree5 :: (Int -> [Int]) -> [Int] -> [Int] 96 | pointFree5 = undefined {- Rewrite HERE! -} 97 | 98 | -- (4.1.1) 99 | church n f z = undefined {- Rewrite HERE! -} 100 | 101 | -- (4.1.2) 102 | unchurch c = undefined {- Rewrite HERE! -} 103 | 104 | -- (4.1.3) 105 | csucc c f z = undefined {- Rewrite HERE! -} 106 | 107 | -- (4.1.4) 108 | cadd c1 c2 f z = undefined {- Rewrite HERE! -} 109 | 110 | -- (4.1.5) 111 | cmul c1 c2 f z = undefined {- Rewrite HERE! -} 112 | 113 | -- (4.1.6) 114 | cpred c f z = undefined {- Rewrite HERE! -} 115 | 116 | -- (4.2 pre-defined) 117 | cTrue :: t -> t -> t 118 | cTrue = \t f -> t 119 | 120 | cFalse :: t -> t -> t 121 | cFalse = \t f -> f 122 | 123 | -- (4.2.1) 124 | churchb b = undefined {- Rewrite HERE! -} 125 | 126 | -- (4.2.2) 127 | unchurchb cb = undefined {- Rewrite HERE! -} 128 | 129 | -- (4.2.3) 130 | cnot cb = undefined {- Rewrite HERE! -} 131 | 132 | -- (4.2.4) 133 | cand cb1 cb2 = undefined {- Rewrite HERE! -} 134 | 135 | -- (4.2.5) 136 | cor cb1 cb2 = undefined {- Rewrite HERE! -} 137 | 138 | -- (4.3 pre-defined) 139 | cif :: (Bool -> Bool -> Bool) -> t -> t -> t 140 | cif cb t f = if unchurchb cb then t else f 141 | 142 | -- (4.3.1) 143 | cis0 c = undefined {- Rewrite HERE! -} 144 | 145 | -- (4.3.2) 146 | ceven c = undefined {- Rewrite HERE! -} 147 | 148 | -- (4.3.3) 149 | cevennot0 c = undefined {- Rewrite HERE! -} 150 | 151 | -- (4.3.4) 152 | clte2 c = undefined {- Rewrite HERE! -} 153 | -------------------------------------------------------------------------------- /Src/Chapter6.hs: -------------------------------------------------------------------------------- 1 | module Src.Chapter6 2 | ( 3 | sortByFrequency 4 | , initialMap 5 | , infixPalindromicNumber 6 | , vernam 7 | ) where 8 | import Data.Ord 9 | import Data.List 10 | import qualified Data.Map as Map 11 | import Data.Char 12 | import Data.Bits 13 | 14 | -- (1.1) 15 | sortByFrequency :: Ord a => [a] -> [a] 16 | sortByFrequency xs = undefined {- Rewrite HERE! -} 17 | 18 | -- (1.2) 19 | initialMap :: [String] -> Map.Map Char [String] 20 | initialMap ss = undefined {- Rewrite HERE! -} 21 | 22 | -- (1.3) 23 | infixPalindromicNumber :: Int -> Int 24 | infixPalindromicNumber n = undefined {- Rewrite HERE! -} 25 | 26 | -- (2) 27 | vernam :: String -> String -> String 28 | vernam k s = undefined {- Rewrite HERE! -} 29 | -------------------------------------------------------------------------------- /Test/Chapter1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.Util 4 | import Test.QuickCheck 5 | import qualified Src.Chapter1 as Src 6 | import qualified Answer.Chapter1 as Ans 7 | 8 | prop_manlen (p1, p2) = Src.manlen p1 p2 == Ans.manlen p1 p2 9 | test_manlen = quickCheck prop_manlen 10 | 11 | prop_points n = Src.points n `listeq` Ans.points n 12 | test_points = quickCheck prop_points 13 | 14 | prop_mancircle n = Src.mancircle n `listeq` Ans.mancircle n 15 | test_mancircle = quickCheck prop_mancircle 16 | 17 | test = $quickCheckAll 18 | -------------------------------------------------------------------------------- /Test/Chapter3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.Util 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Monadic 6 | import Data.Function 7 | import Data.Functor 8 | import qualified Src.Chapter3 as Src 9 | import qualified Answer.Chapter3 as Ans 10 | 11 | prop_tri_pattern (NonNegative n) = Src.tri_pattern n' == Ans.tri_pattern n' 12 | where n' = n `mod` 20 13 | test_tri_pattern = quickCheck prop_tri_pattern 14 | 15 | prop_tri_guard (NonNegative n) = Src.tri_guard n' == Ans.tri_guard n' 16 | where n' = n `mod` 20 17 | test_tri_guard = quickCheck prop_tri_guard 18 | 19 | prop_tri_case (NonNegative n) = Src.tri_case n' == Ans.tri_case n' 20 | where n' = n `mod` 20 21 | test_tri_case = quickCheck prop_tri_case 22 | 23 | qnorm :: (Int, Int) -> (Int, Int) 24 | qnorm (a,0) = (a,0) 25 | qnorm (a,b) | b < 0 = qnorm (-a,-b) 26 | qnorm (a,b) = (a `div` g, b `div` g) 27 | where g = gcd a b 28 | 29 | qeq :: Maybe (Int, Int) -> Maybe (Int, Int) -> Bool 30 | qeq = (==) `on` fmap qnorm 31 | 32 | prop_qadd q1 q2 = monadicIO $ do 33 | res1 <- run $ tryEval $ Src.qadd q1 q2 34 | res2 <- run $ tryEval $ Ans.qadd q1 q2 35 | assert $ res1 `qeq` res2 36 | test_qadd = quickCheck prop_qadd 37 | 38 | prop_qequal q1 q2 = monadicIO $ do 39 | res1 <- run $ tryEval $ Src.qequal q1 q2 40 | res2 <- run $ tryEval $ Ans.qequal q1 q2 41 | assert $ res1 == res2 42 | test_qequal = quickCheck prop_qequal 43 | 44 | prop_qlist q n = monadicIO $ do 45 | res1 <- run $ tryEval $ take n $ Src.qlist q 46 | res2 <- run $ tryEval $ take n $ Ans.qlist q 47 | assert $ res1 == res2 48 | test_qlist = quickCheck prop_qlist 49 | 50 | test = $quickCheckAll 51 | -------------------------------------------------------------------------------- /Test/Chapter4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.Util 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Monadic 6 | import qualified Src.Chapter4 as Src 7 | import qualified Answer.Chapter4 as Ans 8 | 9 | prop_tri_number (NonNegative n) = Src.tri_number n == Ans.tri_number n 10 | test_tri_number = quickCheck prop_tri_number 11 | 12 | prop_tetration (NonNegative n) (NonNegative m) = Src.tetration n' m' == Ans.tetration n' m' 13 | where n' = n `mod` 5 14 | m' = m `mod` 4 15 | test_tetration = quickCheck prop_tetration 16 | 17 | prop_index (NonNegative n) (SafeString xs) = monadicIO $ do 18 | res1 <- run $ tryEval $ Src.index n xs 19 | res2 <- run $ tryEval $ Ans.index n xs 20 | assert $ res1 == res2 21 | test_index = quickCheck prop_index 22 | 23 | prop_even_odd xs = Src.even_odd xs == Ans.even_odd xs 24 | where types = xs::[Int] 25 | test_even_odd = quickCheck prop_even_odd 26 | 27 | prop_insert (Ordered xs) x = Src.insert xs x == Ans.insert xs x 28 | where types = (xs::[Int], x::Int) 29 | test_insert = quickCheck prop_insert 30 | 31 | prop_isort xs = Src.isort xs == Ans.isort xs 32 | where types = xs::[Int] 33 | test_isort = quickCheck prop_isort 34 | 35 | prop_part_num (Positive n) = Src.part_num n' == Ans.part_num n' 36 | where n' = n `mod` 30 37 | test_part_num = quickCheck prop_part_num 38 | 39 | test = $quickCheckAll 40 | -------------------------------------------------------------------------------- /Test/Chapter5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.Util 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Monadic 6 | import Data.List 7 | import Data.Function 8 | import qualified Src.Chapter5 as Src 9 | import qualified Answer.Chapter5 as Ans 10 | 11 | prop_applyPair (Blind n) (Blind m) t = Src.applyPair f t == Ans.applyPair f t 12 | where types = t::(Int,Int) 13 | f x = x * n + m 14 | test_applyPair = quickCheck prop_applyPair 15 | 16 | prop_applyN (Blind (NonZero p)) (NonNegative n) m = Src.applyN f n m == Ans.applyN f n m 17 | where types = (n::Int, m::Int) 18 | f x = (x + 1) `mod` p 19 | test_applyN = quickCheck prop_applyN 20 | 21 | prop_squares (NonNegative n) = Src.squares n == Ans.squares n 22 | test_squares = quickCheck prop_squares 23 | 24 | prop_fromBinary (NonNegative n) = Src.fromBinary bs == Ans.fromBinary bs 25 | where bs = reverse . unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 2 , b `div` 2)) $ n 26 | test_fromBinary = quickCheck prop_fromBinary 27 | 28 | prop_tails (SafeString s) = Src.tails s `listeq` Ans.tails s 29 | test_tails = quickCheck prop_tails 30 | 31 | prop_powerSet (SafeString s) = Src.powerSet s' `listeq` Ans.powerSet s' 32 | where s' = take 10 s 33 | test_powerSet = quickCheck prop_powerSet 34 | 35 | prop_pointFree1 xs = Src.pointFree1 xs == Ans.pointFree1 xs 36 | where types = xs::[Int] 37 | test_pointFree1 = quickCheck prop_pointFree1 38 | 39 | prop_pointFree2 xss = Src.pointFree2 xss == Ans.pointFree2 xss 40 | where types = xss::[[Int]] 41 | test_pointFree2 = quickCheck prop_pointFree2 42 | 43 | prop_pointFree3 (Blind (NonNegative n)) m = Src.pointFree3 fs m == Ans.pointFree3 fs m 44 | where types = m::Int 45 | fs = map (+) $ take n $ [1..] 46 | test_pointFree3 = quickCheck prop_pointFree3 47 | 48 | prop_pointFree4 (Blind (NonNegative n)) xs = Src.pointFree4 f xs == Ans.pointFree4 f xs 49 | where types = xs::[Int] 50 | f x = take n [x..] 51 | test_pointFree4 = quickCheck prop_pointFree4 52 | 53 | prop_pointFree5 (Blind n) xs = Src.pointFree5 f xs == Ans.pointFree5 f xs 54 | where types = xs::[Int] 55 | f x = [x, x+n] 56 | test_pointFree5 = quickCheck prop_pointFree5 57 | 58 | ceq :: ((Int -> Int) -> Int -> Int) -> ((Int -> Int) -> Int -> Int) -> Bool 59 | ceq = (==) `on` Ans.unchurch 60 | 61 | beq :: (Bool -> Bool -> Bool) -> (Bool -> Bool -> Bool) -> Bool 62 | beq = (==) `on` Ans.unchurchb 63 | 64 | prop_church (NonNegative n) = Src.church n `ceq` Ans.church n 65 | where types = n::Int 66 | test_church = quickCheck prop_church 67 | 68 | prop_unchurch (NonNegative n) = Src.unchurch n' == Ans.unchurch n' 69 | where types = n::Int 70 | n' = Ans.church n 71 | test_unchurch = quickCheck prop_unchurch 72 | 73 | prop_csucc (NonNegative n) = Src.csucc n' `ceq` Ans.csucc n' 74 | where types = n::Int 75 | n' = Ans.church n 76 | test_csucc = quickCheck prop_csucc 77 | 78 | prop_cadd (NonNegative n) (NonNegative m) = Src.cadd n' m' `ceq` Ans.cadd n' m' 79 | where types = (n::Int, m::Int) 80 | n' = Ans.church n 81 | m' = Ans.church m 82 | test_cadd = quickCheck prop_cadd 83 | 84 | prop_cmul (NonNegative n) (NonNegative m) = Src.cmul n' m' `ceq` Ans.cmul n' m' 85 | where types = (n::Int, m::Int) 86 | n' = Ans.church n 87 | m' = Ans.church m 88 | test_cmul = quickCheck prop_cmul 89 | 90 | prop_cpred (NonNegative n) = Src.cpred n' `ceq` Ans.cpred n' 91 | where types = n::Int 92 | n' = Ans.church n 93 | test_cpred = quickCheck prop_cpred 94 | 95 | prop_churchb b = Src.churchb b `beq` Ans.churchb b 96 | where types = b::Bool 97 | test_churchb = quickCheck prop_churchb 98 | 99 | prop_unchurchb b = Src.unchurchb b' == Ans.unchurchb b' 100 | where types = b::Bool 101 | b' = Ans.churchb b 102 | test_unchurchb = quickCheck prop_unchurchb 103 | 104 | prop_cnot b = Src.cnot b' `beq` Ans.cnot b' 105 | where types = b::Bool 106 | b' = Ans.churchb b 107 | test_cnot = quickCheck prop_cnot 108 | 109 | prop_cand b1 b2 = Src.cand b1' b2' `beq` Ans.cand b1' b2' 110 | where types = (b1::Bool, b2::Bool) 111 | b1' = Ans.churchb b1 112 | b2' = Ans.churchb b2 113 | test_cand = quickCheck prop_cand 114 | 115 | prop_cor b1 b2 = Src.cor b1' b2' `beq` Ans.cor b1' b2' 116 | where types = (b1::Bool, b2::Bool) 117 | b1' = Ans.churchb b1 118 | b2' = Ans.churchb b2 119 | test_cor = quickCheck prop_cor 120 | 121 | prop_cis0 (NonNegative n) = Src.cis0 n' `beq` Ans.cis0 n' 122 | where types = n::Int 123 | n' = Ans.church n 124 | test_cis0 = quickCheck prop_cis0 125 | 126 | prop_ceven (NonNegative n) = Src.ceven n' `beq` Ans.ceven n' 127 | where types = n::Int 128 | n' = Ans.church n 129 | test_ceven = quickCheck prop_ceven 130 | 131 | prop_cevennot0 (NonNegative n) = Src.cevennot0 n' `beq` Ans.cevennot0 n' 132 | where types = n::Int 133 | n' = Ans.church n 134 | test_cevennot0 = quickCheck prop_cevennot0 135 | 136 | prop_clte2 (NonNegative n) = Src.clte2 n' `beq` Ans.clte2 n' 137 | where types = n::Int 138 | n' = Ans.church n 139 | test_clte2 = quickCheck prop_clte2 140 | 141 | test = $quickCheckAll 142 | -------------------------------------------------------------------------------- /Test/Chapter6.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.Util 4 | import Test.QuickCheck 5 | import Test.QuickCheck.Modifiers 6 | import Data.Function 7 | import Data.List(sort) 8 | import qualified Data.Map as Map 9 | import qualified Src.Chapter6 as Src 10 | import qualified Answer.Chapter6 as Ans 11 | 12 | prop_sortByFrequency (SafeString xs) = Src.sortByFrequency xs == Ans.sortByFrequency xs 13 | test_sortByFrequency = quickCheck prop_sortByFrequency 14 | 15 | prop_initialMap xss = Src.initialMap xss' `mapEq` Ans.initialMap xss' 16 | where types = xss::([SafeString]) 17 | xss' = map unwrapSafeString xss 18 | mapEq = (==) `on` Map.map sort 19 | test_initialMap = quickCheck prop_initialMap 20 | 21 | prop_infixPalindromicNumber (NonNegative n) = Src.infixPalindromicNumber n == Ans.infixPalindromicNumber n 22 | test_infixPalindromicNumber = quickCheck prop_infixPalindromicNumber 23 | 24 | prop_vernam (SafeString k) (SafeString s) = (not . null) k ==> Src.vernam k s == Ans.vernam k s 25 | test_vernam = quickCheck prop_vernam 26 | 27 | test = $quickCheckAll 28 | -------------------------------------------------------------------------------- /Test/Util.hs: -------------------------------------------------------------------------------- 1 | module Test.Util 2 | ( 3 | listeq 4 | , tryEval 5 | , SafeString(..) 6 | ) where 7 | import Test.QuickCheck 8 | import Data.Function(on) 9 | import Data.List(sort) 10 | import Data.Functor 11 | import Control.Exception hiding (assert) 12 | 13 | listeq :: Ord a => [a] -> [a] -> Bool 14 | listeq = (==) `on` sort 15 | 16 | eitherToMaybe :: Either a b -> Maybe b 17 | eitherToMaybe (Right x) = Just x 18 | eitherToMaybe (Left _) = Nothing 19 | 20 | tryEval' :: a -> IO (Either SomeException a) 21 | tryEval' = try . evaluate 22 | 23 | tryEval :: a -> IO (Maybe a) 24 | tryEval = fmap eitherToMaybe . tryEval' 25 | 26 | genSafeChar :: Gen Char 27 | genSafeChar = elements ['a'..'z'] 28 | 29 | genSafeString :: Gen String 30 | genSafeString = listOf genSafeChar 31 | 32 | newtype SafeString = SafeString { unwrapSafeString :: String } 33 | deriving Show 34 | instance Arbitrary SafeString where 35 | arbitrary = SafeString <$> genSafeString 36 | -------------------------------------------------------------------------------- /chapter1.md: -------------------------------------------------------------------------------- 1 | #1. マンハッタン距離 2 | 3 | 2つの整数のペアを受け取り、その2点のマンハッタン距離を返す関数`manlen`を定義せよ。 4 | ただし、`p1 = (a,b)`と`p2 = (c,d)`のマンハッタン距離`manlen(p1, p2)`は次式で定義される。 5 | ```haskell 6 | manlen(p1, p2) = |a - c| + |b - d| 7 | ``` 8 | なお、`|x|`は`x`の絶対値である。 9 | Haskellでは組み込み関数`abs`があり、これを用いて良い。 10 | 11 | ```haskell 12 | manlen :: (Int, Int) -> (Int, Int) -> Int 13 | 14 | *Main> abs 1 15 | 1 16 | *Main> abs (-1) 17 | 1 18 | *Main> manlen (0,0) (1,1) -- x方向での距離1, y方向での距離1 19 | 2 20 | *Main> manlen (-1,1) (1,3) -- x方向での距離2, y方向での距離2 21 | 4 22 | ``` 23 | 24 | #2. 整数座標のリスト 25 | 非負整数を受け取り、2数それぞれの絶対値がその数以内であるような整数のペアをリストで返す関数`points`を定義せよ。 26 | 例として、1が与えられた時には`[(x,y) | x ∈ {-1, 0, 1}, y ∈ {-1, 0, 1}] `のような集合になる。(`x`と`y`それぞれの絶対値が1以下となる全ての整数のペア) 27 | なお、負数が与えられた場合の挙動は考慮しなくて良い。 28 | 29 | ```haskell 30 | points :: Int -> [(Int, Int)] 31 | 32 | *Main> points 0 33 | [(0,0)] 34 | *Main> points 1 35 | [(-1,-1),(-1,0),(-1,1),(0,-1),(0,0),(0,1),(1,-1),(1,0),(1,1)] 36 | ``` 37 | 38 | #3. タクシー幾何学における円 39 | 非負整数を受け取り、原点`(0,0)`からのマンハッタン距離がその数であるような整数のペアをリストで返す関数`mancircle`を定義せよ。 40 | なお、負数が与えられた場合の挙動は考慮しなくて良い。 41 | 42 | ```haskell 43 | mancircle :: Int -> [(Int, Int)] 44 | 45 | *Main> mancircle 0 46 | [(0,0)] 47 | *Main> mancircle 1 48 | [(-1,0),(0,-1),(0,1),(1,0)] 49 | *Main> mancircle 2 50 | [(-2,0),(-1,-1),(-1,1),(0,-2),(0,2),(1,-1),(1,1),(2,0)] 51 | ``` 52 | 53 | # 参考 54 | ユークリッド幾何学ではユークリッド距離√(dx^2 + dy^2)を用いるが、この代わりにマンハッタン距離dx+dyを用いた幾何学をタクシー幾何学という。 55 | 円を「原点から等距離にある点の集合」と定義した場合、タクシー幾何学に於ける円は一般的な意味での菱型(より正確には正方形)を成す。 56 | http://ja.wikipedia.org/wiki/%E3%83%9E%E3%83%B3%E3%83%8F%E3%83%83%E3%82%BF%E3%83%B3%E8%B7%9D%E9%9B%A2 57 | -------------------------------------------------------------------------------- /chapter3.md: -------------------------------------------------------------------------------- 1 | #1. トリボナッチ数列 2 | ### トリボナッチ数列の定義 3 | 以下のような数列を考える。 4 | - 最初の2つの数字は`0` 5 | - 3つめの数字は`1` 6 | - 4つめ以降の数字は、直前の3つの数の和 7 | 8 | このような数列をトリボナッチ数列という。 9 | 例として、最初の10項は 10 | ``` 11 | 0, 0, 1, 1, 2, 4, 7, 13, 24, 44 12 | ``` 13 | となる。 14 | 15 | ### 問 16 | トリボナッチ数列のn番目の数を計算する関数を、以下の名前と方法で定義せよ。 17 | 1. `tri_pattern` : パターンマッチを用いる 18 | 2. `tri_guard` : ガードを用いる 19 | 3. `tri_case` : case式を用いる。 20 | 21 | ただし一番最初の数を0番目とする。 22 | また負数を与えた場合の挙動は考慮しなくて良い。 23 | 24 | ### 例 25 | ```haskell 26 | *Main> :t tri_pattern 27 | tri_pattern :: Int -> Int 28 | *Main> take 10 [tri_pattern n | n <- [0..]] 29 | [0,0,1,1,2,4,7,13,24,44] 30 | 31 | *Main> :t tri_guard 32 | tri_guard :: Int -> Int 33 | *Main> take 10 [tri_guard n | n <- [0..]] 34 | [0,0,1,1,2,4,7,13,24,44] 35 | 36 | *Main> :t tri_case 37 | tri_case :: Int -> Int 38 | *Main> take 10 [tri_case n | n <- [0..]] 39 | [0,0,1,1,2,4,7,13,24,44] 40 | ``` 41 | 42 | #2. タプル数 43 | ### タプル数の定義 44 | 有理数を、分子と分母を表す整数の二つ組で表すことにする。 45 | 以下、この表現による数をタプル数と呼ぶことにする[註1]。 46 | 例えば、2/5は`(2,5)`のようにタプル数で表現できる。 47 | 48 | 以下に注意すべき点を挙げる。 49 | - 分子、分母ともに負数を許す。2/5は`(2,5)`とも`(-2,-5)`とも表現できる。 50 | - 既約でない表現を許す。2/5は`(4,10)`とも`(20,50)`とも表現できる。 51 | - 分母が`0`であるタプル数は存在しない。このようなタプル数に対して関数を適用した場合、実行時例外とする。 52 | 53 | ### 問 54 | 以下の関数を定義せよ。なお、オーバーフローが起こるような、極端に大きな数を与えた際の挙動は考慮しなくて良い。 55 | 1. `qadd` : 2つのタプル数を受け取り、その和を返す関数(既約でなくても良い) 56 | 2. `qequal` : 2つのタプル数を受け取り、有理数としての値が等しいかの真偽値を返す関数 57 | 3. `qlist` : 1つのタプル数を受け取り、そのタプル数と等しいすべてのタプル数をリストで返す関数 58 | 　 ただし、順序は分母の絶対値の小さい順とし、絶対値が同じ場合は分母が正の物が先になるようにする。 59 | 　 Haskellには最大公約数を求める関数`gcd`があり、これを用いて良い。 60 | 61 | ### 例 62 | ```haskell 63 | *Main> :t qadd 64 | qadd :: (Int, Int) -> (Int, Int) -> (Int, Int) 65 | *Main> qadd (1,2) (3,4) 66 | (10,8) 67 | *Main> qadd (1,1) (-2,-5) 68 | (-7,-5) 69 | *Main> qadd (1,1) (-2,0) 70 | *** Exception: second of tuple number is 0 71 | 72 | *Main> :t qequal 73 | qequal :: (Int, Int) -> (Int, Int) -> Bool 74 | *Main> qequal (1,2) (-2,-4) 75 | True 76 | *Main> qequal (1,3) (-2,-4) 77 | False 78 | *Main> qequal (1,0) (-2,-4) 79 | *** Exception: second of tuple number is 0 80 | 81 | *Main> :t qlist 82 | qlist :: (Int, Int) -> [(Int, Int)] 83 | *Main> take 10 (qlist (4,6)) 84 | [(2,3),(-2,-3),(4,6),(-4,-6),(6,9),(-6,-9),(8,12),(-8,-12),(10,15),(-10,-15)] 85 | *Main> take 10 (qlist (3,-5)) 86 | [(-3,5),(3,-5),(-6,10),(6,-10),(-9,15),(9,-15),(-12,20),(12,-20),(-15,25),(15,-25)] 87 | *Main> take 10 (qlist (1,0)) 88 | *** Exception: second of tuple number is 0 89 | ``` 90 | 91 | ※註1. タプル数は便宜上定義した語であり、一般的な用語ではない。 92 | -------------------------------------------------------------------------------- /chapter4.md: -------------------------------------------------------------------------------- 1 | #1. 基本的な再帰 2 | 次の関数群を、再帰を用いて定義せよ。 3 | なお非負整数を受け取る関数については、非負整数を受け取った場合の挙動を考慮しなくて良い。 4 | 5 | 1. `tri_number` : 非負整数`n`を受け取り、`0`から`n`までの総和を求める関数(これを **三角数** という) 6 | 2. `tetration` : 整数`n`と非負整数`m`を受け取り、`n`のべき乗を`m`回繰り返した値を求める関数(これを **テトレーション** という) 7 | 例えば、`tetration 2 4`は`2^2^2^2`を計算する 8 | なお、`^`は右結合の演算子である(`tetration 2 4 = 2^(2^(2^2)) = 65536`) 9 | 3. `index` : 非負整数`n`とリスト`xs`を受け取り、`xs`の`n`番目の要素を返す関数 10 | ただし、先頭要素を0番目とし、範囲外の場合はエラーとすること 11 | 4. `even_odd` : 整数のリスト`xs`を受け取り、奇数の要素のリストと偶数の要素のリストのペアを返す関数 12 | ただし、要素間の順序は保持すること 13 | 14 | ###例 15 | ```haskell 16 | *Main> :t tri_number 17 | tri_number :: Int -> Int 18 | *Main> take 10 [tri_number n | n <- [1..]] 19 | [1,3,6,10,15,21,28,36,45,55] 20 | 21 | *Main> -- 非常に大きな数になるためIntegerを用いる 22 | *Main> :t tetration 23 | tetration :: Integer -> Integer -> Integer 24 | *Main> take 5 [tetration 2 n | n <- [0..]] 25 | [1,2,4,16,65536] 26 | *Main> take 4 [tetration 3 n | n <- [0..]] 27 | [1,3,27,7625597484987] 28 | *Main> -- tetration 2 5 や tetration 3 4 は非常に大きな数になるため注意せよ 29 | 30 | *Main> :t index 31 | index :: Int -> [a] -> a 32 | *Main> index 0 [2,4,6,8,10] 33 | 2 34 | *Main> index 2 [2,4,6,8,10] 35 | 6 36 | *Main> index 5 [2,4,6,8,10] 37 | *** Exception: index outbounded 38 | 39 | *Main> :t even_odd 40 | even_odd :: [Int] -> ([Int], [Int]) 41 | *Main> even_odd [2,8,1,4,5,3,9,6] 42 | ([1,5,3,9],[2,8,4,6]) 43 | ``` 44 | 45 | #2. 挿入ソート 46 | ### 挿入ソートの定義 47 | 整列済みのリスト`xs`に、新しい値`x`を追加することを考えよう。 48 | このとき、`xs`の適切な位置に`x`を挿入することで、新たなリストも整列済みであるようにすることができる。 49 | 例えば、`[1,3,4,6]`に`2`を挿入する場合、`1`と`3`の間に挿入すれば、`[1,2,3,4,6]`という新たな整列済みのリストを得ることが出来る。 50 | 51 | ところで、空のリストは整列済みであるとみなすことが出来る。 52 | このため、空リストに繰り返し「適切な挿入」を繰り返すことで、整列済みのリストを得ることが出来る。 53 | 例えば、`[4,2,3,1]`という未ソートのリストがあった場合、以下の手順でソート済みのリストを得る。 54 | - `[]`に`4`を挿入して、`[4]`を得る 55 | - `[4]`に`2`を挿入して、`[2,4]`を得る 56 | - `[2,4]`に`3`を挿入して、`[2,3,4]`を得る 57 | - `[2,3,4]`に`1`を挿入して、`[1,2,3,4]`を得る 58 | 59 | このようなソートアルゴリズムを **挿入ソート** と呼ぶ。 60 | 61 | ### 問 62 | 以下の関数を、再帰を用いて定義せよ。 63 | 1. `insert` : 整列済みリストと挿入する値を受け取り、要素を挿入した整列済みリストを返す関数 64 | 2. `isort` : リストを受け取り、`insert`を用いた挿入ソートを行い整列済みリストを返す関数 65 | 66 | ### 例 67 | ```haskell 68 | *Main> :t insert 69 | insert :: Ord a => [a] -> a -> [a] 70 | *Main> insert [1,3,5] 4 71 | [1,3,4,5] 72 | *Main> insert [1,3,5] 0 73 | [0,1,3,5] 74 | *Main> insert [1,3,5] 6 75 | [1,3,5,6] 76 | 77 | *Main> :t isort 78 | isort :: Ord a => [a] -> [a] 79 | *Main> isort [4,2,3,1,5] 80 | [1,2,3,4,5] 81 | ``` 82 | 83 | #3. 分割数 84 | *難易度の高いトピックである* 85 | ### 分割数の定義 86 | 正整数を、重複を許す正整数の和で表すことを考える。 87 | 例えば`4`は 88 | - `1+1+1+1` 89 | - `2+1+1` 90 | - `3+1` 91 | - `2+2` 92 | - `4` 93 | 94 | の5通りの表現がある。(順序の違いは無視する。例えば`1+3`のようなパターンは`3+1`に含まれる) 95 | 96 | 正整数`n`について、このように重複を許す正整数の和で表したものを`n`の **分割** と呼び、分割の種類数を`n`の **分割数** と呼ぶ。 97 | 例えば`4`は先ほど挙げた通り5通りの分割があるため、`4`の分割数は`5`である。 98 | 99 | ### 問 100 | 次の関数を定義せよ。 101 | ただし、ゼロ及び負数を受け取った場合の挙動は考慮しなくて良い。 102 | - `part_num` : 正整数を受け取り、その数の分割数を返す関数 103 | 104 | ### 例 105 | ```haskell 106 | *Main> :t part_num 107 | part_num :: Int -> Int 108 | *Main> take 10 [part_num n | n <- [1..]] 109 | [1,2,3,5,7,11,15,22,30,42] 110 | ``` 111 | 112 | ### ヒント 113 | 2つの正整数`n`と`m`を受け取り、`m`以上の数のみを使った`n`の分割の種類を返すような補助関数`part_num'`を定義するとよい。 114 | このとき、「`m`を少なくとも一つ用いる」か、「`m`を一つも用いないか」に着目し再帰を適用せよ。 115 | 例えば4の分割のうち、1を含むものは 116 | - `1+1+1+1` 117 | - `2+1+1` 118 | - `3+1` 119 | 120 | の3種類、1を含まないものは 121 | - `2+2` 122 | - `4` 123 | 124 | の2種類である。 125 | 1から5程度までのそれぞれの数について、その分割を列挙し、これらの間にある関係を考察せよ。 126 | 127 | ### 参考 128 | 分割数は上述の通り単純に構成される数であるが、その一般項は非常に複雑になる。 129 | 参考 : http://ameblo.jp/interesting-math/entry-10811088826.html 130 | 131 | 分割数についての分析の話題は「[数学ガール](http://amzn.to/1qzTUS6)」第10章が詳しい。 132 | ただし当該章では母関数なども扱うため、前章を通して読むことが望ましい。 133 | -------------------------------------------------------------------------------- /chapter5.md: -------------------------------------------------------------------------------- 1 | #1. 基本的な高階関数 2 | 次の関数群を定義せよ。 3 | なお非負整数を受け取る関数については、負数を受け取った場合の挙動を考慮しなくて良い。 4 | 5 | 1. `applyPair` : 関数`f`を受け取り、ペア(2-Tuple)を受け取って両方の要素に`f`を適用する関数を返す関数 6 | 2. `applyN` : 関数`f`と非負整数`n`を受け取り、`x`を受け取って`f`を`x`に`n`回適用する関数を返す関数 7 | 3. `squares` : 非負整数`n`を受け取り、`n`以下の全ての平方数を昇順にリストで返す関数 8 | 9 | ### 例 10 | ```haskell 11 | *Main> :t applyPair 12 | applyPair :: (a -> b) -> (a, a) -> (b, b) 13 | *Main> applyPair (*2) (10, 20) 14 | (20,40) 15 | 16 | *Main> :t applyN 17 | applyN :: (a -> a) -> Int -> a -> a 18 | *Main> applyN (1:) 3 [] 19 | [1,1,1] 20 | 21 | *Main> :t squares 22 | squares :: Int -> [Int] 23 | *Main> squares 50 24 | [1,4,9,16,25,36,49] 25 | ``` 26 | 27 | #2. 畳み込み 28 | 以下の関数群を*再帰を用いずに*定義せよ。 29 | 30 | 1. `fromBinary` : `0`か`1`のみからなるリスト`xs`を受け取り、`xs`を2進数表現と解釈した場合の10進数値を返す関数 31 | 2. `tails` : リスト`xs`を受け取り、`xs`の全ての末尾部分リストを返す関数 32 | 3. `powerSet` : リスト`xs`を受け取り、`xs`のべき集合を返す関数 33 | 34 | ### 例 35 | ```haskell 36 | *Main> :t fromBinary 37 | fromBinary :: [Int] -> Int 38 | *Main> fromBinary [1,0,1,0] 39 | 10 40 | 41 | *Main> :t tails 42 | tails :: [a] -> [[a]] 43 | *Main> tails [1,2,3] 44 | [[1,2,3],[2,3],[3],[]] 45 | 46 | *Main> :t powerSet 47 | powerSet :: [a] -> [[a]] 48 | *Main> powerSet [1,2,3] 49 | [[1,2,3],[1,2],[1,3],[1],[2,3],[2],[3],[]] 50 | ``` 51 | 52 | #3. ポイントフリースタイル 53 | 以下の関数群をポイントフリースタイルで定義せよ。 54 | なお、ラムダ式も用いてはならない。 55 | 56 | ```haskell 57 | -- (1) pointFree1という名前でポイントフリースタイルで再定義せよ 58 | pointed1 :: [Int] -> [Int] 59 | pointed1 xs = map negate (map (+10) (filter (>0) xs)) 60 | 61 | -- (2) pointFree2という名前でポイントフリースタイルで再定義せよ 62 | pointed2 :: [[Int]] -> [Int] 63 | pointed2 xss = scanl (+) 0 (map (foldl (*) 1) (filter (\xs -> length xs >= 2) xss)) 64 | 65 | -- (3) pointFree3という名前でポイントフリースタイルで再定義せよ 66 | -- ヒント:flip及び($)を用いよ 67 | pointed3 :: [a -> a] -> a -> a 68 | pointed3 fs x = foldl (\x f -> f x) x fs 69 | 70 | -- (4) pointFree3という名前でポイントフリースタイルで再定義せよ 71 | -- ヒント:(.)をセクションで用いよ 72 | pointed4 :: (a -> [b]) -> [a] -> [b] 73 | pointed4 f xs = concat (map f xs) 74 | 75 | -- (5) pointFree5という名前でポイントフリースタイルで再定義せよ 76 | pointed5 :: (Int -> [Int]) -> [Int] -> [Int] 77 | pointed5 f xs = foldl (\ys g -> g ys) xs (replicate 3 (\zs -> concat (map f zs))) 78 | ``` 79 | 80 | ### 例 81 | ```haskell 82 | *Main> pointed1 [0,10,20] 83 | [-20,-30] 84 | *Main> pointFree1 [0,10,20] 85 | [-20,-30] 86 | 87 | *Main> pointed2 [[1,2],[3],[4,5],[6]] 88 | [0,2,22] 89 | *Main> pointFree2 [[1,2],[3],[4,5],[6]] 90 | [0,2,22] 91 | 92 | *Main> pointed3 [(1+), (*2), (+5)] 10 93 | 27 94 | *Main> pointFree3 [(1+), (*2), (+5)] 10 95 | 27 96 | 97 | *Main> pointed4 (\x -> [x, x+1]) [1,10] 98 | [1,2,10,11] 99 | *Main> pointFree4 (\x -> [x, x+1]) [1,10] 100 | [1,2,10,11] 101 | 102 | *Main> pointed5 (\x -> [x,x*2]) [1,10] 103 | [1,2,2,4,2,4,4,8,10,20,20,40,20,40,40,80] 104 | *Main> pointFree5 (\x -> [x,x*2]) [1,10] 105 | [1,2,2,4,2,4,4,8,10,20,20,40,20,40,40,80] 106 | ``` 107 | 108 | #4. ラムダ計算 109 | *難易度の高いトピックである* 110 | **ラムダ計算**は、関数を値とし、関数の適用のみを定義した計算モデルである。 111 | 以下では形式的な定義を扱わず、問題を通して*関数の適用のみで計算が成立する*ことを示す。 112 | 113 | ## 4.1 チャーチ数 114 | ### チャーチ数の定義 115 | 116 | 非負整数`n`に対して、「関数`f`と値`z`を受け取り、`f`を`z`に`n`回適用するような関数」を考える。 117 | 例として、最初のいくつかの非負整数と、それに対応する関数を挙げていくと、 118 | - 0 : `\f z -> z` 119 | - 1 : `\f z -> f z` 120 | - 2 : `\f z -> f (f z)` 121 | - 3 : `\f z -> f (f (f z))` 122 | 123 | のようになる。 124 | ここで、異なる数に対する関数は、明らかに互いに異なる。 125 | また、ある数とそれに対応する関数は、相互に変換が可能である。 126 | そこで、非負整数`n`と、それに対応する関数を同一視することにする。 127 | このように関数を用いて非負整数を表現したものを**チャーチ数**という。 128 | 129 | ### 問 130 | 以下の関数を定義せよ。 131 | ただし、3～6については*組み込みの数値演算子を用いず、関数適用のみを用いて定義する*こと。 132 | なお非負整数を受け取る関数については、負数を受け取った場合の挙動を考慮しなくて良い。 133 | 134 | 1. `church` : 非負整数`n`を受け取り、対応するチャーチ数を返す関数 135 | 2. `unchurch` : チャーチ数`c`を受け取り、対応する非負整数を返す関数 136 | 3. `csucc` : チャーチ数`c`を受け取り、それより1大きいチャーチ数を返す関数 137 | 4. `cadd` : チャーチ数`c1`、`c2'`を受け取り、`c1`と`c2`を加算したチャーチ数を返す関数 138 | 5. `cmul` : チャーチ数`c1`、`c2'`を受け取り、`c1`と`c2`を乗算したチャーチ数を返す関数 139 | 6. `cpred` : チャーチ数`c`を受け取り、それより1小さいチャーチ数を返す関数 140 | ただし、0より小さくなる場合には0を返す 141 | ヒント:`\g h -> h (g f)`というラムダ式を用いよ 142 | この式を`F`としたとき、`F(F a)`は`\h -> h (f (a f))`に簡約される 143 | また`F(F(F a))`は`\h -> h (f (f (a f)))`に簡約される 144 | 145 | ### 例 146 | ```haskell 147 | *Main> church 5 (1:) [] 148 | [1,1,1,1,1] 149 | *Main> unchurch $ church 5 150 | 5 151 | *Main> unchurch $ csucc $ church 5 152 | 6 153 | *Main> unchurch $ church 3 `cadd` church 2 154 | 5 155 | *Main> unchurch $ church 3 `cmul` church 2 156 | 6 157 | *Main> unchurch $ cpred $ church 0 158 | 0 159 | *Main> unchurch $ cpred $ church 1 160 | 0 161 | *Main> unchurch $ cpred $ church 2 162 | 1 163 | *Main> unchurch $ cpred $ church 5 164 | 4 165 | ``` 166 | 167 | ## 4.2 チャーチ真理値 168 | ### チャーチ真理値の定義 169 | 170 | チャーチ数と同様、真理値も関数を用いて表す事ができる。 171 | - `True` : `\t f -> t` 172 | - `False` : `\t f -> f` 173 | 174 | このように関数を用いて真理値を表現したものを**チャーチ真理値**という。 175 | 端的に言って、`True`に対応するチャーチ真理値は2つの値を受け取り1つめの値を返す関数、`False`に対応するチャーチ真理値は2つの値を受け取り2つめの値を返す関数である。 176 | 177 | ### 問 178 | 以下の関数を定義せよ。 179 | ただし、3～5については*組み込みの論理演算子やif式などを用いず、関数適用のみを用いて定義する*こと。 180 | なお、次のようにチャーチ真理値をあらかじめ定義しておくと良い。 181 | ```haskell 182 | cTrue :: t -> t -> t 183 | cTrue = \t f -> t 184 | 185 | cFalse :: t -> t -> t 186 | cFalse = \t f -> f 187 | ``` 188 | 189 | 1. `churchb` : 真理値`b`を受け取り、対応するチャーチ真理値を返す関数 190 | 2. `unchurchb` : チャーチ真理値`cb`を受け取り、対応する真理値を返す関数 191 | 3. `cnot` : チャーチ真理値`cb`を受け取り、その否定を返す関数 192 | 4. `cand` : チャーチ真理値`cb1`、`cb2`を受け取り、その論理積を返す関数 193 | 5. `cor` : チャーチ真理値`cb1`、`cb2`を受け取り、その論理和を返す関数 194 | 195 | ### 例 196 | ```haskell 197 | *Main> unchurchb $ churchb True 198 | True 199 | *Main> unchurchb $ churchb False 200 | False 201 | 202 | *Main> unchurchb $ cnot cTrue 203 | False 204 | *Main> unchurchb $ cnot cFalse 205 | True 206 | 207 | *Main> unchurchb $ cTrue `cand` cTrue 208 | True 209 | *Main> unchurchb $ cFalse `cand` cTrue 210 | False 211 | *Main> unchurchb $ cTrue `cand` cFalse 212 | False 213 | *Main> unchurchb $ cFalse `cand` cFalse 214 | False 215 | 216 | *Main> unchurchb $ cTrue `cor` cTrue 217 | True 218 | *Main> unchurchb $ cFalse `cor` cTrue 219 | True 220 | *Main> unchurchb $ cTrue `cor` cFalse 221 | True 222 | *Main> unchurchb $ cFalse `cor` cFalse 223 | False 224 | ``` 225 | 226 | ## 4.3 ラムダ計算と型付け 227 | ### 導入 228 | 以下のような、ブール真理値`cb`を受け取り、それと同じ値を返す関数`cid`を考える。 229 | ```haskell 230 | cid cb = cb cTrue cFalse 231 | ``` 232 | 右辺を見ると、`cb`が`cTrue`の時は第一引数である`cTrue`が返され、`cFalse`の時は第二引数である`cFalse`が返されることが分かる。 233 | 実際、この関数は以下のとおり想定通りに動作する。 234 | ```haskell 235 | *Main> unchurchb $ cid cTrue 236 | True 237 | *Main> unchurchb $ cid cFalse 238 | False 239 | ``` 240 | `cid`の型について考えよう。 241 | チャーチ真理値の型は`t -> t -> t`であり、`cid`はチャーチ真理値を受け取りチャーチ真理値を返す。 242 | よって、`cid`全体の型は`(t -> t -> t) -> (t -> t -> t)`であることが期待されるであろう。 243 | しかしながら、この型を指定して`cid`を定義するとコンパイルエラーが起こる。 244 | 型を指定せずに定義した場合、Haskellは以下のような型を推論する。 245 | ```haskell 246 | *Main> :t cid 247 | cid :: ((t1 -> t1 -> t1) -> (t2 -> t2 -> t2) -> t) -> t 248 | ``` 249 | これはどういうことだろうか？ 250 | ここで、`cid`の式中に表れる`cb`の型を`a -> b -> t`としてみよう。 251 | 上述の通り、`cTrue`の型は`t1 -> t1 -> t1`、`cFalse`の型は`t2 -> t2 -> t2`として定義されていることを考えると、明らかに`a`は`t1 -> t1 -> t1`、`b`は`t2 -> t2 -> t2`と等しくなければならない。 252 | つまり`cb`の型は`(t1 -> t1 -> t1) -> (t2 -> t2 -> t2) -> t`でなければならず、よって`cid`全体の型は`((t1 -> t1 -> t1) -> (t2 -> t2 -> t2) -> t) -> t`となる。 253 | 254 | このように、Haskellの型付けでは関数適用後の値が元の関数と別の型になるため、関数適用を計算の礎とするラムダ計算では型が付けられない場合が存在する。 255 | 以下の例では`cTrue`に`cid`を1度適用するだけだが、全体として正しく型付けできずコンパイルエラーとなる。 256 | ```haskell 257 | *Main> unchurchb $ church 1 cid cTrue 258 | 259 | :19:10: 260 | Occurs check: cannot construct the infinite type: 261 | (以下省略) 262 | ``` 263 | 264 | この問題を解決するため、以下のように`cif`を利用して`cid'`を定義しよう。 265 | ```haskell 266 | cif cb t f = if unchurchb cb then t else f 267 | cid' cb = cif cb cTrue cFalse 268 | ``` 269 | `cid'`の型は以下のようになり、先ほどの例も正しく動作する。 270 | ```haskell 271 | *Main> :t cid' 272 | cid' :: (Bool -> Bool -> Bool) -> t -> t -> t 273 | *Main> unchurchb $ church 1 cid' cTrue 274 | True 275 | ``` 276 | 277 | `cif`は型の問題を解決するために存在するだけであり、実質的には`cif cb t f`は`cb t f`と同値であることに注意して欲しい。 278 | つまり、`cif`を用いて定義できる様々な関数は、型の問題を除けば`cif`を用いずに記述することが出来る。 279 | 次の問では、`cif`を利用することで、チャーチ数とチャーチ真理値を組み合わせたいくつかの関数を定義する。 280 | 281 | ### 問 282 | 以下の関数を、*組み込みの演算子や再帰、if式などを用いず、関数適用のみを用いて定義*せよ。 283 | なお、必要に応じて`cnot`、`cand`、`cor`を、`cnot'`、`cand'`、`cor'`という名前で`cif`を利用して再定義せよ。 284 | 285 | 1. `cis0` : チャーチ数`c`を受け取り、それが0に対応するチャーチ数なら`cTrue`を、それ以外なら`cFalse`を返す関数 286 | 2. `ceven` : チャーチ数`c`を受け取り、それが偶数に対応するチャーチ数なら`cTrue`を、それ以外なら`cFalse`を返す関数 287 | 3. `cevennot0` : チャーチ数`c`を受け取り、それが0でない偶数に対応するチャーチ数なら`cTrue`を、それ以外なら`cFalse`を返す関数 288 | 4. `clte2` : チャーチ数`c`を受け取り、それが2以下の数に対応するチャーチ数なら`cTrue`を、それ以外なら`cFalse`を返す関数 289 | 290 | ### 例 291 | ```haskell 292 | *Main> unchurchb $ cis0 $ church 0 293 | True 294 | *Main> unchurchb $ cis0 $ church 1 295 | False 296 | *Main> unchurchb $ cis0 $ church 2 297 | False 298 | 299 | *Main> unchurchb $ ceven $ church 10 300 | True 301 | *Main> unchurchb $ ceven $ church 7 302 | False 303 | 304 | *Main> unchurchb $ cevennot0 $ church 0 305 | False 306 | *Main> unchurchb $ cevennot0 $ church 1 307 | False 308 | *Main> unchurchb $ cevennot0 $ church 2 309 | True 310 | *Main> unchurchb $ cevennot0 $ church 4 311 | True 312 | 313 | *Main> unchurchb $ clte2 $ church 0 314 | True 315 | *Main> unchurchb $ clte2 $ church 1 316 | True 317 | *Main> unchurchb $ clte2 $ church 2 318 | True 319 | *Main> unchurchb $ clte2 $ church 3 320 | False 321 | *Main> unchurchb $ clte2 $ church 4 322 | False 323 | ``` 324 | 325 | ## 総括 326 | 演習の通り、関数のみを用いて数や真理値を定義し、関数適用のみを用いて計算を行うことができる。 327 | このように、関数のみを値とし、関数適用のみを定義した計算モデルが**ラムダ計算**である 328 | 329 | なお今回は扱わなかったが、この体系の中で再帰を定義することもでき、これを利用して階乗などの演算も定義することができる。 330 | ラムダ計算の体系は非常に強力であり、**チューリング完全**であることが知られている。 331 | これはおおまかに言って、汎用プログラミング言語で可能な計算はラムダ計算でも可能である、ということを意味する。 332 | 333 | ラムダ計算を理論の礎とする言語に**Lisp**がある。 334 | またLispに限らず、**Haskell**など**ML**など多くの関数型言語はラムダ計算が理論的な基盤となっている。 335 | 336 | ## 参考 337 | `Bool`型の演算については上述の通り`cif`を用いて型の問題をある程度避けたが、本質的な問題は解決していない。 338 | 例えば、以下のようにチャーチ数の減算`csub`を定義することはできない。 339 | ```haskell 340 | csub c1 c2 = c1 cpred c2 341 | ``` 342 | ここでいう本質的な問題とは「関数適用を行った結果が元の関数と同じ型を持つことができない」ということであり、型付きラムダ計算を型付けの基盤とする言語では通常回避できない問題である。 343 | なお、OCamlでは`-rectypes`オプションを使用することで利用することができるが、本来型付けに失敗してほしい場面でも型がついてしまう場合があることから、デフォルトではオフになっている。 344 | さらに詳しくこのトピックについて知りたい場合は、[型システム入門](http://www.amazon.co.jp/dp/4274069117)の第20章「再帰型」を参照すると良い。 345 | 346 | この問題を避ける一つの方法は、Haskellの言語構造としてのラムダ式を用いる代わりに、ラムダ計算の項を再帰的なデータ型として表現することである。 347 | 第7章の演習で、この方法を用いてラムダ計算を実装する演習を行う。 348 | -------------------------------------------------------------------------------- /chapter6.md: -------------------------------------------------------------------------------- 1 | #1. 標準モジュールの利用 2 | 次の関数群を定義せよ。 3 | なお`Data.Ord`、`Data.List`、`Data.Map`を用いて良い。 4 | また、非負整数を受け取る関数については負数を受け取った時の挙動を考慮しなくてよい。 5 | 6 | 1. `sortByFrequency` : リスト`xs`を受け取り、`xs`内の要素の出現数で降順ソートしたリストを返す関数 7 | なお、出現頻度が同じ要素については、要素自体の昇順となるようにすること 8 | 2. `initialMap` : 文字列のリスト`ss`を受け取り、その文字から始まる文字列のリストへのMapを返す関数 9 | ただし、空文字列が含まれる場合はその要素を無視すること 10 | 3. `infixPalindromicNumber` : 非負整数`n`を受け取り、その数を文字列として含む最小の回文数を返す関数 11 | なお、回文数とは「逆から数字を読んでも同じ数になる数」のことをいう 12 | 13 | ###例 14 | ```haskell 15 | > :t sortByFrequency 16 | sortByFrequency :: Ord a => [a] -> [a] 17 | > sortByFrequency "abaacdabddddb" 18 | "dabc" 19 | > sortByFrequency "bbaacccc" 20 | "cab" 21 | > sortByFrequency ["high", "low", "middle", "high", "high", "middle"] 22 | ["high","middle","low"] 23 | 24 | > :t initialMap 25 | initialMap :: [String] -> Map.Map Char [String] 26 | > initialMap ["hoge", "fuga", "hogehoge", "piyo", "", "fugapiyo"] 27 | fromList [('f',["fugapiyo","fuga"]),('h',["hogehoge","hoge"]),('p',["piyo"])] 28 | 29 | > :t infixPalindromicNumber 30 | infixPalindromicNumber :: Int -> Int 31 | > infixPalindromicNumber 0 32 | 0 33 | > infixPalindromicNumber 12 34 | 121 35 | > infixPalindromicNumber 21 36 | 121 37 | > infixPalindromicNumber 765 38 | 56765 39 | ``` 40 | 41 | #2. バーナム暗号 42 | ### バーナム暗号の定義 43 | ビット毎の排他的論理和は、同じ演算を2回行うと元に戻る性質を持っている。 44 | ```haskell 45 | x `xor` y `xor` y == x 46 | ``` 47 | これを利用し、暗号と復号に同一の鍵を用いるのが *バーナム暗号* である。 48 | 49 | 今、暗号化対象となる平文を数列`[1,2,3]`、暗号化鍵を`[2,3,2]`とする。 50 | リストの各要素同士の排他的論理和を取ると 51 | ```haskell 52 | 1 `xor` 2 == 3 53 | 2 `xor` 3 == 1 54 | 3 `xor` 2 == 1 55 | ``` 56 | となり、暗号文`[3,1,1]`が得られる。 57 | 復号の際には、同様に暗号化鍵との排他的論理和を取って 58 | ```haskell 59 | 3 `xor` 2 == 1 60 | 1 `xor` 3 == 2 61 | 1 `xor` 2 == 3 62 | ``` 63 | となり、平文`[1,2,3]`を得る。 64 | 65 | ### 問 66 | 暗号鍵となる文字列`k`と、暗号化対象となる平文の文字列`s`を受け取り、暗号文の文字列を返す関数`vernam`を定義せよ。 67 | なお、`k`の長さが`s`より短い場合は、`k`を繰り返して使用せよ。 68 | 69 | ビットごとの排他的論理和は`Data.Bits`に`xor`として定義されており、これを使って良い。 70 | ただし、`Char`は`Bits`のインスタンスではないため、直接`xor`を適用できないことに注意すること。 71 | 必要ならば`Data.Char`モジュールの関数を使って良い。 72 | 73 | ### 例 74 | ```haskell 75 | > :t vernam 76 | vernam :: String -> String -> String 77 | > vernam "\NUL" "hogefuga" 78 | "hogefuga" 79 | > vernam "BIGHERO6" "Hello, I am Baymax." 80 | "\n,+$*~o\DELb(*h\a36[#1i" 81 | > vernam "BIGHERO6" "\n,+$*~o\DELb(*h\a36[#1i" 82 | "Hello, I am Baymax." 83 | ``` 84 | --------------------------------------------------------------------------------