2007-02-25

『入門Haskell』練習問題例解(15)

Haskell

『入門Haskell』最後の問題です。

Base64（エンコード）

p.144の(1)です。

(1) このBase64 エンコードは「76文字以内に改行を入れる」ということが行われていません。これに対する対処を、以下の2つのアプローチで実装しなさい。
1. base64Encode関数でevalStateした結果に文字列処理を行う
2. Stateモナドが保持する状態に、「現在何文字目を処理しているか」を持っておく

p.143のbase64.hsを元にして改行処理を追加します。ところでbase64.hsのcalcSuffix関数の定義の中で

calcSuffix (Second n) = table !! shiftR n 4 : "==\n"
calcSuffix (Third  n) = table !! shiftR n 2 : "=\n"

となっているのは

calcSuffix (Second n) = table !! shiftL n 4 : "==\n"
calcSuffix (Third  n) = table !! shiftL n 2 : "=\n"

の誤りです。shiftRではなくshiftLです。それを踏まえた上で…

(1) 1.
76文字ごとに改行を入れていく関数insertLineFeedsを定義して使います。

base64Encode' = insertLineFeeds . base64Encode where
	insertLineFeeds s | length s <= 76 = s
			  | otherwise      = (take 76 s) ++ "\n" ++ insertLineFeeds (drop 76 s)

このbase64Encode'関数を使えば、正しく改行が挿入されます。

(1) 2.
B64EncStateの定義を書き換えます。

data B64EncState = First Int | Second Int Int | Third Int Int

1つ目のIntが「現在何文字目を処理しているか」という状態です。先ほどはエンコードした後の文字列に対して76文字ごとに改行を入れました。今度はエンコード中に改行を入れていきます。ということは、76 / 4 * 3 = 57文字処理するごとに改行を入れることになります。よってコード全体は

import Control.Monad.State
import Data.Char
import Data.Bits

data B64EncState = First Int | Second Int Int | Third Int Int


table = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+/"

procChar :: Int -> State B64EncState String
procChar c = get >>= transit
	where
	transit (First m)    = do put $ Second (m+1) (c .&. 3)
				  return [table !! shiftR c 2]
	transit (Second m n) = do put $ Third (m+1) (c .&. 15)
				  return [table !! (shiftL n 4 .|. shiftR c 4)]
	transit (Third  m n) = do put $ First (m+1)
				  return $ [ table !! (shiftL n 2 .|. shiftR c 6)
					   , table !! (c .&. 63)]
					   ++ if m `mod` 57 == 0 then "\n" else ""

calcSuffix :: B64EncState -> String
calcSuffix (First m)    = "\n"
calcSuffix (Second m n) = table !! shiftL n 4 : "==\n"
calcSuffix (Third  m n) = table !! shiftL n 2 : "=\n"

b64Enc :: String -> State B64EncState String
b64Enc s = do strs <- mapM (procChar.ord) s
	      suffix <- gets calcSuffix
	      return (concat strs ++ suffix)

base64Encode s = evalState (b64Enc s) (First 1)

となります。

Base64（デコード）

p.144の(2)です。

(2) Base64文字列から元のバイト列を復元するbase64Decode関数を定義しなさい。

エンコードの時は「元の文字列を6ビット単位で切り分ける -> テーブルから文字を探して置き換えていく」ということをやったので、デコードの場合はまず逆引きをしなくてはいけません。逆引きテーブルは連想リストの形で

reverseTable = zip (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+/") [0..]

となります。文字'Z'を逆引きしたいときは fromJust $ lookup 'Z' reverseTable とすれば25が得られます。状態は

data B64DecState = First | Second Int | Third Int | Fourth Int

で表します。これを使って

1文字目…空文字列を値として返す。「今見ている数字の下位6ビット」を次に渡す。
2文字目…「1文字目の時に残した6ビットを左に2桁シフトしたもの」と「今見ている文字を右に4桁シフトしたもの」との論理和を取って値として返す。「今見ている数字の下位4ビット」を次に渡す。
3文字目…「2文字目の時に残した4ビットを左に4桁シフトしたもの」と「今見ている文字を右に2桁シフトしたもの」との論理和を取って値として返す。「今見ている数字の下位2ビット」を次に渡す。
4文字目…「3文字目の時に残した2ビットを左に6桁シフトしたもの」と「今見ている文字」との論理和を取って値として返す。

という処理を行います。後は改行文字'\n'とイコール'='ですが、単純に無視すればいいみたいです（状態遷移も行いません）。
以上をまとめてコードの全体を示します。

import Control.Monad.State
import Data.Char
import Data.Bits
import Data.Maybe

data B64DecState = First | Second Int | Third Int | Fourth Int

reverseTable = zip (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "+/") [0..]

decChar :: Int -> State B64DecState String
decChar 61 = return ""   -- '=' は無視
decChar 10 = return ""   -- '\n' は無視
decChar c = get >>= transit where
	d = fromJust $ lookup (chr c) reverseTable
	transit First      = do put $ Second (d .&. 63)
				return ""
	transit (Second n) = do put $ Third (d .&. 15)
				return [chr (shiftL n 2 .|. shiftR d 4)]
	transit (Third n)  = do put $ Fourth (d .&. 3)
				return [chr (shiftL n 4 .|. shiftR d 2)]
	transit (Fourth n) = do put $ First
				return [chr (shiftL n 6 .|. d)]

b64Dec :: String -> State B64DecState String
b64Dec s = mapM (decChar.ord) s >>= return . concat

base64Decode :: String -> String
base64Decode s = evalState (b64Dec s) First

試してみます。

*Main> base64Encode "Gakuen Utopia Manabi Straight!"
"R2FrdWVuIFV0b3BpYSBNYW5hYmkgU3RyYWlnaHQh\n"
*Main> base64Decode "R2FrdWVuIFV0b3BpYSBNYW5hYmkgU3RyYWlnaHQh\n"
"Gakuen Utopia Manabi Straight!"

ちゃんと元の文字列が復元できました。これで『入門Haskell』の練習問題は全て終わりました。お疲れ様でした。

2007-02-24

『入門Haskell』練習問題例解(14)

Haskell

p.128。モナド関連の関数です。

1. sequence_ を foldr を使って定義しなさい。
2. mapM と mapM_ を定義しなさい（sequenceなどを使ってもよい）。
3. foldM と foldM_ を定義しなさい。

sequence_

mySequence_ :: Monad m => [m a] -> m ()
mySequence_ = foldr (>>) (return ())

こうなります。ちなみに、sequence を foldr を使って定義すると

mySequence :: (Monad m) => [m a] -> m [a]
mySequence = foldr ((flip (.) (((flip (.) ((return .) . (:))) . (>>=)))) . (>>=)) (return [])

となります。もはや何がなんだか…

mapM, mapM_

mapM f = (\x -> sequence (map f x))
=> (\x -> sequence ((map f) x))
=> (sequence . (map f))
=> (\x -> sequence . (map x)) f
=> ((sequence .) . map) f

なので、最終的には

myMapM :: Monad m => (a -> m b) -> [a] -> m [b]
myMapM = (sequence .) . map

myMapM_ :: Monad m => (a -> m b) -> [a] -> m ()
myMapM_ = (sequence_ .) . map

となります。

foldM, foldM_

foldM f a [x1, x2, ... ,xn] は

f a x1 >>= (\y -> f y x2) >>= ... >>= (\y -> f y xn) >>= (\y -> f y [])

と同じことです。flip関数を使ってyが消去できるので、答えは

myFoldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
myFoldM f a [] = return a
myFoldM f a (x:xs) = (f a x) >>= (flip (myFoldM f) xs)

myFoldM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
myFoldM_ f a [] = return ()
myFoldM_ f a (x:xs) = (f a x) >>= (flip (myFoldM_ f) xs)

となります。

次回、最終回！

2007-02-23

『入門Haskell』練習問題例解(13)

Haskell

p.113です。

(1)木の最大深さを計算する関数depthを書きなさい。
(2)上で示したtreeToList(p.112)は、リストの順序が滅茶苦茶になっています。これを、キーの昇順に並べるように実装しなおしなさい。

昇順に並んだリストを返す関数はtreeToSortedListとします。(1)(2)をいっぺんに解くと

import List

data Tree a = Leaf | Node a (Tree a) (Tree a) deriving Show

depth :: Tree a -> Int
depth Leaf = 0
depth (Node _ l r) = 1 + max (depth l) (depth r)

lengthTree :: Tree a -> Int
lengthTree Leaf = 0
lengthTree (Node _ l r) = 1 + lengthTree l + lengthTree r

lookupTree :: (Ord a) => a -> Tree (a, b) -> Maybe b
lookupTree x Leaf = Nothing
lookupTree x (Node (k, v) l r)
  | x < k     = lookupTree x l
  | x > k     = lookupTree x r
  | otherwise = Just v

insertTree :: (Ord a) => (a, b) -> Tree (a, b) -> Tree (a, b)
insertTree (k', v') Leaf = Node (k', v') Leaf Leaf
insertTree (k', v') (Node (k, v) l r)
  | k' < k    = Node (k, v) (insertTree (k', v') l) r
  | k' > k    = Node (k, v) l (insertTree (k', v') r)
  | otherwise = Node (k', v') l r

emptyTree = Leaf

listToTree :: (Ord a) => [(a, b)] -> Tree (a, b)
listToTree = foldl (flip insertTree) emptyTree

treeToList :: Tree a -> [a]
treeToList Leaf = []
treeToList (Node x l r) = x : treeToList l ++ treeToList r

treeToSortedList :: (Ord a) => Tree a -> [a]
treeToSortedList = sort . treeToList

こうなります。

2007-02-23

『入門Haskell』練習問題例解(12)

Haskell

p.106です。

(1) MaybeはOrd a => Ord (Maybe a)でもあります。このインスタンス宣言を行いなさい。またShow a => Show (Maybe a)のインスタンス宣言も行いなさい。
(2) 2章で見たように、Ordの宣言の概略は次のようになっています。（中略）これにデフォルトの定義を加えることで、必要最低限の関数だけ用意すれば動作するようにしなさい。

Maybe

MyMaybe型を作ります。derivingを使ってよいなら

data MyMaybe = data MyMaybe a = MyNothing | MyJust a deriving (Eq, Ord, Show)

で一発です。使わなければ

data MyMaybe a = MyNothing | MyJust a

instance (Eq a) => Eq (MyMaybe a) where
	MyNothing == MyNothing = True
	MyJust x  == MyJust y  = x == y
	_         == _         = False

instance (Ord a) => Ord (MyMaybe a) where
	compare MyNothing  MyNothing  = EQ
	compare MyNothing  _          = LT
	compare _          MyNothing  = GT
	compare (MyJust x) (MyJust y) = compare x y

instance (Show a) => Show (MyMaybe a) where
	show MyNothing           = "MyNothing"
	show (MyJust x)          = "MyJust" ++ show x

こんな感じになると思います。ただしこの定義だと show (MyJust (MyJust 1)) は "MyJust (MyJust 1)" ではなく "MyJust MyJust 1" となってしまいます。何とかしたいのですが…。

Ord

MyOrd型クラスを作ります。関数は myCompare, (@>), (@<), (@>=), (@<=), myMax, myMin とします。
はじめ、スーパークラスにはEq型クラスをそのまま使おうと思ったのですが、(==) と (/=) だけ@が頭についてないのは何となく気持ち悪いなあと思ったのでMyEq型クラスを用意することにしました。ついでにOrdering型に代えてMyOrdering型を使うことにしました。

class MyEq a where
	(@==), (@/=) :: a -> a -> Bool
	x @== y = not (x @/= y)
	x @/= y = not (x @== y)

data MyOrdering = MyLT | MyEQ | MyGT

instance MyEq MyOrdering where
	MyLT @== MyLT = True
	MyEQ @== MyEQ = True
	MyGT @== MyGT = True
	_    @== _    = False

class MyEq a => MyOrd a where
	myCompare                :: a -> a -> MyOrdering
	(@>), (@<), (@>=), (@<=) :: a -> a -> Bool
	myMax, myMin             :: a -> a -> a
	x @> y  = myCompare x y @== MyGT
	x @< y  = myCompare x y @== MyLT
	x @>= y = myCompare x y @/= MyLT
	x @<= y = myCompare x y @/= MyGT
	myMax x y | x @>= y   = x
		 | otherwise = y
	myMin x y | x @<= y   = x
		 | otherwise = y

ためしに data Alpha = A | B | C | D という型に順序を入れてみます。

data Alpha = A | B | C | D deriving Show

instance MyEq Alpha where
	A @== A = True
	B @== B = True
	C @== C = True
	D @== D = True
	_ @== _ = False

instance MyOrd Alpha where
	myCompare A A = MyEQ
	myCompare A _ = MyLT
	myCompare _ A = MyGT
	myCompare B B = MyEQ
	myCompare B _ = MyLT
	myCompare _ B = MyGT
	myCompare C C = MyEQ
	myCompare C D = MyLT
	myCompare D C = MyGT
	myCompare D D = MyEQ

GHCiで結果が確認できるようにShow型クラスを継承させました。

*Main> myMax C B
C
*Main> myMin A A
A

こうなります。

2007-02-21

圏論

Haskell Math

Haskellにおけるモナドと圏論の関係についてこの論文が非常に参考になりました。
The Haskell Programmer's Guide to the IO Monad --- Don't Panic
関手や自然変換について、ごくごく基本的なレベルですが腹の底から理解できました。MaybeモナドやListモナド、IOモナドの仕組みもわかりました。今度は「モナドのすべて」を読みたいと思います。ところでMonadPlusに対応する概念は圏論だと何というのでしょうか？

2007-02-12

Schemeはじめました

Scheme

Scheme始めました。『計算論』は90ページぐらいまで読みました。位相空間論の本も読んでいます。やっぱ数学は楽しー！

2007-02-04

『計算論』メモ　問1.3.15

Math

『計算論計算可能性とラムダ計算 (コンピュータサイエンス大学講座)』p.22の問1.3.15。

代入命令 $x := 0$ （0を代入）
代入命令 $x := x + 1$ （次の自然数を代入）
判定命令 $x = y ?$ （xとyが等しいか判定し分岐する）
入力命令（入力値は保存）と出力命令

からなるNプログラムを正規形のNプログラムと言うが、任意のNプログラムPに対して、Pと同じ関数を計算するNプログラムがあることを示せ、という問題。

Nプログラムとは

代入命令 $x:=f(x_1, x_2, \cdots, x_i)$
判定命令 $f(x_1, x_2, \cdots, x_i) = g(y_1, y_2, \cdots, y_j)$
入力命令（入力値は保存）と出力命令

で構成される。ここでf, gは変数と定数0, 1, 2, ...と四則演算 $+, \overset{\cdot}{-}, \times, \div$ からなる任意の算術式である。

代入命令 $x:=f(\vec{x})$ が正規形Nプログラムで計算できるならば、判定命令 $f(\vec{x}) = g(\vec{y}) ?$ も正規形Nプログラムで計算できる。なぜなら

(1) input()
(2) f() = g() ?

は

(1) input()
(2) s := f()
(3) t := g()
(4) s = t ?

に変形できるからである。そこで代入命令 $x:=f(\vec{x})$ が正規形Nプログラムで計算できることを示せばよいが、 $f(\vec{x})$ は仮定により算術式であり、算術式は原始的関数であるから、原始的関数の定義と定理1.3.14（「原始的関数はNプログラムで計算することができる」）により、零関数 $zero()$ 、後者関数 $suc(x)$ 、射影関数 $p_i^n(\vec{x})$ が正規形Nプログラムで計算できることを示せば十分である。

零関数。

(1) input()
(2) s := 0
(3) output(s)

後者関数。矢印で行き先が明示されていない場合次の行へ進むものとする。

(1) input(x)
(2) s := 0
(3) s = x ?
      true  -> (5) 
      false -> (4)
(4) s := s + 1  -> (3)
(5) s := s + 1
(6) output(s)

射影関数。

(1) input()
(2) output()

証明終。