下のエントリの fold,「ふつケル」の解答例を見たら concatMap を使っていた。なるほど。
Prelude> :t concatMap concatMap :: (a -> [b]) -> [a] -> [b] Prelude> concatMap (replicate 3) "abc" "aaabbbccc"
takatoh's blog – Learning programming languages.
下のエントリの fold,「ふつケル」の解答例を見たら concatMap を使っていた。なるほど。
Prelude> :t concatMap concatMap :: (a -> [b]) -> [a] -> [b] Prelude> concatMap (replicate 3) "abc" "aaabbbccc"
また間があいてしまった。たまには触らないと鈍る――ってほどなれてるわけでもないけど――ので,練習問題をやってみる。
「ふつうのHaskellプログラミング ふつうのプログラマのための関数型言語入門」,p.191 から。
標準入力から読み込んだ各行を幅60バイトに納まるように折り返すコマンド,
foldを書きなさい。単語境界やマルチバイト文字は考えなくて構いません。
問題は60バイトだけど30バイトでやってみた。
module Main (main) where
import System
fold :: Int -> String -> String
fold n cs = let (h, t) = splitAt n cs
in if null t then h else h ++ "\n" ++ fold n t
main :: IO ()
main = do cs <- getContents
putStr $ unlines $ map (fold 30) $ lines cs
結果
>runghc fold.hs < fold.hs
module Main (main) where
import System
fold :: Int -> String -> Strin
g
fold n cs = let (h, t) = split
At n cs
in if null t the
n h else h ++ "\n" ++ fold n
t
main :: IO ()
main = do cs <- getContents
putStr $ unlines $ m
ap (fold 30) $ lines cs
今日で最後だ。のこりの命令「[」と「]」を実装した。
「[」と「]」を実装するには命令の列を行ったり来たりできなきゃいけない。はじめに考えたのは BrainF_ck と同じように,命令のリストと現在位置を示すポインタを持ったデータ型を定義することだった。
けど,考え直して文字列のペアで代用することにした。これを次のように操作する。
で,実装はこのとおり。
type Program = ([Char], [Char])
progNew :: String -> Program
progNew str = ([], str)
progFetch :: Program -> [Char]
progFetch prog = snd prog
progShift :: Program -> Program
progShift (l, (r:rs)) = (l ++ [r], rs)
progUnshift :: Program -> Program
progUnshift (l, r) = (take ((length l) -1) l, (last l):r)
progSkip :: BrainF_ck -> Program -> Program
progSkip bf prog = if bfValue bf == 0 then skip prog else progShift prog
where skip p = if (head $ progFetch next) == ']' then next else skip next
where next = progShift p
progBack :: BrainF_ck -> Program -> Program
progBack bf prog = if bfValue bf == 0 then progShift prog else back prog
where back p = if (head $ progFetch prev) == '[' then prev else back prev
where prev = progUnshift p
でもって,プログラムを走らせる関数 bfRun を導入(前回までは foldM を使っていた)して,main も書き換えた。
bfRun :: BrainF_ck -> Program -> IO BrainF_ck
bfRun bf prog = run $ progFetch prog
where run [] = return bf
run (c:cs) | c == '[' = bfRun bf (progSkip bf prog)
| c == ']' = bfRun bf (progBack bf prog)
| otherwise = do next <- bfEvaluate bf c
bfRun next (progShift prog)
main :: IO BrainF_ck
main = do filename <- getArgs >>= return . head
prog <- readFile filename >>= ((return . progNew) . concat) . lines
bfRun bfInitial prog
さらに。いままで入出力を整数でやっていたけど,これを文字に変更する。まぁ文字<->整数(文字コード)の変換だけだけど。
import Data.Char
bfInput :: BrainF_ck -> IO BrainF_ck
bfInput bf = do let p = bfPointer bf
let r = bfRegister bf
putStr "\ninput? ";
c <- getChar
return $ BF p ((take p r) ++ [ord c] ++ (tail $ drop p r))
bfPrint :: BrainF_ck -> IO BrainF_ck
bfPrint bf = do putChar $ chr $ bfValue bf
return bf
これでできあがりのはずだ。さっそく試してみよう。
実行するプログラムは当初の目標,HelloWorld。
>type hello.bf ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<< +++++++++++++++.>.+++.------.--------.>+.>. >runghc hbf.hs hello.bf Hello World!
OK!!!!!!!!!!!!!!!!
いろいろと制限もあるけど,とにかく目標は達成。これ以上はまた気が向いたらってことで。
以下,全体を示しておく。
module Main where
import System
import Monad
import Data.Char
data BrainF_ck = BF { bfPointer :: Int, bfRegister :: [Int] } deriving (Show)
type Program = ([Char], [Char])
bfInitial :: BrainF_ck
bfInitial = BF { bfPointer = 0, bfRegister = [0,0,0,0,0,0,0,0,0,0] }
bfValue :: BrainF_ck -> Int
bfValue bf = (bfRegister bf) !! (bfPointer bf)
bfIncrement :: BrainF_ck -> BrainF_ck
bfIncrement (BF p v) = BF p ((take p v) ++ [(v !! p) + 1] ++ (tail $ drop p v))
bfDecrement :: BrainF_ck -> BrainF_ck
bfDecrement (BF p v) = BF p ((take p v) ++ [(v !! p) - 1] ++ (tail $ drop p v))
bfShift :: BrainF_ck -> BrainF_ck
bfShift (BF p v) = BF (p+1) v
bfUnshift :: BrainF_ck -> BrainF_ck
bfUnshift (BF p v) = BF (p-1) v
bfInput :: BrainF_ck -> IO BrainF_ck
bfInput bf = do let p = bfPointer bf
let r = bfRegister bf
putStr "\ninput? "
c <- getChar
return $ BF p ((take p r) ++ [ord c] ++ (tail $ drop p r))
bfPrint :: BrainF_ck -> IO BrainF_ck
bfPrint bf = do putChar $ chr $ bfValue bf
return bf
bfEvaluate :: BrainF_ck -> Char -> IO BrainF_ck
bfEvaluate bf '+' = return $ bfIncrement bf
bfEvaluate bf '-' = return $ bfDecrement bf
bfEvaluate bf '>' = return $ bfShift bf
bfEvaluate bf '<' = return $ bfUnshift bf
bfEvaluate bf '.' = bfPrint bf
bfEvaluate bf ',' = bfInput bf
progNew :: String -> Program
progNew str = ([], str)
progFetch :: Program -> [Char]
progFetch prog = snd prog
progShift :: Program -> Program
progShift (l, (r:rs)) = (l ++ [r], rs)
progUnshift :: Program -> Program
progUnshift (l, r) = (take ((length l) -1) l, (last l):r)
progSkip :: BrainF_ck -> Program -> Program
progSkip bf prog = if bfValue bf == 0 then skip prog else progShift prog
where skip p = if (head $ progFetch next) == ']' then next else skip next
where next = progShift p
progBack :: BrainF_ck -> Program -> Program
progBack bf prog = if bfValue bf == 0 then progShift prog else back prog
where back p = if (head $ progFetch prev) == '[' then prev else back prev
where prev = progUnshift p
bfRun :: BrainF_ck -> Program -> IO BrainF_ck
bfRun bf prog = run $ progFetch prog
where run [] = return bf
run (c:cs) | c == '[' = bfRun bf (progSkip bf prog)
| c == ']' = bfRun bf (progBack bf prog)
| otherwise = do next <- bfEvaluate bf c
bfRun next (progShift prog)
main :: IO BrainF_ck
main = do filename <- getArgs >>= return . head
prog <- readFile filename >>= ((return . progNew) . concat) . lines
bfRun bfInitial prog
入出力の命令「.」と「,」を実装した。
最初,よく考えもせずに出力する関数 bfPrint をこうした。
bfPrint bf = print $ bfValue bf
確かにこれでこの関数自体はちゃんと動く。つまり1文字出力される。
*Main> bfPrint $ bfIncrement bfInitial Loading package haskell98-1.0 ... linking ... done. 1
けど,返り値が IO () なのであとが続かない。出力命令が来たらそこで終わり,では話しにならないよな。
ここでしばらく行き詰まってしまった。
次の命令の処理につなげるには BrainF_ck を返さないといけないけど,どうやったらいいのか。
一部の命令だけ IO モナドになってしまうのを,他の命令と型を合わせるにはどうしたらいいのか。
結局「入門Haskell―はじめて学ぶ関数型言語」のモナドの章を読み直して,何とかできたのがこれ。
bfEvaluate は1つの命令を評価するようにして,次々に処理するのは main に移した。モナドを扱うので foldM を使った。
bfInput :: BrainF_ck -> IO BrainF_ck
bfInput bf = do let p = bfPointer bf
let r = bfRegister bf
putStr "\ninput? "
v <- getChar return $ BF p ((take p r) ++ [read [v]] ++ (tail $ drop p r))
bfPrint :: BrainF_ck -> IO BrainF_ck
bfPrint bf = do putStr $ show $ bfValue bf
return bf
bfEvaluate :: BrainF_ck -> Char -> IO BrainF_ck
bfEvaluate bf c = case c of
'+' -> return $ bfIncrement bf
'-' -> return $ bfDecrement bf
'>' -> return $ bfShift bf
'<' -> return $ bfUnshift bf
'.' -> bfPrint bf
',' -> bfInput bf
main :: IO ()
main = do args <- getArgs
prog <- readFile $ head args
result <- foldM bfEvaluate bfInitial prog
print result
あ,foldM を使うには import Monad が必要。 さて,試してみよう。入力するプログラムはこれ。
++.>++.>++.<-.>>,.
結果。
>runghc hbf.hs sample.bf
2221
input? 7
7BF {bfPointer = 3, bfRegister = [2,1,2,7,0,0,0,0,0,0]}
一番最後に状態を出力してるから見にくいけどそれはおいといて。
input? のあとの 7 が入力。で,そのすぐあとに入力されたばかりの 7 を出力している。最後の状態を見てもちゃんと 7 が入力されている(左から4番目)。
というわけで,何とかできたけど入出力は難しい。これで良いのかなぁ。もっとスマートにいかないものか。
今のままじゃテストするもの面倒なので,外部のファイルからプログラムを読み込めるようにした。
といっても手抜きで,命令列を頭から一直線に実行して無くなったら終わり。で,最後の状態を表示する。今のところはジャンプしたりはできないんだからこれでいいさ。
module Main where
import System
(snip)
bfEvaluate :: BrainF_ck -> [Char] -> BrainF_ck
bfEvaluate = foldl eval
where eval bf c = case c of
'+' -> bfIncrement bf
'-' -> bfDecrement bf
'>' -> bfShift bf
'<' -> bfUnshift bf
main :: IO ()
main = do args <- getArgs
prog <- readFile $ head args
print $ bfEvaluate bfInitial prog
サンプルのプログラムはこれ。
++>++>++<-
最初のレジスタを2回インクリメントして右にシフト,同じく2回インクリメントして右にシフト,また2回インクリメントしたら今度は左に1つシフト,1回デクリメントして終わり。 結局,レジスタの値が左から 2,1,2 になって,ポインタは 1 (左から2番目を指している)になる。やってみよう。
>type sample.bf
++>++>++<-
>runghc hbf.hs sample.bf
BF {bfPointer = 1, bfRegister = [2,1,2,0,0,0,0,0,0,0]}
OK。
Wkikipediaの記事を読んだり,ダウンロードしたインタプリタをいじってるうちに,なんかちょっとできそうな気がしてきた。
目標は Hello world プログラムの実行だ。
まず,データを格納する配列(レジスタと呼ぶことにしよう)とポインタが必要だな。
data BrainF_ck = BF { bfPointer :: Int, bfRegister :: [Int] }
操作する命令をそれぞれ関数にする。こんな感じか。
| 命令 | 関数名 |
| + | bfIncrement |
| - | bfDencrement |
| > | bfShift |
| < | bfUnshift |
| . | bfPrint |
| , | bfInput |
| [ | bfGoto |
| ] | bfBack |
とりあえず簡単そうな「+」,「-」,「>」,「<」だけにしよう。
それから,BrainF_ck の初期値を設定する関数も要るな。レジスタがいくつ要るかわからないけど,10個あればいいか。
data BrainF_ck = BF { bfPointer :: Int, bfRegister :: [Int] } deriving (Show)
bfInitial :: BrainF_ck
bfInitial = BF { bfPointer = 0, bfRegister = [0,0,0,0,0,0,0,0,0,0] }
bfValue :: BrainF_ck -> Int
bfValue bf = (bfRegister bf) !! (bfPointer bf)
bfIncrement :: BrainF_ck -> BrainF_ck
bfIncrement (BF p v) = BF p ((take p v) ++ [(v !! p) + 1] ++ (tail $ drop p v))
bfDecrement :: BrainF_ck -> BrainF_ck
bfDecrement (BF p v) = BF p ((take p v) ++ [(v !! p) - 1] ++ (tail $ drop p v))
bfShift :: BrainF_ck -> BrainF_ck
bfShift (BF p v) = BF (p+1) v
bfUnshift :: BrainF_ck -> BrainF_ck
bfUnshift (BF p v) = BF (p-1) v
まずはここまででどうだ。
Prelude> :load hbf.hs
Compiling Main ( hbf.hs, interpreted )
Ok, modules loaded: Main.
*Main> bfInitial
Loading package haskell98-1.0 ... linking ... done.
BF {bfPointer = 0, bfRegister = [0,0,0,0,0,0,0,0,0,0]}
*Main> bfIncrement $ bfInitial
BF {bfPointer = 0, bfRegister = [1,0,0,0,0,0,0,0,0,0]}
*Main> bfIncrement $ bfShift $ bfInitial
BF {bfPointer = 1, bfRegister = [0,1,0,0,0,0,0,0,0,0]}
*Main> bfUnshift $ bfIncrement $ bfShift $ bfInitial
BF {bfPointer = 0, bfRegister = [0,1,0,0,0,0,0,0,0,0]}
おお,なんだかうまくいってるみたい。
前のエントリでは話がBrainf*ck(一応伏せ字にする)にいっちゃったけど,こっちが本題。
まったくもって乗り遅れたけど書いてみた。
import System
showStar :: Int -> IO ()
showStar n = do putStrLn $ (show n) ++ " : " ++ (repeatStar n)
repeatStar :: Int -> String
repeatStar n = take n $ repeat '*'
main = do args <- getArgs
mapM_ showStar $ map read args
実行。
>runghc starbar.hs 3 8 5 3 : *** 8 : ******** 5 : *****
OK。いけてるぞ。
でも桁数の違う数が混じると汚いな。
>runghc starbar.hs 3 12 7 3 : *** 12 : ************ 7 : *******
まぁいいか。
追記:
(コメントから)
そうか。replicate を使えばいいのか。よし,ついでにポイントフリーにして,
Prelude> let repeatStar = flip replicate '*' Prelude> :t repeatStar repeatStar :: Int -> [Char] Prelude> repeatStar 7 "*******"
『本物のプログラマはhaskellを使う』にでてきた用語の日英対応表をつくってみた。
こういうのは憶えておくと役に立つ,かも。
| lazy evaluation | 遅延評価,怠惰評価 |
| functional programming | 関数型プログラミング |
| logic programming | 論理型プログラミング |
| probabilistic functional programming | 確率的関数プログラミング |
| Domain Specific Language | 特定領域言語,ドメイン特化言語 |
| lambda abstraction | ラムダ抽象 |
| anonymous function | 無名関数 |
| type inference | 型推論 |
| type variable | 型変数 |
| context | 文脈 |
| type class | 型クラス |
| instance | インスタンス |
| inheritance | 継承 |
| subclass | サブクラス |
| module | モジュール |
| import | インポート |
| type synonym | 型の同義名,型シノニム |
| algebraic data type | 代数的データ型 |
| type constructor | 型構成子,型構築子 |
| data constructor | データ構成子,データ構築子 |
| polymorphic type | 多相型,多様型 |
| parametric polymorphism | パラメータ多相,パラメトリック多相 |
| ad-hoc polymorphism | アドホック多相 |
| unboxed array | 非ボックス化配列 |
| infix operators | 中置演算子 |
| monad | モナド |
| action | 動作,アクション |
| bind | 束縛した |
| do expression | do式 |
| do-notation | do記法 |
第2回が掲載されている。
けど ITproって会員にならないと記事一覧が見られないらしい。
せっかくだからこのエントリにリンクを作っておこう。
とりとめもない話なんだけど。
エントリのなかに isPrefixOf という関数がでてくる。
xs `isPrefixOf` ys
は文字列 xs が ys のプレフィックスである時に True を返すんだけど,この xs と ys の順序について。
上のように中置形式で書くという前提なら,「xs が ys のプレフィックスのとき True」というのは素直に納得できる。
じゃあ,普通に関数名を前に置いて書いたらどうか。
isPrefixOf xs ys
これって見た目には,どちらかというと「ys が xs のプレフィックスのとき True」,つまり中置き形式のときとは逆じゃないかな。さらに,部分適用してこんな関数を考えてみるとなおさらそんな気がする。
isPrefixOfXS = isPrefixOf "is it prefix of xs?"
いや,こんな関数はあまり有用には思えないからいい例じゃないんだけど。
前置も中置もどちらもおなじ,というのを合わせて考えると,引数の順序もなんだか悩ましいなぁ,と。