第2回スタートHaskellの範囲を予習しました。

第2回スタートHaskellの範囲の演習問題を解いてみました。
間違っている箇所が多々あると思いますが、ここに載せておきます。

第2回スタートHaskellの範囲はプログラミングHaskellの以下の章です。

• 第5章 リスト内包表記
• 第6章 再帰関数
• 第7章 高階関数

5章 練習問題の解答

import Data.Char

-- 5.7.1
sumOfSqure = sum [x * x | x <- [1..100]]

-- 5.7.2
myreplicate :: Int -> a -> [a]
myreplicate n obj = [obj | x <- [1 .. n]]

-- 5.7.3
pyths :: Int -> [(Int,Int,Int)]
pyths n = [(x,y,z) | x <- [1..n], y <- [1..n], z <- [1..n], z*z == x*x + y*y]

-- 5.7.4
perfects :: Int -> [Int]
perfects n = [x | x <- [1..n], x == sum (divisors x)]
             where
               divisors = (\ n -> [x | x <- [1..n], n `mod` x == 0 && (not (n == x))])

-- 5.7.5
twogen = concat [[(x, y)|y <- [4,5,6]] | x <- [1,2,3]]

-- 5.7.6
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 [(xs!!n, n) | n <- [0 .. endIndex]]
                 where
                   endIndex = length xs -1

-- 5.7.7
scalarproduct :: [Int] -> [Int] -> Int
scalarproduct xs ys = sum [xs!!n * ys!!n | n <- [0 .. (length xs -1)]]

-- 5.7.8
let2int :: Char -> Int
-- let2int c  = ord c - ord 'a'
let2int c | isUpper c = ord c - ord 'A' + 260
          | otherwise = ord c - ord 'a'


int2let :: Int -> Char
int2let n | n < 260 = chr (ord 'a' + n)
          | otherwise = chr(ord 'A' + n - 260) 

shift :: Int -> Char -> Char
shift n c | isLower c = int2let ((let2int c + n) `mod` 26)
          | isUpper c = int2let (((let2int c + n) `mod` 26) + 260)
          | otherwise = c

encode :: Int -> String -> String
encode n xs = [shift n x | x <- xs]

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

lowers :: String -> Int
lowers xs = length [x|x <- xs, isLower x]

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 = lowers xs

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

crack :: String -> String
crack xs = encode (-factor) xs
           where
             factor = head (positions (minimum chitab) chitab)
	     chitab = [chisqr (rotate n table') table | n <- [0..25]]             
             table' = freqs xs

6章 練習問題の解答

-- ex6.8.1

(***) :: Int -> Int -> Int
(***) 0 _ = 0
(***) _ 0 = 1
(***) x n | n > 0 = x * (x *** (n - 1))
          | otherwise = error "n: invalid arg"

-- ex6.8.2
length' :: [a] -> Int
length' [] = 0
length' (_:xs) = 1 + length' xs

drop' :: Int -> [a] -> [a]
drop' 0 [] = []
drop' 0 (x:xs) = x:xs
drop' n [] = []
drop' n (x:xs) = drop' (n - 1) xs

init' :: [a] -> [a]
init' [_] = []
init' (x:xs) = x : init' xs

-- ex6.8.3
and' :: [Bool] -> Bool
and' [] = True
and' (x:xs) | x = and' xs
            | otherwise = False

concat' :: [[a]] -> [a]
concat' [] = []
concat' (x:xs) = x ++ (concat' xs)

replicate' :: Int -> a -> [a]
replicate' 0 _ = []
replicate' n x = x : (replicate' (n - 1) x)

(!!!) :: [a] -> Int -> a
(!!!) [] _ = error "index too large"
(!!!) (x:xs) 0 = x
(!!!) (x:xs) n = xs !!! (n -1)

elem' :: Eq a => a -> [a] -> Bool
elem' _ [] = False
elem' x xs | x == (head xs) = True
           | otherwise = elem' x (tail xs)

-- ex6.8.4
merge' :: Ord a => [a] -> [a] -> [a]
merge' [] xs = xs
merge' xs [] = xs
merge' (x:xs) (y:ys) | x < y = x:(merge' xs (y:ys))
                     | otherwise = y:(merge' (x:xs) ys)

-- ex6.8.5
msort :: Ord a => [a] -> [a]
msort [] = []
msort [x] = [x]
msort [x,y] = merge' [x] [y]
msort xs = merge' (msort forth) (msort back)
           where
              i = (length xs) `div` 2
              forth = take i xs
              back = drop i xs

-- ex6.8.6
sum' :: Num a => [a] -> a
sum' [] = 0
sum' (x:xs) = x + (sum' xs)

take' :: Int -> [a] -> [a]
take' 0 _ = []
take' n [] = []
take' n (x:xs) = x:(take' (n - 1) xs)

last' :: [a] -> a
last' [] = error "empty list"
last' [x] = x
last' (x:xs) = last' xs

7章 練習問題の解答

import Data.Char

-- ex7.8.1
listComprehension :: (a -> b) -> (a -> Bool) -> [a] -> [b]
listComprehension f p xs = map f (filter p xs)

-- ex7.8.2
all' :: (a -> Bool) -> [a] -> Bool
all' p xs = and (map p xs)

any' :: (a -> Bool) -> [a] -> Bool
any' p xs = or (map p xs)

takeWhile' :: (a -> Bool) -> [a] -> [a]
takeWhile' p [] = []
takeWhile' p (x:xs) | p x = x:(takeWhile' p xs)
                    | otherwise = []

dropWhile' :: (a -> Bool) -> [a] -> [a]
dropWhile' p [] = []
dropWhile' p (x:xs) | p x = dropWhile' p xs
                    | otherwise = x:xs

-- ex7.8.3
map' :: (a -> b) -> [a] ->  [b]
map' f = foldr (\ x y -> (f x):y) [] 

filter' :: (a->Bool)->[a] -> [a]
filter' p = foldr (\ x y -> if p x then x:y else y) []

-- ex7.8.4
dec2int :: [Int] -> Int
dec2int xs = foldr f 0 l
             where
               f = (\ (x,p) y -> x * (10 ^ p) + y)
               l = zip (reverse xs) [0 .. (length xs)]

-- ex7.8.5
compose :: [a -> a] -> (a -> a)
compose = foldr (.) id
-- sumsqreven = compose [sum , map ((^) 2) , filter even]
-- sumの型が sum :: Num a => [a] -> a で、リストを返さない。
-- このためsumだけリストに入れる事が出来ない。
-- 以下のように合成することは出来る。
sumsqreven = sum . map ((^) 2) . (filter even)

-- ex7.8.6
add :: (Int,Int) -> Int
add (x,y) = x + y

curry' :: ((a, b) -> c) -> a -> b -> c
curry' f x y = f (x,y)

add' x y = x + y
uncurry' :: (a -> b -> c) -> ((a, b) -> c)
uncurry' f = (\ (x,y) -> f x y)

-- ex7.8.7
unfold p h t x | p x = []
               | otherwise = h x : unfold p h t (t x)

int2bin = unfold (== 0) (`mod` 2) (`div` 2)

type Bit = Int
chop8 :: [Bit] -> [[Bit]]
chop8 bits = unfold null (take 8) (drop 8) bits

map'' :: (a -> b) -> ([a] -> [b])
map'' f = unfold null (f . head) (tail) 

iterate' :: (a -> a) -> a -> [a]
iterate' f = unfold (\x -> False) id f


-- ex7.8.8
make8 :: [Bit] -> [Bit]
make8 bits = take 8 (bits ++ repeat 0)

bin2int :: [Bit] -> Int
bin2int bits = sum [ w * b | (w, b) <- zip weights bits]
               where
                 weights = iterate (* 2) 1

encode :: String -> [Bit]
encode = concat . map (make8 . int2bin . ord)

addParityBit :: [Bit] -> [Bit]
addParityBit bits = concat (map (\x -> (parityBit x):x) (chop8 bits))
                    where
                       parityBit = (\x -> (sum x) `mod` 2)

encode' :: String -> [Bit]
encode' str = addParityBit (encode str)

decode :: [Bit] -> String
decode = map (chr . bin2int) . chop8

chop9 :: [Bit] -> [[Bit]]
chop9 bits = unfold null (take 9) (drop 9) bits

correctParityBit :: [[Bit]] -> Bool
correctParityBit bits = and (map (\x-> ((sum (tail x)) `mod` 2) == head x) bits)

removeParityBit :: [Bit] -> [Bit]
removeParityBit bits = concat (map tail (chop9 bits))

decode' :: [Bit] -> String
decode' bits | correctParityBit (chop9 bits) = decode (removeParityBit bits)
             | otherwise = error "decode fail"

-- ex7.8.9
transmit :: String -> String
transmit = decode' . id . encode'

transmitWithError :: String -> String
transmitWithError = decode' . tail .encode'