プログラミングHaskellを読む (5)

第5章 リスト内包記法

この章のシーザー暗号の部分は、なかなか面白いです。

基本

リスト内包記法は数学の集合の表現を模している。
参考:集合の基本概念:定義と記号[数学についてのwebノート]

*Main> -- { x^2 | x ∈ {1, ..., 10} }
*Main> [x^2 | x <- [1..10]]
[1,4,9,16,25,36,49,64,81,100]

"x <- [1..10]"の部分は生成器と呼ばれる。

リスト内包記法では複数の生成器や、ガード*1をつけることも可能。
また、文字列は[Char]なので、生成器で使用出来る。

*Main Data.Char> [(x, y) | x <- "aAbBc", y <- "AaBbC", isLower x, isLower y]
[('a','a'),('a','b'),('b','a'),('b','b'),('c','a'),('c','b')]

テクニックを学ぶには、やはりソースを眺めるのが一番。

-- 一時変数のような使い方
concat :: [[a]] -> [a]
concat xss = [x | xs <- xss, x <- xs]

-- ワイルドカード
firsts :: [(a, b)] -> [a]
firsts ps = [x | (x, _) <- ps]

-- 気持ち悪いlength
length :: [a] -> Int
length xs = sum [1 | _ <- xs]

-- 約数(ただし効率は悪い)
factors :: Int -> [Int]
factors n = [x | x <- [1..n], n `mod` x == 0]

-- 素数かどうか
prime :: Int -> Bool
prime n = factors n == [1, n]

-- 素数を並べる
primes :: Int -> [Int]
primes n = [x | x <- [2..n], prime x]

{- 素数を求めるための有名な「エラトステネスのふるい」は12章で扱われるらしい。 -}

-- 隣の要素とペアを作る(zipは要素数の少ない方に調整される)
pairs :: [a] -> [(a, a)]
pairs xs = zip xs (tail xs)

シーザー暗号

これについては、練習問題8にて。

練習問題

1. 100まで二乗の和
sumSquare100 :: Int
sumSquare100 = sum [x^2 | x <- [1..100]]
2. 複製replicate
replicate' :: Int -> a -> [a]
replicate' x y = [y | x' <- [1..x]]
3. ピタゴラス
pyths :: Int -> [(Int, Int, Int)]
pyths n = [(x, y, z) | x <- l, y <- l, z <- l, x^2 + y^2 == z^2]
          where l = [1..n]
4. 完全数
factors :: Int -> [Int]
factors n = [x | x <- [1..n], n `mod` x == 0]
perfects :: Int -> [Int]
perfects n = [x | x <- [1..n], sum (init (factors x)) == x]
5. 1つの内包記法を2つで表現
cmpr = [(x, y) | x <- [1, 2, 3], y <- [4, 5, 6]]
cmpr' = concat [[(x, y) | y <- [4, 5, 6]] | x <- [1, 2, 3]]
testCmpr = cmpr == cmpr'
6. findを使ったpositions
positions :: Eq a => a -> [a] -> [Int]
positions x xs = [i | (x', i) <- zip xs [0..n], x == x']
                 where n = length xs - 1
find :: Eq a => a -> [(a, b)] -> [b]
find k t = [v | (k', v) <- t, k == k']
positions' :: Eq a => a -> [a] -> [Int]
positions' x xs = find x (zip xs [0..n]) where n = length xs - 1
7. 内積

普通に、複数の生成器にしてしまうと、全てのパターンで計算されてしまうので、zipでパターンを決めています。このテクはかなり使えそうですね。

scalarproduct :: [Int] -> [Int] -> Int
scalarproduct xs ys = sum [x * y | (x, y) <- zip xs ys]
8. シーザー暗号の大文字対応

出現頻度は大文字も小文字も合わせて計算すればよいので、計算する時に全部小文字に変換するだけで良いかと思います。なのでエンコード部分を大文字対応させれば終わったも同然です。

import Data.Char

---------------------------------------
-- エンコーダの作成
---------------------------------------

-- baseを基準に数値に変換
let2int :: Char -> Char -> Int
let2int base c = ord c - ord base

-- let2intの逆
int2let :: Char -> Int -> Char
int2let base n = chr (ord base + n)

-- 大文字用
let2intU = let2int 'A'
int2letU = int2let 'A'

-- 小文字用
int2letL = int2let 'a'
let2intL = let2int 'a'

-- 文字をずらす(大文字対応版)
shift :: Int -> Char -> Char
shift n c | isLower c = int2letL ((let2intL c + n) `mod` 26)
          | isUpper c = int2letU ((let2intU c + n) `mod` 26)
          | otherwise = c

-- 文字列変換
encode :: Int -> String -> String
encode n xs = [shift n x | x <- xs]

-- おまけ(http://ja.wikipedia.org/wiki/ROT13)
rot13 :: String -> String
rot13 = encode 13


---------------------------------------
-- 出現頻度表の作成
---------------------------------------

-- 統計による出現頻度表
table :: [Float]
table = [8.2, 1.5, 2.8, 4.3, 12.7, 2.2, 2.0, 6.1, 7.0, 0.2, 0.8, 4.0, 2.4,
         6.7, 7.5, 1.9, 0.1, 6.0, 6.3, 9.1, 2.8, 1.0, 2.4, 0.2, 2.0, 0.1]

-- 百分率の算出
percent :: Int -> Int -> Float
percent n m = (fromIntegral n / fromIntegral m) * 100

{- fronIntegralはIntをFloatのキャストを行うためのライブラリ関数 -}

-- 文字列中に現れる回数
count :: Char -> String -> Int
count x xs = length [x' | x' <- xs, x == x']

-- 文字列から出現頻度表を作成する(小文字用)
freqs :: String -> [Float]
freqs xs = [percent (count x xs) n | x <- ['a'..'z']]
           where n = length [x | x <- xs, isLower x]


---------------------------------------
-- 暗号解読
---------------------------------------

-- リストを比較するカイ2乗検定。小さいほど近い。
chisqr :: [Float] -> [Float] -> Float
chisqr os es = sum [((o-e)^2) / e | (o, e) <- zip os es]

-- リストを回す
rotate :: Int -> [a] -> [a]
rotate n xs = drop n xs ++ take n xs

-- 該当の要素をのインデックスをリストで返す
positions :: Eq a => a -> [a] -> [Int]
positions x xs = [i | (x', i) <- zip xs [0..n], x == x']
                 where n = length xs - 1

-- シーザー暗号の解読
crack :: String -> String
crack xs = encode (-factor) xs
           where
             -- 一番近い回転数
             factor = head (positions (minimum chitab) chitab)
             -- 順番に回してカイ2乗検定をした結果のテーブル
             chitab = [chisqr (rotate n table') table | n <- [0..25]]
             -- 入力文字の出現頻度表 table'
             table' = freqs [toLower(x) | x <- xs]


---------------------------------------
-- テスト
---------------------------------------
             
test :: [String]
test = [crack (rot13 xs) | xs <-
             ["Haskell is fun.",
              "List comprehensions are useful.",
              "Haskell",
              "Boxing wizards jump quickly",
              "The quick brown fox jumps over the lazy dog."]]


以上です。
新しいことは少ないのですが、演習は結構重かったですね。

*1:フィルタリングの条件