| ホーム ＞ Haskell ＞ 2004年12月 | 記事の検索 | サイト検索 | 更新情報 |
| プロフィール | 記事一覧 | リンク集 | RSS |
|
CommonHaskellIdiomsを眺めている。
PointFreeStyleは、引数を書かず（考えず）、関数のcompositionで関数を定義するスタイル。好ましいスタイル。
HigherOrderFunctionsのページでは、 関数の共通の振る舞いをくくりだす話が書かれている。
SOE 18.4 State Monadsを見ながら、 自分でわかりやすいように書き換えたり、 コメントをつけたり、道に迷ったり。
「関数」というものを直接イメージするのがまだ苦手なので、引数を補って考えている。
状態が暗黙のうちに流れていく様子はだいぶわかったつもり。
\begin{code}
module Main where
-- Lstはリストを表す型。
data Lst a = Nil | MakeLst a (Lst a) deriving (Show, Eq)
-- Stateは状態。数の累積に使う。
type State = Integer
-- Numberingは要素の数を数えるための型。
-- newtype Numbering aを使うと、Numberingはaと本質的に同じ型。
-- 汎用に作っているので、とりあえずLstとは無関係。
newtype Numbering a = Numbering (State -> (a, State))
-- State -> (a, State) という型は「状態を渡されると、値に状態をくっつけて返す関数」を表す型
-- そうか！「状態」は暗黙のうちにbindを経由して渡っていくんだな。
-- Numbering型をMonadのインスタンスにする。これで>>=やreturnが使える（使えるように定義する）
instance Monad Numbering where
-- return xは、Numbering fという関数で表現しよう。
-- fというのは、どういう関数か。f s は「xに対して、流れてくる状態sをくっつけて返す関数」である。
return x = Numbering f
where
f s = (x, s)
-- 「Numbering fの結果を元にnextfする」ということを「Numbering g」という関数で表現しよう。
-- gというのはどういう関数か。g sは「h t」である。
-- tとはどういう状態か。「f sしたときの結果の状態である」
-- hとはどんな関数か。「f sしたときの値に対してnextfする関数」である。
-- このあたりで道に迷ってしまった …(@_@)
Numbering f >>= nextf = Numbering g
where
g s = h t
where
(l, t) = f s
Numbering h = nextf l
number :: Lst a -> Lst Integer
number l = fst (f 0)
where
Numbering f = numb l
where
numb :: Lst a -> Numbering (Lst Integer)
numb Nil = do
return Nil
numb (MakeLst _ l) = do
n <- nextNumber
nl <- numb l
return (MakeLst n nl)
where
nextNumber :: Numbering Integer
nextNumber = Numbering f
where
f n = (n+1, n+1)
s1 = MakeLst "A" (MakeLst "B" (MakeLst "C" Nil))
n1 = number s1
\end{code}
Main> s1 MakeLst "A" (MakeLst "B" (MakeLst "C" Nil)) Main> n1 MakeLst 1 (MakeLst 2 (MakeLst 3 Nil))
SOE 18.2.1 Other Instances of Monadをちらちらみながら、 MaybeならぬPerhapsを作ってみる。 Nothingの代わりに「最初にエラーが起きたときの文字列を保持するError String」を作ってみる。
doの表記を手で置換してみると、意味がよく分かる。
\begin{code}
module Main where
data Perhaps a = Error String | Value a deriving (Show,Eq)
instance Monad Perhaps where
Value x >>= k = k x
Error s >>= k = Error s
return x = Value x
fail s = Error s
a1 = Value 123 >>= (\x ->
Value x >>= (\y ->
Value y >>= (\z ->
Value z )))
t1 = do
x <- Value 123
y <- Value x
z <- Value y
return z
a2 = Value 123 >>= (\x ->
Value x >>= (\y ->
Error "Too bad." >>= (\_ ->
Value y >>= (\z ->
Value z ))))
t2 = do
x <- Value 123
y <- Value x
Error "Too bad."
z <- Value y
return z
a3 = Value 123 >>= (\x ->
Value x >>= (\y ->
Error "Too bad." >>= (\_ ->
Value y >>= (\z ->
Error "Invalid." >>= (\_ ->
Value z )))))
t3 = do
x <- Value 123
Error "Too bad."
y <- Value x
Error "Invalid."
z <- Value y
return z
\end{code}
Main> a1 Value 123 Main> t1 Value 123 Main> a2 Error "Too bad." Main> t2 Error "Too bad." Main> a3 Error "Too bad." Main> t3 Error "Too bad."
nobsunから、またアドバイスをいただきました。 いつもありがとうございます。 ちょうど、以下でご説明いただいた部分を考えていたところなので、 よい整理になりました。
nobsunから
結城さん モナドの考察、たいへん興味深く拝見しています。 以下は、ひょっとして、ヒントになるかもしれないと思って書いています。 (モナドになると、だいぶんおよび腰になってしまうのは、私自身、 モナドの意味そのものをよく理解していわけでないからです。) Haskell のクラスには細かく分類すると 2 種類あります。 「型クラス」と「型構築子クラス」です。 - Ord、Eq、Show などは「型クラス」 - Functor、Monad、MonadPlus などは「型構築子クラス」 「型クラス」は、そのインスタンスである型の値(これは first class)の性質を 規定するものですが、「型構築子クラス」は、そのインスタンスである型構築子 (これは first class ではありません)の性質を規定するものです。 data List a = Nil | Cons a (List a) というデータ型を定義したとき、Nil、Cons はデータ構築子で、 List は型構築子です。たとえば、Eq のインスタンスであるという宣言は instance Eq (List a) where Nil == Nil = True Cons x xs == Cons y ys = xs == ys _ == _ = False のようなインスタンス宣言になります。これは、(List a)が Eq のインスタンス ということですね。一方、Functor のインスタンスであるという宣言は instance Functor List where fmap f Nil = Nil fmap f (Cons x xs) = Cons (f x) (fmap f xs) これは、型構築子 List が Functor クラスであるという宣言になります。 このように見ると、型構築子クラスは型クラスに比べて抽象度が高いと いえますね。
SOE 18.4 State Monadsをみながら、 自作のListの要素に連番を付けるプログラムを書いてみる。 いちおう動くが、まだ納得していない。
\begin{code}
module Main where
data Lst a = Val a | Lst a (Lst a) deriving (Show, Eq)
numbering :: Lst a -> Lst Integer
numbering l = fst (numb l 0)
where
numb :: Lst a -> Integer -> (Lst Integer, Integer)
numb (Val a) n =
let
n' = n + 1
ls' = Val n'
in
(ls', n')
numb (Lst a ls) n =
let
n' = n + 1
(ls', n'') = numb ls n'
ls'' = Lst n' ls'
in
(ls'', n'')
a0 = Val "A"
a1 = Lst "A" (Lst "B" (Lst "C" (Val "D")))
b0 = numbering a0
b1 = numbering a1
newtype Numbering a = Numbering (Integer -> (a, Integer))
instance Monad Numbering where
return a
= Numbering (\s -> (a, s))
Numbering ls0 >>= fls1
= Numbering $ \s0 ->
let
(a1, s1) = ls0 s0
Numbering ls1 = fls1 a1
in
ls1 s1
mnumbering :: Lst a -> Lst Integer
mnumbering t =
let
Numbering nt = mnumb t
in fst (nt 0)
mnumb :: Lst a -> Numbering (Lst Integer)
mnumb (Val a) = do
n <- getNumber
return (Val n)
mnumb (Lst a ls) = do
na <- getNumber
nls <- mnumb ls
return (Lst na nls)
getNumber :: Numbering Integer
getNumber = Numbering (\ n -> (n+1, n+1))
c0 = mnumbering a0
c1 = mnumbering a1
\end{code}
Main> a0 Val "A" Main> a1 Lst "A" (Lst "B" (Lst "C" (Val "D"))) Main> b0 Val 1 Main> b1 Lst 1 (Lst 2 (Lst 3 (Val 4))) Main> c0 Val 1 Main> c1 Lst 1 (Lst 2 (Lst 3 (Val 4)))
Functorを考えるとき、なれないと、fを関数だと思ってしまう。 これって型なんですよね。
class Functor f where
fmap :: (a -> b) -> f a -> f b
気持ちはこう。
class Functor t where
fmap :: (a -> b) -> t a -> t b
以下は、 >>= の型を理解したから、型のエラーはしなくなったけれど、
何をやりたいか今ひとつわかっていないプログラム。
\begin{code}
module Main where
data Myvar a = Myvar a deriving (Show,Eq)
add :: Integer -> Myvar Integer -> Myvar Integer
add n (Myvar x) = Myvar (n + x)
makeVar :: Integer -> Myvar Integer
makeVar = \ n -> Myvar n
instance Monad Myvar where
(Myvar x) >>= k = k x
return x = Myvar x
a0 = Myvar 0
a1 = Myvar 1
a2 = Myvar 2
b1 = add 1 a0
b2 = makeVar 123
t = do
x <- a0
y <- add 1 a0
z <- add 2 a2
return (x,y,z)
\end{code}
Main> a0 Myvar 0 Main> a1 Myvar 1 Main> a2 Myvar 2 Main> b1 Myvar 1 Main> b2 Myvar 123 Main> t Myvar (0,1,4)
…もう一回State Monadを勉強しなおそう…。
たとえば、
instance Eq MyType where ...
のようにしてMyTypeをEqのインスタンスにすると、 MyType型の値に対してEqのoperationである(==)が使えることになる （使えるようにMyTypeに対して (==) を定義しなければならない）。
それと同じように、
instance Monad MyType where ...
のようにしてMyTypeをMonadのインスタンスにすると、 MyType型の値に対してMonadのoperationである(>>=)やreturnやfailが使えることになる （使えるようにMyTypeに対して定義しなければならない）。
「Eqのインスタンスにしたい」という欲求はわかりやすい。等値性を判定したいっていうことだからね。 では「Monadのインスタンスにしたい」というのはどういう気持ちなのだろう。 これまで学んだところからすると、
return
>>=
>>
fail
という感じのような気がする。 でも、私の感じはここで足踏みしている。どこでひっかかっているかというと、 「型」を抽象的にとらえたまま操作するところでひっかかっているようだ。
たとえば、return の型は、 a -> m a である。
これは汎用的な型から、自分が注目している型への変換関数である。
何だかこれって return というよりも make って感じがするんですう。
>>= の型は、 m a -> (a -> m b) -> m b である。
つまり x >>= y となっていたら、 x :: m a であり、
y :: (a -> m b) だ。
xはいま注目している型で、yは、いま注目している型の元の型から、m bっていうのは、
ええと…。このあたりだな。 m a というのは、汎用の型aを元に作った私の型。
たとえば自分がListxを作っていたら、Listx aのことだ。
m b というのは、別の（同じでもいい）型bを元に作った私の型。
たとえば自分がListxを作っていたら、Listx bのことだ。
自分がpolymorphicな型を作っているっていうことを忘れちゃうんだな。
a --------------> Listx a
|
|
---------------------
|
v
b -------------> Listx b
>>= というのは「Listx a」と「a から Listx b」の関数を引数にとって「Listx b」を作るんだな。
うーん。処理の流れを値で追うと、最初の処理の結果はListx a型、次の処理の結果はListx b型だな。
でその遷移を引き起こしているのがa -> Listx b型の関数なんだ。たぶん。
あ、わかったぞ。 >>= というのは、きっと最初の処理の結果Listx a型の値から、包まれていないa型の値を取り出し、
それをa -> Listx b型の引数に渡してやる仕組みなんだ！
SOE 12.2 (p.152)より引用：
Polymorphism captures similar structure over different values, while type classes capture similar operations over different structures.
（polymorphismは異なる値に共通の構造をとらえるのに対し、 type classは異なる構造に共通の操作をとらえる）
このあと、例としてListとEqを挙げている。
多態的なListは、数の列、文字の列、×××の列という「共通の構造」をとらえている。
一方Eqは、数の等価性チェック、文字の等価性チェック、×××の等価性チェックという「共通の操作」をとらえている。
モナドの中身に入る前に、形式的な部分でしょっちゅうエラーになって頭が痛い。
SOE 18.2 The Monad Classをちらちらのぞきながら、
エラーを起こさない小さなMonadのインスタンスを作ってみる。
でもって、t0〜t5では自分の理解を試すためにさまざまな置き換えを試みる。
さらに、b1, b2ではちゃんとGenericな型aについて同じことができることを確かめる。
ここまで至るだけですでに頭がかなり痛くなっているけれど… (^_^;
\begin{code}
module Main where
data Myvar a = Myvar a deriving (Show,Eq)
instance Monad Myvar where
(>>=) (Myvar x) k = k x
return x = Myvar x
a0 = Myvar 0
a1 = Myvar "hello"
a2 = Myvar 3.14
-- return is a constructor
c0 = \x -> Myvar x
t0 = (>>=) a0 c0
t1 = a0 >>= c0
t2 = a0 >>= (\x -> Myvar x)
t3 = do { x <- a0; return x }
t4 = (Myvar 0) >>= (\x -> Myvar x)
t5 = do { x <- Myvar 0; return x }
b1 = do { x <- a1; return x }
b2 = do { x <- a2; return x }
\end{code}
Main> t0 Myvar 0 Main> t1 Myvar 0 Main> t2 Myvar 0 Main> t3 Myvar 0 Main> t4 Myvar 0 Main> t5 Myvar 0 Main> b1 Myvar "hello" Main> b2 Myvar 3.14
SOE 18.1 The Functor Classを元に、自作のリスト版のfmapを作ってみる。
class Functor f where
fmap :: (a -> b) -> f a -> f b
なので、fのところに型Listxを持ってきてinstanceを作ると、
fmap :: (a -> b) -> Listx a -> Listx b
というのが作れる。a -> bである関数を、
構造の中に送り込むことができるわけだ。
a -> bである関数を使って、
Listx a -> Listx bという関数を作れるとも考えられる。
非常に深いレベルでの「再利用」がここにありますね。
つまり、a -> bである関数を作ったら、
ちょっとした工夫で、その関数をさまざまな型に対して適用できるような形にできる、と。
「これとこれは似ている」という人間の感覚を最大限に発揮しているようにも感じます。
\begin{code}
module Main where
data Listx a = Nilx a | Nextx a (Listx a) deriving (Show,Eq)
instance Functor Listx where
fmap f (Nilx x) = Nilx (f x)
fmap f (Nextx x y) = Nextx (f x) (fmap f y)
a0 = Nilx 0
a1 = Nextx 1 (Nilx 0)
a2 = Nextx 2 (Nextx 1 (Nilx 0))
a3 = Nextx 3 (Nextx 2 (Nextx 1 (Nilx 0)))
a4 = Nextx 4 (Nextx 3 (Nextx 2 (Nextx 1 (Nilx 0))))
b0 = fmap (+1) a0
b1 = fmap (+1) a1
b2 = fmap (+1) a2
b3 = fmap (+1) a3
b4 = fmap (+1) a4
c0 = fmap show a0
c1 = fmap show a1
c2 = fmap show a2
c3 = fmap show a3
c4 = fmap show a4
\end{code}
Main> a1 Nextx 1 (Nilx 0) Main> a2 Nextx 2 (Nextx 1 (Nilx 0)) Main> a3 Nextx 3 (Nextx 2 (Nextx 1 (Nilx 0))) Main> a4 Nextx 4 (Nextx 3 (Nextx 2 (Nextx 1 (Nilx 0)))) Main> b0 Nilx 1 Main> b1 Nextx 2 (Nilx 1) Main> b2 Nextx 3 (Nextx 2 (Nilx 1)) Main> b3 Nextx 4 (Nextx 3 (Nextx 2 (Nilx 1))) Main> b4 Nextx 5 (Nextx 4 (Nextx 3 (Nextx 2 (Nilx 1)))) Main> c0 Nilx "0" Main> c1 Nextx "1" (Nilx "0") Main> c2 Nextx "2" (Nextx "1" (Nilx "0")) Main> c3 Nextx "3" (Nextx "2" (Nextx "1" (Nilx "0"))) Main> c4 Nextx "4" (Nextx "3" (Nextx "2" (Nextx "1" (Nilx "0"))))
(+1)のほうは、a -> bでaとbが同じ型の例。
showのほうは、a -> bでaとbが違う型の例。
何だかこんな図を書きたくなりますね。
a ------> b
| |
| |
v v
f a -----> f b
もう少し具体的に書くと、こんな感じ。
show a
a ---------------> String
| |
| |
| |
v v
Listx a -------------> Listx String
fmap show (Listx a)
nobsunからコメントをいただきました。楽しいですね (^_^)
nobsunから
結城さん
楽しいので、またまた、コメントです。
head . take 1 と head は同等ですし、 drop 1 と tail は同等なので
lastone = head . reverse
droplastone = reverse . tail . reverse
でよいかも。
GEB をちらっと読んで、pq システムを書いてみました。
\begin{code}
wellFormed :: String -> Maybe (String,String,String)
wellFormed s
= case span ('-'==) s of
(hs@('-':_),'p':rs)
-> case span ('-'==) rs of
(hs'@('-':_),'q':rs')
-> case span ('-'==) rs' of
(hs''@('-':_),[])
-> Just (hs,hs',hs'')
_ -> Nothing
_ -> Nothing
_ -> Nothing
isTheorem :: String -> Maybe Bool
isTheorem s
= case wellFormed s of
Nothing -> Nothing
Just hs -> Just $ prove hs
where
prove (xs,ys,zs)
= not (null ys || null zs)
&&
((sub zs xs == "-") && ys == "-" -- 公理
||
prove (xs,droplast ys, droplast zs)) -- 生成規則
sub [] _ = []
sub xs [] = xs
sub (_:xs) (_:ys) = sub xs ys
droplast = reverse . tail . reverse
isTheorem' :: String -> Maybe Bool
isTheorem' s
= case wellFormed s of
Nothing -> Nothing
Just hs -> Just $ interp hs
where
interp (hs,hs',hs'') = length hs + length hs' == length hs''
\end{code}
『ゲーデル・エッシャー・バッハ』の「pqシステム」(p.63)を参考にしている。
以下の関数proveは、与えられた文字列がpqシステムにおける「定理」であるかを調べる。
\begin{code}
module Main where
prove :: String -> Bool
prove "pq" = True
prove ('-':xs) | lastone xs == '-' = (prove . droplastone) xs
prove ('p':'-':xs) | lastone xs == '-' = (prove . ((:) 'p') . droplastone) xs
prove _ = False
lastone :: [a] -> a
lastone = head . (take 1) . reverse
droplastone :: [a] -> [a]
droplastone = reverse . (drop 1) . reverse
-- 定理であるもの
t1 = prove "pq"
t2 = prove "p-q-"
t3 = prove "-pq-"
t4 = prove "-p-q--"
t5 = prove "--p-q---"
t6 = prove "--p--q----"
ts = [t1,t2,t3,t4,t5,t6]
-- 定理でないもの
f1 = prove "-pq"
f2 = prove "-p-q-"
f3 = prove "-p--q-"
f4 = prove "--p-q-"
f5 = prove "--p--q---"
f6 = prove "--p-p-q----"
fs = [f1,f2,f3,f4,f5,f6]
\end{code}
Main> ts [True,True,True,True,True,True] Main> fs [False,False,False,False,False,False]
SOE 5.1 Polymorphic Types
JavaがJ2SE 1.5でやっとできるようになったことは、 とうの昔にHaskellでできていたわけですな。 …と書くのはcorrectだけれどfairではないか。
\begin{code}
module Main where
-- SOE 5.1 Polymorphic Types
mylength :: [a] -> Integer
mylength [] = 0
mylength (x:xs) = 1 + mylength xs
-- mylengthはどんな型のリストに対しても使える
a1 = mylength [1,2,3,4,5,6]
a2 = mylength ['A'..'F']
a3 = mylength [a1,a2,a3,a1,a2,a3]
-- SOE 5.2 Abstraction Over Recursive Definitions
mymap :: (a -> b) -> [a] -> [b]
mymap f [] = []
mymap f (x:xs) = f x : mymap f xs -- Recursion
mydouble :: [Integer] -> [Integer]
mydouble = mymap (*2) -- Recursionはmymapの中に隠されている
b1 = mydouble [1..6]
\end{code}
Main> a1 6 Main> a2 6 Main> a3 6 Main> b1 [2,4,6,8,10,12]
しかし、モナドはまだ分からない。 というか、モナド以前に、 高階関数をちゃんと理解していないような気がする。 つまりは「関数というもの」を分かっていないんですね。 このあたり、じっくり掘り下げてみると、 想像している以上に豊かなものがぞくぞく出てきそうな予感。 分からないことがまだまだ多いけれど、 いまは分からないことを楽しんでいる。
KnuthのThings a Computer Scientist Rarely Talks AboutのLecture 6で、
Coping with finitenessという記事の話題が出ていたのでGoogleで探してみる。
すると、sampou.orgの
MLの記事が見つかる。何だかこのあたりの話題を巡っていると、
いつもsampou.orgに戻ってくるような (^_^; 。
www.haskell.org/soe/graphics.htmの記事によると、SOEと最新のHugsには互換でない部分があるので、 Nov2002の版を使いなさいとのこと。ふむふむ。
http://cvs.haskell.org/Hugs/pages/downloading-Nov2002.htmから、以下のファイルをダウンロードしてインストール。
GraphicsLib.msi hugs98-Nov2002.msi SOE.msi
The Haskell School of Expression (SOE)がアマゾンから届いた。
\begin{code}
module Main where
-- from SOE 14.1
twos = 2:twos
-- Try.
data Sheep = Sheep deriving Show
sheep = Sheep : sheep
a1 = take 10 twos
a2 = take 10 sheep
-- from SOE 14.1
fib1 :: Integer -> Integer
fib1 0 = 1
fib1 1 = 1
fib1 n = fib1 (n-1) + fib1 (n-2)
fibs1 :: [Integer]
fibs1 = fiblist1 0
where
fiblist1 n = (fib1 n) : fiblist1 (n+1)
fibs2 :: [Integer]
fibs2 = 1:1:zipWith (+) fibs2 (tail fibs2)
a3 = take 25 fibs1 -- very slow.
a4 = take 25 fibs2 -- fast.
\end{code}
Main> a1 [2,2,2,2,2,2,2,2,2,2] Main> a2 [Sheep,Sheep,Sheep,Sheep,Sheep,Sheep,Sheep,Sheep,Sheep,Sheep] Main> a3 [1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711, 28657,46368,75025] Main> a4 [1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711, 28657,46368,75025]
無限ストリームと交代級数によるπの近似に対してnobsunからのコメントをいただきました。 何だか個人添削されているみたいで感激しちゃいます。 PreludeやListもちゃんと読まなくっちゃ。
nobsunから
make_tableau の定義が SICP とすこしだけ相違がありますね。 結城さんの版 make_tablau :: ([Double] -> [Double]) -> [Double] -> [[Double]] make_tablau trans [] = [] make_tablau trans s@(x:xs) = (trans s) : (make_tablau trans (trans s)) SICP版 make_tableau :: ([Double] -> [Double]) -> [Double] -> [[Double]] make_tableau trans s = s : make_tablau trans (trans s) 与える sequence の長さは気にする必要はないですよね。 SICP版では、オリジナルの sequence が保存されています。 Haskell では、Prelude に iterate という、そのまんま使える高階関数が 定義されています。リスト上の再帰関数を定義するときには、Prelude や 標準ライブラリの List で定義されているリスト関連の高階関数が使えないか 探してみるのも楽しいですよ。経験から言うと殆どの場合、既に定義されている 高階関数が使えます。こうした高階関数は、(リスト上の)再帰関数を定義するときの 一種のデザインパターンと思ってもいいかもしれませんね。 以下は高階関数を使った定義です。 明示的な再帰定義があらわれていないのが楽しいですよね。
import List pis :: [Double] pis = map (4*) $ scanl bop 1.0 [1..] where bop s i = s + (-1)^^i / (2*fromInteger i+1) -- contElems は http://www.hyuki.com/haskell/20041223110550 にあった、f です。 contElems :: Int -> [a] -> [[a]] contElems n = (!! n) . transpose . map inits . tails type Transformer = [Double] -> [Double] eulerTrans :: Transformer eulerTrans = map trans . contElems 3 where trans [s0,s1,s2] = s2 - (s2 - s1)^^2 / (s0 - 2*s1 + s2) makeTableau :: Transformer -> [Double] -> [[Double]] makeTableau = iterate accelerate :: Transformer -> Transformer accelerate trans = map head . makeTableau trans showStream :: Show a => Int -> [a] -> IO () showStream n = mapM_ putStrLn . map show . take n t0 = showStream 5 pis t1 = showStream 5 $ eulerTrans pis t2 = showStream 5 $ iterate eulerTrans pis !! 2 t3 = showStream 5 $ iterate eulerTrans pis !! 3 t4 = showStream 5 $ accelerate eulerTrans pis
以下はSICP 3.5.3を元にしている。
$\pi / 4 = 1 - (1/3) + (1/5) - (1/7) + (1/9) - \cdots$ を使って円周率を近似する。 その際に、Eulerによる「並び加速」を使って収束の速度を上げる。 最後にストリームのストリーム(タブロー)を使う。
\begin{code}
module Main where
pi_sums :: Double -> Double -> [Double]
pi_sums sgn n = (sgn / n) : (pi_sums (-sgn) (n + 2))
partial_sums :: [Double] -> [Double]
partial_sums xss = psum 0 xss
where
psum s [] = []
psum s (x:xs) = (s + x) : psum (s + x) xs
pi_stream :: [Double]
pi_stream = map (*4.0) (partial_sums (pi_sums 1.0 1.0))
display_stream [] = putStr ""
display_stream (x:xs) = do
putStrLn $ show x
display_stream xs
euler_transform1 :: [Double] -> [Double]
euler_transform1 (s0:s1:s2:xs) = (s2 - ((s2-s1)^2 / (s0-2*s1+s2))) : (euler_transform1 xs)
euler_transform2 = euler_transform1 . euler_transform1
euler_transform3 = euler_transform2 . euler_transform1
make_tablau :: ([Double] -> [Double]) -> [Double] -> [[Double]]
make_tablau trans [] = []
make_tablau trans s@(x:xs) = (trans s) : (make_tablau trans (trans s))
accel_seq :: ([Double] -> [Double]) -> [Double] -> [Double]
accel_seq trans [] = []
accel_seq trans s = map head (make_tablau trans s)
euler_transformX = accel_seq euler_transform1
t0 = display_stream $ take 5 $ pi_stream
t1 = display_stream $ take 5 $ euler_transform1 pi_stream
t2 = display_stream $ take 5 $ euler_transform2 pi_stream
t3 = display_stream $ take 5 $ euler_transform3 pi_stream
t4 = display_stream $ take 5 $ euler_transformX pi_stream
\end{code}
Main> t0 4.0 2.66666666666667 3.46666666666667 2.8952380952381 3.33968253968254 Main> t1 3.16666666666667 3.13968253968254 3.14207181707182 3.1414067184965 3.14168318920776 Main> t2 3.14187746961483 3.14158972263034 3.14159290941745 3.14159260392652 3.14159266804457 Main> t3 3.14159287451049 3.1415926529004 3.14159265361311 3.14159265358745 3.14159265359021 Main> t4 3.16666666666667 3.14187746961483 3.14159287451049 3.14159265361083 3.14159265358979
状態を明示的に持たせる練習をもう一度。 まずは状態を変化させずにただ伝播させていく練習。
\begin{code}
module Main where
data Bit = Ot | It deriving (Show,Eq)
a0 = Ot
a1 = It
bitnot :: Bit -> Bit
bitnot Ot = It
bitnot It = Ot
b0 = [Ot,It,Ot,It]
b1 = map bitnot b0
mapWithState :: ( Bit -> state -> ( Bit , state))
-> [Bit] -> state -> ([Bit], state)
mapWithState f [] state = ([], state)
mapWithState f (x:xs) state = ((y:ys), state')
where
(y, s) = f x state -- process x
(ys, state') = mapWithState f xs s -- process xs
bitnotWithState :: Bit -> state -> (Bit, state)
bitnotWithState Ot state = (It, state)
bitnotWithState It state = (Ot, state)
c1 = mapWithState bitnotWithState b0 12345
\end{code}
Main> a0 Ot Main> a1 It Main> b0 [Ot,It,Ot,It] Main> b1 [It,Ot,It,Ot] Main> c1 ([It,Ot,It,Ot],12345)
nobsunから、 連想リスト絡みでまた楽しいメールをいただきました。
nobsunから
結城さんの記事にいろいろとinspireされています。 連想リストですが、こんなfunctionalのも面白いとおもいませんか。
type Table a b = a -> Maybe b emptyTable :: Eq a => Table a b emptyTable = const Nothing myAssign :: Eq a => Table a b -> a -> b -> Table a b myAssign tbl k v x = if k == x then Just v else tbl x myLookup :: Eq a => Table a b -> a -> Maybe b myLookup = id makeTable :: Eq a => [(a, b)] -> Table a b -- makeTable = foldr (\ ent tbl -> uncurry (myAssign tbl) ent) emptyTable -- makeTable = foldr (\ ent tbl -> flip uncurry ent $ myAssign tbl) emptyTable -- makeTable = foldr (\ ent -> flip uncurry ent . myAssign) emptyTable -- makeTable = foldr (\ ent -> (.) (flip uncurry ent) myAssign) emptyTable -- makeTable = foldr (\ ent -> flip (.) myAssign (flip uncurry ent)) emptyTable -- makeTable = foldr (\ ent -> flip (.) myAssign $ flip uncurry $ ent) emptyTable makeTable = foldr (flip (.) myAssign . flip uncurry) emptyTable a1 = makeTable $ zip "abcdefg" [1..] a2 = myAssign a1 'A' 10 a3 = myAssign a1 'd' 50 f1 = myLookup a1 'c' f2 = myLookup a1 'x' f3 = myLookup a2 'A' f4 = myLookup a1 'd' f5 = myLookup a3 'd'
明にstateを扱うmapListStateでは、関数のシグニチャがぐちゃぐちゃになるので、
新しくState st aというtype synonymを使って簡略化する。
bindStateを使って「現在の処理結果」を後ろに続くラムダ式の仮引数にバインドする？
そうすると「順序良く」計算結果を送っていくことができる？
そして作ったのがmapListStateMである？
期待通りに動いているんだが、なぜ動くのかまだよく分かっていない。
うう、もどかしい。 あとちょっとでモナドにたどりつきそうなのだけれど、よくわからん。
\begin{code}
module Main where
-- 1. List
data List a = End | Next a (List a) deriving Show
-- 2. List example
a1 = End
a2 = Next 1 (Next 2 (Next 3 End))
a3 = Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End)))))
-- 3. mapList
mapList :: ( a -> b)
-> List a -> List b
mapList f End = End
mapList f (Next a ls) = Next b ls'
where
b = f a
ls' = mapList f ls
-- 4. mapList example
f1 = (+1)
f2 = (*2)
b1 = mapList f1 a1
b2 = mapList f1 a2
b3 = mapList f2 a3
-- 5. mapListState
mapListState :: ( a -> state -> ( b, state))
-> List a -> state -> (List b, state)
mapListState g End state = (End, state)
mapListState g (Next a ls) state = (Next b ls', state'')
where
(b, state' ) = g a state
(ls', state'') = mapListState g ls state'
-- 6. mapListState example
g1 x state = (f1 x, (state+x))
c1 = mapListState g1 a1 0
c2 = mapListState g1 a2 0
c3 = mapListState g1 a3 100
-- 7. State
type State st a = st -> (a, st)
returnState :: a -> State st a
returnState a = \ st -> (a, st)
bindState :: State st a -> (a -> State st b) ->
State st b
bindState m k = \ st ->
let (a, st') = m st
m' = k a
in m' st'
-- 8. mapListStateM
mapListStateM :: ( a -> State st b )
-> List a -> State st (List b)
mapListStateM h End = returnState End
mapListStateM h (Next a as) =
h a `bindState` \ b ->
mapListStateM h as `bindState` \ bs ->
returnState (Next b bs)
-- 9. mapListStateM example
h1 a = \ st -> ((f1 a), (st+a))
d1 = mapListStateM h1 a1 0
d2 = mapListStateM h1 a2 0
d3 = mapListStateM h1 a3 100
\end{code}
確かにc1, c2, c3とd1, d2, d3が同じ結果になっている。
Main> a1 End Main> a2 Next 1 (Next 2 (Next 3 End)) Main> a3 Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End))))) Main> b1 End Main> b2 Next 2 (Next 3 (Next 4 End)) Main> b3 Next 2 (Next 4 (Next 6 (Next 8 (Next 10 (Next 12 End))))) Main> c1 (End,0) Main> c2 (Next 2 (Next 3 (Next 4 End)),6) Main> c3 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 (Next 7 End))))),121) Main> d1 (End,0) Main> d2 (Next 2 (Next 3 (Next 4 End)),6) Main> d3 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 (Next 7 End))))),121)
自分が本当に理解しているか試すため、 (state, a)を(a, state)にしてみた。
\begin{code}
module Main where
-- 1. List
data List a = End | Next a (List a) deriving Show
-- 2. List example
a1 = End
a2 = Next 1 (Next 2 (Next 3 End))
a3 = Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End)))))
-- 3. mapList
mapList :: ( a -> b)
-> List a -> List b
mapList f End = End
mapList f (Next a ls) = Next b ls'
where
b = f a
ls' = mapList f ls
-- 4. mapList example
f1 = (+1)
f2 = (*2)
b1 = mapList f1 a1
b2 = mapList f1 a2
b3 = mapList f2 a3
-- 5. mapListState
mapListState :: ( a -> state -> ( b, state))
-> List a -> state -> (List b, state)
mapListState g End state = (End, state)
mapListState g (Next a ls) state = (Next b ls', state'')
where
(b, state' ) = g a state
(ls', state'') = mapListState g ls state'
-- 6. mapListState example
g1 x state = (f1 x, (state+x))
c1 = mapListState g1 a1 0
c2 = mapListState g1 a2 0
c3 = mapListState g1 a3 100
\end{code}
Main> a1 End Main> a2 Next 1 (Next 2 (Next 3 End)) Main> a3 Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End))))) Main> b1 End Main> b2 Next 2 (Next 3 (Next 4 End)) Main> b3 Next 2 (Next 4 (Next 6 (Next 8 (Next 10 (Next 12 End))))) Main> c1 (End,0) Main> c2 (Next 2 (Next 3 (Next 4 End)),6) Main> c3 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 (Next 7 End))))),121)
Yet Another Haskell Tutorial の 9.3 A Simple State Monad を元にして、 リストを作り、状態を手で入れるとどれだけ大変になるかをまず確認する。 mapListとmapListStateの定義がちょうどパラレルになり、どこにstateが張り付いているか 分かりやすいように書く。
\begin{code}
module Main where
-- 1. List
data List a = End | Next a (List a) deriving Show
-- 2. List example
a1 = End
a2 = Next 1 (Next 2 (Next 3 End))
a3 = Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End)))))
-- 3. mapList
mapList :: ( a -> b)
-> List a -> List b
mapList f End = End
mapList f (Next a ls) = Next b ls'
where
b = f a
ls' = mapList f ls
-- 4. mapList example
f1 = (+1)
f2 = (*2)
b1 = mapList f1 a1
b2 = mapList f1 a2
b3 = mapList f2 a3
-- 5. mapListState
mapListState :: ( a -> state -> (state, b))
-> List a -> state -> (state, List b)
mapListState g End state = (state, End)
mapListState g (Next a ls) state = (state'', Next b ls')
where
(state', b) = g a state
(state'', ls') = mapListState g ls state'
-- 6. mapListState example
g1 x state = ((state+x), (x+1))
c1 = mapListState g1 a1 0
c2 = mapListState g1 a2 0
c3 = mapListState g1 a3 100
\end{code}
Main> a1 End Main> a2 Next 1 (Next 2 (Next 3 End)) Main> a3 Next 1 (Next 2 (Next 3 (Next 4 (Next 5 (Next 6 End))))) Main> b1 End Main> b2 Next 2 (Next 3 (Next 4 End)) Main> b3 Next 2 (Next 4 (Next 6 (Next 8 (Next 10 (Next 12 End))))) Main> c1 (0,End) Main> c2 (6,Next 2 (Next 3 (Next 4 End))) Main> c3 (121,Next 2 (Next 3 (Next 4 (Next 5 (Next 6 (Next 7 End))))))
手作りのリスト。
\begin{code}
module Main where
data Listx = Nilx | Consx Listx Listx | Atomx String deriving (Eq)
-- show
instance Show Listx where
show Nilx = "()"
show (Atomx s) = s
show l = "(" ++ showcdr l
where
showcdr :: Listx -> String
showcdr Nilx = " )"
showcdr (Consx car cdr) = " " ++ show car ++ showcdr cdr
showcdr (Atomx s) = " . " ++ s ++ " )"
-- take
takex :: Int -> Listx -> Listx
takex n (Consx car cdr) | n > 0 = (Consx car (takex (n-1) cdr))
takex _ _ = Nilx
-- drop
dropx :: Int -> Listx -> Listx
dropx n x@(Consx car cdr) | n > 0 = dropx (n-1) cdr
| otherwise = x
dropx _ _ = Nilx
-- car
carx :: Listx -> Maybe Listx
carx (Consx car cdr) = Just car
carx x = Nothing
-- cdr
cdrx :: Listx -> Maybe Listx
cdrx (Consx car cdr) = Just cdr
cdrx x = Nothing
nil = Nilx
alice = Atomx "Alice"
bob = Atomx "Bob"
chris = Atomx "Chris"
a1 = Consx alice nil
a2 = Consx bob nil
a3 = Consx chris nil
a4 = Consx alice (Consx bob nil)
a5 = Consx alice bob
a6 = Consx alice (Consx bob (Consx chris nil))
a7x = Consx alice a7x -- infinite loop
a7 = takex 10 a7x
a8 = dropx 2 a6
b1 = carx a6
b2 = cdrx a6
\end{code}
Main> a1 ( Alice ) Main> a2 ( Bob ) Main> a3 ( Chris ) Main> a4 ( Alice Bob ) Main> a5 ( Alice . Bob ) Main> a6 ( Alice Bob Chris ) Main> a7 ( Alice Alice Alice Alice Alice Alice Alice Alice Alice Alice ) Main> a8 ( Chris ) Main> b1 Just Alice Main> b2 Just ( Bob Chris )
何となく無限列。
\begin{code}
module Main where
a1 = take 10 [1..]
a2 = take 10 $ enumFrom 1
a3 = enumFromTo 1 10
a4 = enumFromThenTo 1 2 10
b1 = take 10 $ enumFromThen 0 0
b2 = take 10 $ 1:(enumFromThen 0 0)
c1 = foldr (+) 0 [1..10]
c2 = foldr (*) 1 [1..10]
d1 = zip [1..10] [2..11]
d2 = zipWith (+) [1..10] [2..11]
d3 = take 10 $ zipWith (+) [1..] [2..]
fib1 0 = 0
fib1 1 = 1
fib1 n = fib1 (n-1) + fib1 (n-2)
fib2 0 = 0 : (fib2 1)
fib2 1 = 1 : (fib2 2)
fib2 n = zipWith (+) (fib2 (n-1)) (fib2 (n-2))
\end{code}
Main> a1 [1,2,3,4,5,6,7,8,9,10] Main> a2 [1,2,3,4,5,6,7,8,9,10] Main> a3 [1,2,3,4,5,6,7,8,9,10] Main> a4 [1,2,3,4,5,6,7,8,9,10] Main> b1 [0,0,0,0,0,0,0,0,0,0] Main> b2 [1,0,0,0,0,0,0,0,0,0] Main> c1 55 Main> c2 3628800 Main> d1 [(1,2),(2,3),(3,4),(4,5),(5,6),(6,7),(7,8),(8,9),(9,10),(10,11)] Main> d2 [3,5,7,9,11,13,15,17,19,21] Main> d3 [3,5,7,9,11,13,15,17,19,21] Main> fib1 10 55 Main> fib2 0 [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946 ERROR - Garbage collection fails to reclaim sufficient space
結城から
■クイズ「Haskellで自分自身を出力するプログラムを書け」 結城にはまだ書けないのですが… Perlでは以前書いたことがあります。 以下のようになります。 $q=q(print"\$q=q($q);$q");print"\$q=q($q);$q" これを動かすと、これと同じ文字列を出力します。 > type self.pl $q=q(print"\$q=q($q);$q");print"\$q=q($q);$q" > perl self.pl > out > diff self.pl out Haskellではどうなるんでしょうか。
nobsunから
これは、 $ cat quine.hs main=putStr(x++show x);x="main=putStr(x++show x);x=" $ runhugs quine.hs main=putStr(x++show x);x="main=putStr(x++show x);x=" ですね。 http://www.sampou.org/cgi-bin/haskell.cgi?p=Programming%3a%b6%cc%bc%ea%c8%a2%3a%ca%b8%bb%fa%ce%f3&l=jp#5 にあります。
nobsunより
『Monadのインスタンスはモナド則を満たす』という言明は、ちょっとだけ 注意が必要です。 『「正しく定義された」Monadのインスタンスはモナド則を満たす』あるいは 『Monad クラスのインスタンスは、モナド則を満す「べき」です』というのが 正しいと言明だと思います。 もちろん、ちゃんと定義されたモナドインスタンスではどれも、モナド則を 満していますので、安心して使ってもいいのですが、自分で定義しようとする ときには注意が必要です。 Monad クラスにかぎらず、Haskell のクラス宣言はメソッドの名と型を規定しますが、 残念ながらそのセマンティクスまでは規定できません。 簡単な例で言うと、Eq クラスの宣言では、(==) というメソッドの名前と型を 規定しています。(==) は同値関係の規則(対称律、反射律、推移律)を満す「べき」 ですが、そうでないように、インスタンス宣言しても、処理系にそれをチェック させる方法はありません。それ故、 data JNK = Goo | Choci | Paa instance Eq JNK where Goo == Choci = True Choci == Paa = True Paa == Goo = True _ == _ = False という対称律も反射律も推移律も満さない (==) を持つ、Eq のインスタンスを 宣言することもできてしまいます。こんなの使えませんよね。
shelarcyさんからの情報。
結城からnobsunへ
いまはMonadを読み始めています。 要するにこれは手続きを抽象化しているのではないかと 踏んでいるところです。 成功、失敗、結果を使って次のことをする、1つのことの次に次のことをする…
nobsunから結城へ
> いまはMonadを読み始めています。
> 要するにこれは手続きを抽象化しているのではないかと
> 踏んでいるところです。
するどいですねぇ。結城さんの直観と洞察は、いつも感動します。
(>>=) は (flip ($)) の拡張と看倣せますよね。
> 成功、失敗、結果を使って次のことをする、1つのことの次に次のことをする…
Haskell が現在の仕様になる以前、Gofer という処理系がありました。
(Hugs は Haskell User's Gofer System)
型構築子クラス、モナドIO などは Gofer で最初に実装され、あとから、
Haskell の仕様にとりいれられました。
Gofer では、型構築子クラスがとりいれられたときに、Functor クラス
Monad クラスが定義されました。(これらは現在の Haskell のものと
本質的には同じですが、method 名がちがっていました。)
このとき、List もモナドとして定義されなおしました。
同時に、List Comprehension のセマンティクスが拡張されて
Monad Comprehension と呼ばれました。たとえば、
[ f x y | x <- xs, y <- ys ]
これは、
bind xs (\ x ->
bind ys (\ y ->
unit (f x y)))
の構文糖衣とされました。いまの Monad のメソッド名をつかうと
(>>=) xs (\ x ->
(>>=) ys (\ y ->
return (f x y)))
つまり、
xs >>= (\ x ->
ys >>= (\ y ->
return (f x y)
ですね。昔の bind というメソッド名と、Monad Comprehesion 構文から、
なんとなく、
let
x = ...
y = ...
in
f x y
という let の構文を想像しませんか。
(意味としては、ここでの let は Scheme の let* だとおもってください。)
do構文が採用される以前のころは、
「do」ではなく、「do-let」と呼んだ人(Wadlerだったかなぁ)もいたようです。
今の Haskell に導入さた do 構文で書くと、
do
x <- xs
y <- ys
return (f x y)
となるわけです。Haskellでは計算の順序を指定することはできません。
しかし、束縛の入れ子で、計算の順序づけを模倣することができます。
それで、計算の順序が本質であるような IO に Monad を使うのは理に
かなっているということのようです。
(他にも理由はあるとは思いますが^^;)
ここまでの説明は、あくまでも私の想像や理解ではこうであるということです。
厳密な説明ではありませんし、微妙に間違いの部分もあると思いますが、
なにかのHintになるかもしれないと思って書きました。
ファイルのバイト数を表示する。
\begin{code}
module Main where
import IO
main = doCount
doCount = do
putStrLn "Enter file name:"
filename <- getLine
putStrLn $ "filename = " ++ filename
bracket (openFile filename ReadMode) hClose
countFile
countFile handle = do
contents <- hGetContents handle
putStrLn $ show $ length contents
\end{code}
Main> main Enter file name: libraries/Char.hs filename = libraries/Char.hs 331
3個の要素からなる集合を考え、それらを点(Dot)とする。 2個の異なる点で直線(Line)が決まり、 1個の直線と、それに含まれていない点で平面(Plane)が決まる。 3個の要素を色の三原色になぞらえて表現しようと試みる。 平面は白である。
\begin{code}
module Main where
data Dot = Red | Green | Blue deriving (Eq)
data Line = Line Dot Dot
data Plane = Plane Dot Dot Dot
instance Show Dot where
show Red = "Red"
show Green = "Green"
show Blue = "Blue"
instance Show Line where
show (Line Red Green) = "Yellow"
show (Line Green Blue) = "Cyan"
show (Line Blue Red) = "Purple"
show (Line x y) | x == y = "?"
| otherwise = show (Line y x)
instance Show Plane where
show _ = "White"
instance Eq Line where
(==) (Line p q) (Line p' q') = p == p' && q == q' || p == q' && q == p'
instance Eq Plane where
(==) _ _ = True
newLine :: Dot -> Dot -> Maybe Line
newLine p q | p /= q = Just (Line p q)
| otherwise = Nothing
newPlane :: Dot -> Line -> Maybe Plane
newPlane p l@(Line q r) | l `includes` p = Nothing
| otherwise = Just (Plane p q r)
where
includes :: Line -> Dot -> Bool
includes (Line u v) w = u == w || v == w
intersect :: Line -> Line -> Maybe Dot
intersect l@(Line p q) l'@(Line p' q') | l == l' = Nothing
| p == p' || p == q' = Just p
| q == q' || q == p' = Just q
| otherwise = Nothing
r = Red
g = Green
b = Blue
rb = Line Red Blue
br = Line Blue Red
rg = Line Red Green
mrg = newLine r g
rgb = Plane Red Green Blue
t1 = intersect rb br
t2 = intersect rb rg
t3 = newLine r r
t4 = newLine r g
t5 = newPlane r (Line r g)
t6 = newPlane r (Line g b)
\end{code}
Main> t1 Nothing Main> t2 Just Red Main> t3 Nothing Main> t4 Just Yellow Main> t5 Nothing Main> t6 Just White
気になったのは、たとえば(Line Red Red)というのは直線としては正しくないのだが、
コンストラクタとしては書けてしまうこと。
newLine Red RedはNothingを返せるのだが。
先日のmapに関する記事に対して、nobsunから超絶技巧なお返事をいただきました。
目が回りそうですが、楽しいです。 (^_^;
map の foldr による定義の導出、おみごとですね。
map1 f = foldr ((:) . f) []
ちょっとした変形をおこなうと、引数 f も省略した定義が可能ですね。
map2 = flip foldr [] . ((:) .)
ところで、yts さんによる定義も、accumulation ですね。
map3 f = iter id f
where iter k f [] = k []
iter k f (x:xs) = iter (k . (f x:)) f xs
accumulation は foldl で書きなおすことができます。
map4 f xs = foldl (\ k x -> k . (f x:)) id xs []
こっから先は、パズルになってしまいます。
が、遊べてしまうのが Haskell です。
変形すると引数 xs を省略できて、たとえば、
map5 f = ((flip.).) foldl (flip (.) ((:) . f) . (.)) id []
という定義が可能です。さらに、こんな無茶もできたりします。
map6 = (((flip.).).) (flip.) ((flip.).) foldl id [] . flip (.) (.) . flip (.) . (.) (:)
map5 や map6 をわざわざ作るのは、obscured code contest 用ですね。
でも、このあたりを追及すると、SK-combinatorによる関数の構成という
分野に到達します。unlambda という言語の世界ですね。
ちょっと暴走してしまいましたが、
map のもうすこし別の表現もあげておきましょう。
map7 は比較的良く使うパターンです。
map7 f xs = [f x | x <- xs]
map8 f xs = xs >>= return . f
map だけでこれだけ楽しめてしまうところが、Haskell の面白いところです。
でも、ここでいつまでも遊んでしまって、先へなかなか行けないという
副作用もあります。(^^;)
monadはHaskellの中で難しいところらしい。 難しいという意味ではC言語のポインタのようなものか。
とりあえず、Haskell Reportの6.3.6 The Monad Classをじっと見る。
class Monad m where
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
return :: a -> m a
fail :: String -> m a
m >> k = m >>= \_ -> k
fail s = error s
>>= は、実行結果を次に渡していくものっぽい。
>> は、実行結果を捨てて、次に進むものっぽい。
return は、実行結果を返す。
fail は、エラー。
listとMaybeとIOはMonadクラスのインスタンスらしい。 failは、listでは[], MaybeではNothing、IOでは例外、といわれればなるほどと思うが、まだよくわからない。
Monadのインスタンスは次の規則を満たすそうだ。→満たすように作るべきだそうだ。
return a >>= k = k a m >>= return = m m >>= (\x -> k x >>= h) = (m >>= k) >>= h
>>= が結果を次に渡していくと考えると、
おかしくはないが、なるほど！とはまだ思えない。
doはmonadに関連しているらしい。
\begin{code}
t1 =
putStr "What's your name? " >>
getLine >>= \s ->
putStrLn ("Your name is " ++ s ++ ".") >>
putStr "Do you like Haskell? " >>
getLine >>= \s ->
putStrLn ("Your answer is " ++ s ++ ".")
t2 = do
putStr "What's your name? "
s <- getLine
putStrLn ("Your name is " ++ s ++ ".")
putStr "Do you like Haskell? "
s <- getLine
putStrLn ("Your answer is " ++ s ++ ".")
\end{code}
Main> t1 What's your name? Alice Your name is Alice. Do you like Haskell? Yes Your answer is Yes. Main> t2 What's your name? Alice Your name is Alice. Do you like Haskell? Yes Your answer is Yes.
2chのHaskellスレッド Part3 35より：
a = [0, 1, 2, 3, 4] てなリストがあったとき、 f 3 a => [[0, 1, 2], [1, 2, 3], [2, 3, 4]] といった値を返す関数 f が欲しい
f 3 [0,1,2,3,4] = [[0,1,2],[1,2,3],[2,3,4]] ↓1個くくりだす f 3 [0,1,2,3,4] = [0,1,2]:[[1,2,3],[2,3,4]] ↓cdr部分をfで書く。 f 3 [0,1,2,3,4] = [0,1,2]:(f 3 [1,2,3,4]) ↓左辺も1個くくりだす f (1+2) (0:[1,2,3,4]) = [0,1,2]:(f 3 [1,2,3,4]) ↓[1,2,3,4]をxsにする f (1+2) (0:xs) = [0,1,2]:(f 3 xs)
数字と英文字を分けたほうがわかりやすいので仕切りなおし。
f 3 "abcde" = ["abc","bcd","cde"]
↓1個くくりだす
f 3 ('a':"bcde") = "abc":["bcd","cde"]
↓1個くくりだす
f 3 ('a':"bcde") = ('a':"bc"):["bcd","cde"]
↓xsにして、関数gを導入
f 3 ('a':xs) = ('a':(g 2 xs)) : (f 3 xs)
↓nとxにする
f n (x:xs) = (x:(g (n-1) xs)) : (f (n-1) xs)
うん、ここまで考えたらプログラムに書ける。 やっぱり、small exampleから考えるのはよいなあ。
\begin{code}
module Main where
f :: Int -> [a] -> [[a]]
f _ [] = []
f 0 _ = []
f n (x:xs) | n <= length (x:xs) = (x:(g (n-1) xs)) : (f n xs)
| otherwise = []
where
g :: Int -> [a] -> [a]
g _ [] = []
g 0 _ = []
g k (x:xs) = x : (g (k-1) xs)
t1 = f 3 "abcde"
t2 = f 0 "abcde"
t3 = f 1 "abcde"
t4 = f 5 "abcde"
t5 = f 6 "abcde"
t6 = f 3 ""
\end{code}
Main> t1 ["abc","bcd","cde"] Main> :l l Main> t2 [] Main> t3 ["a","b","c","d","e"] Main> t4 ["abcde"] Main> t5 [] Main> t6 []
takeを使うように変更。
f :: Int -> [a] -> [[a]]
f _ [] = []
f 0 _ = []
f n (x:xs) | n <= length (x:xs) = (x: take (n-1) xs) : (f n xs)
| otherwise = []
otherwiseのあたりを整理する。
f :: Int -> [a] -> [[a]] f n (x:xs) | n <= length (x:xs) = (x: take (n-1) xs) : (f n xs) f _ _ = []
取り出すほうのリストにlengthを使うと無限リストに使えないので直す。
\begin{code}
module Main where
f :: Int -> [a] -> [[a]]
f n (x:xs) | n <= 1 + length ts = (x:ts) : f n xs
where
ts = take (n-1) xs
t1 = take 5 $ f 3 [1..]
t2 = take 5 $ drop 100 $ f 3 [1..]
\end{code}
Main> t1 [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]] Main> t2 [[101,102,103],[102,103,104],[103,104,105],[104,105,106],[105,106,107]]
as patternを使う。
f :: Int -> [a] -> [[a]]
f n as@(x:xs) | n <= length ts = ts : f n xs
where
ts = take n as
Guarded Horn ClauseとGlasgow Haskell Compilerのアクロニムが同じなのは偶然だろうか。
連想リストを作る。
最近のassignが以前のassignを覆い隠すのではなく、同じキーを持っているものを削除している。
どきどきしながらas patternを使っている。
\begin{code}
module Main where
mylookup :: Eq a => [(a,b)] -> a -> Maybe b
mylookup [] _ = Nothing
mylookup ((x',y'):as) x | x' == x = Just y'
| otherwise = mylookup as x
myassign :: Eq a => [(a,b)] -> a -> b -> [(a,b)]
myassign as x y = assign [] as x y
where
assign :: Eq a => [(a,b)] -> [(a,b)] -> a -> b -> [(a,b)]
assign hs [] x y = (x,y) : reverse hs
assign hs (xy'@(x',y'):as) x y | x' == x = (x,y) : reverse hs ++ as
| otherwise = assign (xy':hs) as x y
a1 = zip "abcdefg" [1,2,3,4,5,6,7]
a2 = myassign a1 'A' 10
a3 = myassign a1 'd' 50
f1 = mylookup a1 'c'
f2 = mylookup a1 'x'
f3 = mylookup a2 'A'
f4 = mylookup a1 'd'
f5 = mylookup a3 'd'
\end{code}
Main> a1
[('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]
Main> a2
[('A',10),('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]
Main> a3
[('d',50),('a',1),('b',2),('c',3),('e',5),('f',6),('g',7)]
Main> f1
Just 3
Main> f2
Nothing
Main> f3
Just 10
Main> f4
Just 4
Main> f5
Just 50
自然数を作る。
\begin{code}
module Main where
data Countable = Zero | Succ Countable deriving (Show)
fromCountable :: Countable -> Int
fromCountable Zero = 0
fromCountable (Succ n) = 1 + fromCountable n
toCountable :: Int -> Countable
toCountable 0 = Zero
toCountable n | n > 0 = (Succ (toCountable (n-1)))
add :: Countable -> Countable -> Countable
add x Zero = x
add x (Succ y) = Succ (add x y)
t0 = Zero
t1 = Succ Zero
t2 = Succ (Succ Zero)
t3 = Succ (Succ (Succ Zero))
a0 = fromCountable t0
a1 = fromCountable t1
a2 = fromCountable t2
a3 = fromCountable t3
b0 = toCountable 0
b1 = toCountable 1
b2 = toCountable 2
b3 = toCountable 3
c0 = add Zero Zero
c1 = add (Succ Zero) Zero
c2 = add (Succ Zero) (Succ Zero)
c3 = add c1 c2
\end{code}
Main> t0 Zero Main> t1 Succ Zero Main> t2 Succ (Succ Zero) Main> t3 Succ (Succ (Succ Zero)) Main> a0 0 Main> a1 1 Main> a2 2 Main> a3 3 Main> b0 Zero Main> b1 Succ Zero Main> b2 Succ (Succ Zero) Main> b3 Succ (Succ (Succ Zero)) Main> c0 Zero Main> c1 Succ Zero Main> c2 Succ (Succ Zero) Main> c3 Succ (Succ (Succ Zero))
_|_ について考える。
\begin{code}
module Main where
bot = error "bot"
bang n = reverse [1..n] ++ error "bang!"
t1 = bot
t2 = bang 5
t3 = zip (bang 5) "Hello, world!"
\end{code}
Main> t1 Program error: bot Main> t2 [5,4,3,2,1 Program error: bang! Main> t3 [(5,'H'),(4,'e'),(3,'l'),(2,'l'),(1,'o') Program error: bang!
ytsさんから、reverseしないO(n)のmymapを教えていただきました。
\begin{code}
module Main where
mymap f k [] = k []
mymap f k (x:xs) = mymap f (k . (f x:)) xs
\end{code}
Main> mymap show id [1..5] ["1","2","3","4","5"]
うーん、なるほどと言うか、何と言うか。
要するに、以下のような構造を作ったようですね。
((((((id . (show 1:)) . (show 2:)) . (show 3:)) . (show 4:)) . (show 5:)) [])
む。
ということは、foldrが使えるかも。
\begin{code}
module Main where
mymap :: (a -> b) -> [a] -> [b]
mymap f = foldr ((:) . f) []
t = mymap show [1..5]
\end{code}
Main> t ["1","2","3","4","5"]
やたー。
ちなみにこう考えました。
↓small example
mymap f [1,2,3] = [f 1, f 2, f 3]
↓1個くくり出し
mymap f [1,2,3] = (f 1):[f 2, f 3]
↓infix
mymap f [1,2,3] = (:) (f 1) [f 2, f 3]
↓combine
mymap f [1,2,3] = ((:) . f) 1 [2, 3]
↓foldr
mymap f [1,2,3] = foldr ((:) . f) [] [1,2,3]
↓xs
mymap f xs = foldr ((:) . f) [] xs
↓eta reduction
mymap f = foldr ((:) . f) []
楽しいけれど、すっごく頭使う…。
unzipを作る。
\begin{code}
module Main where
myunzip :: [(a,b)] -> ([a],[b])
myunzip zs = f ([],[]) zs
where
f :: ([a],[b]) -> [(a,b)] -> ([a],[b])
f (xs,ys) ((x,y):xys) = f ((x:xs),(y:ys)) xys
f zs _ = zs
f1 = unzip [('H',1),('e',2),('l',3),('l',4),('o',5)]
f2 = unzip [(1,'A'),(2,'B'),(3,'C')]
g1 = myunzip [('H',1),('e',2),('l',3),('l',4),('o',5)]
g2 = myunzip [(1,'A'),(2,'B'),(3,'C')]
\end{code}
Main> f1
("Hello",[1,2,3,4,5])
Main> f2
([1,2,3],"ABC")
Main> g1
("olleH",[5,4,3,2,1])
Main> g2
([3,2,1],"CBA")
あれれ？ unzipは逆順なのか。 Preludeを読んでみよう。
unzip :: [(a,b)] -> ([a],[b]) unzip = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) ([], [])
foldrを使っている。
zipを作る。
\begin{code}
module Main where
myzip :: [a] -> [b] -> [(a,b)]
myzip _ [] = []
myzip [] _ = []
myzip (x:xs) (y:ys) = (x,y):myzip xs ys
f1 = zip "Hello" [1..5]
f2 = zip "Hello" [1..]
f3 = zip [1..] ['A'..'C']
g1 = myzip "Hello" [1..5]
g2 = myzip "Hello" [1..]
g3 = myzip [1..] ['A'..'C']
\end{code}
Main> f1
[('H',1),('e',2),('l',3),('l',4),('o',5)]
Main> f2
[('H',1),('e',2),('l',3),('l',4),('o',5)]
Main> f3
[(1,'A'),(2,'B'),(3,'C')]
Main> g1
[('H',1),('e',2),('l',3),('l',4),('o',5)]
Main> g2
[('H',1),('e',2),('l',3),('l',4),('o',5)]
Main> g3
[(1,'A'),(2,'B'),(3,'C')]
さて、Preludeを読んでみよう。
zip :: [a] -> [b] -> [(a,b)] zip = zipWith (\a b -> (a,b)) zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith z (a:as) (b:bs) = z a b : zipWith z as bs zipWith _ _ _ = []
なるほど。zipWithで2つの要素を組み合わせる「組み合わせ方」も引数に渡すのか。 面白い。
次はdropを作ってみよう。最初のn個を捨てるの。
\begin{code}
module Main where
myDrop :: Int -> [a] -> [a]
myDrop n [] = []
myDrop n xs | n <= 0 = xs
myDrop n (_:xs) = myDrop (n-1) xs
f1 = myDrop (-1) "abc"
f2 = myDrop 0 "abc"
f3 = myDrop 1 "abc"
f4 = myDrop 2 "abc"
f5 = myDrop 3 "abc"
f6 = myDrop 4 "abc"
f7 = myDrop 5 "abc"
g1 = drop (-1) "abc"
g2 = drop 0 "abc"
g3 = drop 1 "abc"
g4 = drop 2 "abc"
g5 = drop 3 "abc"
g6 = drop 4 "abc"
g7 = drop 5 "abc"
\end{code}
Main> f1 "abc" Main> f2 "abc" Main> f3 "bc" Main> f4 "c" Main> f5 "" Main> f6 "" Main> f7 "" Main> g1 "abc" Main> g2 "abc" Main> g3 "bc" Main> g4 "c" Main> g5 "" Main> g6 "" Main> g7 ""
ではPrelude.hsと比べてみましょう。
drop :: Int -> [a] -> [a] drop n xs | n <= 0 = xs drop _ [] = [] drop n (_:xs) = drop (n-1) xs
myDrop :: Int -> [a] -> [a] myDrop n [] = [] myDrop n xs | n <= 0 = xs myDrop n (_:xs) = myDrop (n-1) xs
次はtakeWhileを作ってみよう。
\begin{code}
module Main where
import Char
myTakeWhile :: (a -> Bool) -> [a] -> [a]
myTakeWhile f [] = []
myTakeWhile f (x:xs) | f x = x:(myTakeWhile f xs)
| otherwise = []
f1 = myTakeWhile Char.isLower ""
f2 = myTakeWhile Char.isLower "take"
f3 = myTakeWhile Char.isLower "takeWhile"
f4 = myTakeWhile Char.isLower "takeWhileAgain"
g1 = takeWhile Char.isLower ""
g2 = takeWhile Char.isLower "take"
g3 = takeWhile Char.isLower "takeWhile"
g4 = takeWhile Char.isLower "takeWhileAgain"
\end{code}
Main> f1 "" Main> f2 "take" Main> f3 "take" Main> f4 "take" Main> g1 "" Main> g2 "take" Main> g3 "take" Main> g4 "take"
ではPrelude.hsと比べてみましょう。
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []
myTakeWhile :: (a -> Bool) -> [a] -> [a]
myTakeWhile f [] = []
myTakeWhile f (x:xs) | f x = x:(myTakeWhile f xs)
| otherwise = []
nobsunがsplitAtを使っていたので、自作のmySplitAtを作ってみる。 リストを指定した場所で切ってペアを作るの。
\begin{code}
module Main where
mySplitAt :: Int -> [a] -> ([a],[a])
mySplitAt n [] = ([],[])
mySplitAt 0 xs = ([],xs)
mySplitAt 1 (x:xs) = ([x],xs)
mySplitAt n (x:xs) = (x:hs,ts) where (hs,ts) = mySplitAt (n-1) xs
f1 = mySplitAt 0 "abc"
f2 = mySplitAt 1 "abc"
f3 = mySplitAt 2 "abc"
f4 = mySplitAt 3 "abc"
f5 = mySplitAt 4 "abc"
f6 = mySplitAt 5 "abc"
g1 = splitAt 0 "abc"
g2 = splitAt 1 "abc"
g3 = splitAt 2 "abc"
g4 = splitAt 3 "abc"
g5 = splitAt 4 "abc"
g6 = splitAt 5 "abc"
\end{code}
Main> f1
("","abc")
Main> f2
("a","bc")
Main> f3
("ab","c")
Main> f4
("abc","")
Main> f5
("abc","")
Main> f6
("abc","")
Main> g1
("","abc")
Main> g2
("a","bc")
Main> g3
("ab","c")
Main> g4
("abc","")
Main> g5
("abc","")
Main> g6
("abc","")
動いた動いた。 ちなみに、Hugs 98の「解答」はこうなっていた。
splitAt :: Int -> [a] -> ([a], [a]) splitAt n xs | n <= 0 = ([],xs) splitAt _ [] = ([],[]) splitAt n (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
見比べてみる。
mySplitAt :: Int -> [a] -> ([a],[a]) mySplitAt n [] = ([],[]) mySplitAt 0 xs = ([],xs) mySplitAt 1 (x:xs) = ([x],xs) mySplitAt n (x:xs) = (x:hs,ts) where (hs,ts) = mySplitAt (n-1) xs
ふうむ。
_
結城が書いていたcommaに関して、nobsunからアドバイスをいただきました。 いつもありがとうございます。 以下のプログラムは、メールからの抜粋です。
every :: Int -> [a] -> [[a]] every _ [] = [] every n xs = hs : every n ts where (hs,ts) = splitAt n xs comma = reverse . foldr1 (\ x y -> x++',':y) . every 3 . reverse
import List every n = takeWhile (not . null) . map (take n) . iterate (drop n) comma = reverse . concat . intersperse "," . every 3 . reverse
何だかすごいですね。 関数をvalueとして扱う感覚。
日本でHaskellといえば、nobsunだよね。
メールや投稿フォームで結城のコードにコメントをつけてくださっていたので、 「nobsun先生」と呼称していたが、ご本人より「suffixはつけないで」とのご要望があったので、 今後は「nobsun」と書いて心の中で（先生）と呼ばせていただくことにする。 昨日のcommaにいろいろコメントをいただいているが、もう眠いので、また明日。
Happy Haskell!
さっきのsuffixで、reverseが繰り返し出てくることに気づいて、 pipeという高階関数を定義する解を作ってみました。
\begin{code}
module Main where
prefix, suffix :: Eq a => [a] -> [a] -> [a]
prefix _ [] = []
prefix [] _ = []
prefix (x:xs) (y:ys) | x == y = x:(prefix xs ys)
| otherwise = []
suffix = pipe reverse prefix
where
pipe f g x y = f $ g (f x) (f y)
t1 = suffix [1,2,3,4,5,6] [1,2,3,6,4,5,6]
t2 = suffix [1,2,3,4,5,6] []
t3 = suffix [] [1,2,3,4,5,6]
t4 = suffix "textfile.org" "example.org"
\end{code}
Main> t1 [4,5,6] Main> t2 [] Main> t3 [] Main> t4 "le.org"
suffixはprefixの反対さ!
\begin{code}
module Main where
prefix, suffix :: Eq a => [a] -> [a] -> [a]
prefix _ [] = []
prefix [] _ = []
prefix (x:xs) (y:ys) | x == y = x:(prefix xs ys)
| otherwise = []
suffix x y = reverse $ prefix (reverse x) (reverse y)
t1 = suffix [1,2,3,4,5,6] [1,2,3,6,4,5,6]
t2 = suffix [1,2,3,4,5,6] []
t3 = suffix [] [1,2,3,4,5,6]
t4 = suffix "textfile.org" "example.org"
\end{code}
Main> t1 [4,5,6] Main> t2 [] Main>