開発環境
- OS X Lion - Apple(OS)
- Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
- Haskell (純粋関数型プログラミング言語)
- GHC (The Glasgow Haskell Compiler) (処理系)
『初めてのプログラミング 第2版』(Chris Pine 著、長尾 高弘 訳、オライリー・ジャパン、2010年、ISBN978-4-87311-469-9)の13章(新しいクラスの作成と既存クラスの変更), 13.2(クラスの作り方)、13.3(インスタンス変数)、13.4(newとinitialize)、13.5(ベビードラゴンゲーム)、13.6(練習問題の続き)、対話的ベビードラゴンをHaskellで解いてみる。
その他参考書籍
- プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)
- Real World Haskell―実戦で学ぶ関数型言語プログラミング (オライリージャパン) Bryan O'Sullivan John Goerzen Don Stewart(著) 山下 伸夫 伊東 勝利 株式会社タイムインターメディア(翻訳)
Haskellだと組み込みクラスとかオブジェクトとかRubyと考え方が違うので、前問と同様にとりあえずモジュールを作ったり、自作の新しい型を作ったりしてみる。
対話的ベビードラゴン
コード(BBEdit)
Sample.hs
{-# OPTIONS -Wall -Werror #-}
import Dragon
main :: IO ()
main = do
putStrLn "ベビードラゴンの名前を入力してください。"
line <- getLine
let s = if line == ""
then "匿名"
else line
pet = born s
putStrLn $ s ++ "が生まれました。"
command pet
command :: Dragon -> IO ()
command d = do
putStrLn "コマンドを(feed/walk/bed/toss/rock)を入力: "
line <- getLine
let (e, xs) = case line of
"feed" -> feed d
"walk" -> walk d
"bed" -> putToBed d
"toss" -> toss d
"rock" -> rock d
_ -> (d, ["入力を確認してください"])
mapM_ putStrLn xs
command e
コード(BBEdit)
Dragon.hs
--{-# OPTIONS -Wall -Werror #-}
module Dragon
( Dragon,
born,
feed,
walk,
putToBed,
toss,
rock
) where
data Dragon = Dragon { name :: String,
asleep :: Bool,
stuffInBelly :: Int,
stuffInIntestine :: Int}
born :: String -> Dragon
born [] = Dragon "匿名" False 10 0
born s = Dragon s False 10 0
feed :: Dragon -> (Dragon, [String])
feed (Dragon a b _ c) = (fst $ passageOfTime $ Dragon a b 10 c,
[a ++ "にご飯をあげます。"])
walk :: Dragon -> (Dragon, [String])
walk (Dragon a b c _) = (fst $ passageOfTime $ Dragon a b c 0,
[a ++ "をトイレに連れていきます。"])
putToBed :: Dragon -> (Dragon, [String])
putToBed (Dragon a _ b c) =
let (Dragon d e f g, xs) = loop 3 (Dragon a True b c) []
s = a ++ "を寝かしつけます。"
in if e
then (Dragon d False f g, s:(xs ++ [a ++ "はゆっくり目覚めます。"]))
else (Dragon d e f g, s:xs)
loop :: Int -> Dragon -> [String] -> (Dragon, [String])
loop 0 a xs = (a, xs)
loop n (Dragon a False b c) xs = loop (n - 1) (Dragon a False b c) xs
loop n (Dragon a True b c) xs =
let (Dragon d e f g, ys) = passageOfTime $ Dragon a True b c
in if e
then loop (n - 1)
(Dragon d e f g)
(xs ++ ys ++ [a ++ "がいびきをかいて、部屋が煙だらけです。"])
else loop (n - 1) (Dragon d e f g) $ xs ++ ys
toss :: Dragon -> (Dragon, [String])
toss a = let b = passageOfTime a
c = name a
in (fst b, (c ++ "に高い高いをします。"):
(c ++ "が笑ってあなたの眉毛が焦げます。"):(snd b))
rock :: Dragon -> (Dragon, [String])
rock (Dragon a _ b c) =
let (Dragon d e f g, xs) = passageOfTime $ Dragon a True b c
ys = (a ++ "をやさしくあやします。"):(a ++ "は少し居眠りをします。"):xs
in if e
then (Dragon d False f g, ys ++ ["しかし、やめると起きてしまいます"])
else (Dragon d e f g, ys)
passageOfTime :: Dragon -> (Dragon, [String])
passageOfTime (Dragon a True 0 _) = error $ ('\n':a) ++
"が突然目を覚まします！\n" ++
a ++ "がお腹をすかせています。\n" ++
"我慢できなくてあなたを食べました。"
passageOfTime (Dragon a False 0 _) = error $ ('\n':a) ++
"がお腹をすかせています。\n" ++
"我慢できなくてあなたを食べました。"
passageOfTime (Dragon a b c d) =
let (e, xs) = intestine $ Dragon a b (c - 1) (d - 1)
(f, ys) = hungry e
(g , zs) = poopy f
in (g, xs ++ ys ++ zs)
intestine :: Dragon -> (Dragon, [String])
intestine (Dragon a b c d) | d >= 10 = (Dragon a b c 0,
["うわっ、" ++ a ++ "がお漏らしを…"])
| otherwise = (Dragon a b c d, [])
hungry :: Dragon -> (Dragon, [String])
hungry (Dragon a b c d)
| c <= 2 = let e = a ++ "のお腹が鳴っています。"
xs = if b
then (a ++ "が突然目を覚まします！"):[e]
else [e]
in (Dragon a False c d, xs)
| otherwise = (Dragon a b c d, [])
poopy :: Dragon -> (Dragon, [String])
poopy (Dragon a b c d)
| d >= 8 = let e = a ++ "がうんちのためにしゃがみ込みます。"
xs = if b == True
then (a ++ "が突然目を覚まします！"):[e]
else [e]
in (Dragon a False c d, xs)
| otherwise = (Dragon a b c d, [])
入出力結果(Terminal, runghc)
$ runghc Sample.hs ベビードラゴンの名前を入力してください。 ノーバート ノーバートが生まれました。 コマンドを(feed/walk/bed/toss/rock)を入力: feed ノーバートにご飯をあげます。 コマンドを(feed/walk/bed/toss/rock)を入力: toss ノーバートに高い高いをします。 ノーバートが笑ってあなたの眉毛が焦げます。 コマンドを(feed/walk/bed/toss/rock)を入力: walk ノーバートをトイレに連れていきます。 コマンドを(feed/walk/bed/toss/rock)を入力: bed ノーバートを寝かしつけます。 ノーバートがいびきをかいて、部屋が煙だらけです。 ノーバートがいびきをかいて、部屋が煙だらけです。 ノーバートがいびきをかいて、部屋が煙だらけです。 ノーバートはゆっくり目覚めます。 コマンドを(feed/walk/bed/toss/rock)を入力: rock ノーバートをやさしくあやします。 ノーバートは少し居眠りをします。 しかし、やめると起きてしまいます コマンドを(feed/walk/bed/toss/rock)を入力: bed ノーバートを寝かしつけます。 ノーバートが突然目を覚まします！ ノーバートのお腹が鳴っています。 コマンドを(feed/walk/bed/toss/rock)を入力: bed ノーバートを寝かしつけます。 ノーバートが突然目を覚まします！ ノーバートのお腹が鳴っています。 コマンドを(feed/walk/bed/toss/rock)を入力: bed ノーバートを寝かしつけます。 ノーバートが突然目を覚まします！ ノーバートのお腹が鳴っています。 コマンドを(feed/walk/bed/toss/rock)を入力: bed Sample.hs: ノーバートが突然目を覚まします！ ノーバートがお腹をすかせています。 我慢できなくてあなたを食べました。 $
0 コメント:
コメントを投稿