プログラミングHaskell 第7章 高階関数

前章に比べるとレベル上がった印象。

import Data.Char(chr, ord, isLower, isUpper)

-- 7.1 基本概念
twice :: (a -> a) -> a -> a
twice f x = f (f x)

-- 7.2 リスト処理
map :: (a -> b) -> [a] -> [b]
map f xs = [f x | x <- xs]

map f [] = []
map f (x:xs) = f x : map f xs

filter :: (a -> Bool) -> [a] -> [a]
filter p xs = [x | x <- xs, p x]
filter p [] = []
filter p (x:xs) | p x       = x : filter p xs
                | otherwise = filter p xs

-- 整数のリストから偶数を取り出し、二乗した値の合計をとる
sumsqreven :: [Int] -> Int
sumsqreven ns = sum (map (^2) (filter even ns))

-- 7.3 畳込 foldr

sum = foldr (+) 0
product = foldr (*) 1
or = foldr (||) False
and = foldr (&&) True

foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f v [] = v
foldr f v (x:xs) = f x (foldr f v xs)

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

length = foldr (\_ n -> 1+n) 0

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

-- 新しい要素をリストの末尾に追加する
snoc :: a -> [a] -> [a]
snoc x xs = xs ++ [x]

reverse [] = []
reverse (x:xs) = snoc x (reverse xs)

reverse foldr snoc []

-- error
-- (++ys) = foldr (:) ys 

-- 7.4 畳込関数 foldl
sum = foldl (+) 0
product = foldl (*) 1
or = foldl (||) False
and = foldl (&&) True

length = foldl (\n _ -> n+1) 0
reverse = foldl (\xs x -> x:xs) []
-- error
-- (xs++) = foldl (\ys y -> ys ++ [y]) xs

foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f v [] = v
foldl f v (x:xs) = foldl f (f v x) xs


-- 7.5 関数合成演算子
(.) :: (b -> c) -> (a -> b) -> (a -> c)
f.g = \x -> f (g x)

odd n = not (even n)
odd = not.even

twice f x = f (f x)
twice f = f.f

sumsqreven ns = sum (map (^2) (filter even ns))
sumsqreven = sum.map (^2).filter even

id :: a -> a
id = \x -> x

compose :: [a -> a] -> (a -> a)
compose = foldr (.) id


-- 7.6 文字列の変換器
type Bit = Int

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

int2bin :: Int -> [Bit]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)

-- 二進表記を8ビットにする
make8 :: [Bit] -> [Bit]
make8 bits = take 8 (bits ++ repeat 0)

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

-- 8ビットの二進表記に分割する
chop8 :: [Bit] -> [[Bit]]
chop8 [] = []
chop8 bits = take 8 bits : chop8 (drop 8 bits)

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

transmit :: String -> String
transmit = decode.channel.encode

channel :: [Bit] -> [Bit]
channel = id

exercise.

1.

リスト内包表記 [ f x | x <- xs, p x ] を
高階関数 map と filter を使って書き直すとどうなるか?

map f ( filter p xs )

2.

標準ライブラリでの定義を見ないで、
高階関数all, any, takeWhile, およびdropWhileを定義せよ。

myAll :: (a -> Bool) -> [a] -> Bool
myAll p [] = True
myAll p (x:xs) = (p x) && myAll p xs

myAny :: (a -> Bool) -> [a] -> Bool
myAny p [] = False
myAny p (x:xs) = (p x) || myAny p xs
  
myTakeWhile :: (a -> Bool) -> [a] -> [a]
myTakeWhile p [] = []
myTakeWhile p (x:xs) | p x       = x : myTakeWhile p xs
                     | otherwise = [] 

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

3.

関数foldrを用いて、関数map f と filter p を定義せよ。

ここでちょっと詰まりました。
map fは2つ定義が書いてあります。
まずはラムダ式の方を思いついたのですが、うーん？というのをTwitterでつぶやいたところ@osanai_先生に2つめのを教えてもらいました。
でもそれをfilterの方には全然いかせてません。

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

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

4.

foldlを用いて、十進表記を整数に変換する関数
dec2int :: [Int] -> Int
を定義せよ。

dec2int :: [Int] -> Int
dec2int = foldr (\x y -> x + 10*y) 0

5.

以下の定義が誤りである理由を説明せよ。
sumsqreven = compose [sum, map (^2), filter even]

compose :: [a -> a] -> (a -> a)
map(^2), filter evenは同じ型だが、sumのみ異なるため。

6.

標準ライブラリの定義を見ないで、以下の2つの高階関数を定義せよ。
・「引数に組をとる関数」を「カリー化された関数」へ変換する関数 curry
・「引数が2つのカリー化された関数」を「引数に組をとる関数」へ変換する関数 uncurry
ヒント：まず、関数の型を書きなさい。

ここでどはまりしました。
引数を2つとる関数を定義する場合、まだどうしても左辺にf x y = みたいに書いてしまいます。

mycurry :: ((a, b) -> c) -> (a -> b -> c)
mycurry = (\a b c -> a (b,c))

myuncurry :: (a -> b -> c) -> ((a, b) -> c)
myuncurry = (\a (b,c) -> a b c)

7.

高階関数 unfold は、リストを生成する簡単な再帰の様式を閉じ込める。
この関数は、以下のように定義できる。

unfold p h t x | p x = []
| otherwise = h x : unfold p h t (t x)

すなわち、関数 unfold p h t は、
述語pを引数に適用した結果Trueとなれば、空リストを返す。
そうでなければ、関数hを引数へ適用することで先頭の要素を作り、
残りのリストは自分自身を呼び出すことで生成して、全体として空でないリストを作る。
再帰する際には、関数tを引数に適用して、新たな引数を作る。
たとえば関数unfoldを用いると、関数int2binはもっと簡潔に書き直せる。

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

関数 unfold を用いて関数 chop8, map f, iterate fを再定義せよ。
|

不完全です。というのもmapで適用できる型にEqクラスであるという制限がついてしまっています。
(==[])のせいなんですが、どうしたもんでしょうか・・・

unfold :: (a -> Bool) -> (a -> b) -> (a -> a) -> a -> [b]
unfold p h t x | p x = []
               | otherwise = h x : unfold p h t (t x)

chop8_unfold :: [Bit] -> [[Bit]]
chop8_unfold = unfold (==[]) (take 8) (drop 8)

map_unfold :: Eq a => (a -> b) -> [a] -> [b]
map_unfold f = unfold (==[]) (f.head) (tail)

8.

パリティービットを用いることで、
文字列を通信するプログラムを軽度の通信エラーを検出できるように変更せよ。
すなわち、8ビットの二進表記は、符号化の際にパリティービットを付加される。
パリティービットは、1の個数が奇数であれば1, そうでなければ0となる。
逆に複号の際は、9ビットの二進表記のパリティービットが正しいか検査する。
正しければパリティービットを捨て誤りであればパリティーエラーを報告する。
ヒント: ライブラリ関数 error :: String -> a は、
評価を強制終了し、与えられる文字列をエラーメッセージとして表示する。

check_parity中でerrorを使ってるんですが、
これcheck_parityの型を完全に無視してる気がするんだけど大丈夫なの？(´・ω・｀)

それから、decode_parityの定義がたぶんなんかおかしいです。
ほんとはmap(chr.bin2int.check_parity).chop9と書きたかったのですが、
bin2int.check_parityのとこで怒られてしまいました。
(.)演算子がちゃんとわかってない。

-- パリティを先頭に付加
make9_parity :: [Bit] -> [Bit]
make9_parity bits = length (filter odd bits) `mod` 2 : make8 bits

encode_parity :: String -> [Bit]
encode_parity = concat.map(make9_parity.int2bin.ord)

-- まじめにやるならchop nを作ってchop8, chop9はそれを使う方がよい気がする
chop9 :: [Bit] -> [[Bit]]
chop9 [] = []
chop9 bits = take 9 bits : chop9 (drop 9 bits)

check_parity :: [Bit] -> [Bit]
check_parity (x:xs) | x == checked_parity = xs
                    | otherwise           = error "parity error"
                        where checked_parity = length (filter odd xs) `mod` 2

decode_parity :: [Bit] -> String
decode_parity = map(chr.bin2int).map(check_parity).chop9

9.

通信エラーの生じる通信路を用いて、
練習問題8で定義した文字列を通信するプログラムを試せ。
この通信路は最初のビットを落とすとする。
これは、関数tailをビットのリストに適用することで実現できる。

transmit_normal :: String -> String
transmit_normal = decode_parity.channel.encode_parity

transmit_broken :: String -> String
transmit_broken = decode_parity.channel_broken.encode_parity

channel_broken :: [Bit] -> [Bit]
channel_broken = tail