カテゴリー: Haskell

また間があいてしまった。たまには触らないと鈍る――ってほどなれてるわけでもないけど――ので，練習問題をやってみる。

「ふつうの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

下のエントリの fold，「ふつケル」の解答例を見たら concatMap を使っていた。なるほど。

Prelude> :t concatMap
concatMap :: (a -> [b]) -> [a] -> [b]
Prelude> concatMap (replicate 3) "abc"
"aaabbbccc"

今日で最後だ。のこりの命令「[」と「]」を実装した。

「[」と「]」を実装するには命令の列を行ったり来たりできなきゃいけない。はじめに考えたのは 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

確かにこれでこの関数自体はちゃんと動く。つまり１文字出力される。

*Main> bfPrint $ bfIncrement bfInitial
Loading package haskell98-1.0 ... linking ... done.
1

けど，返り値が IO () なのであとが続かない。出力命令が来たらそこで終わり，では話しにならないよな。
ここでしばらく行き詰まってしまった。
次の命令の処理につなげるには BrainF_ck を返さないといけないけど，どうやったらいいのか。
一部の命令だけ IO モナドになってしまうのを，他の命令と型を合わせるにはどうしたらいいのか。

結局「入門Haskell―はじめて学ぶ関数型言語」のモナドの章を読み直して，何とかできたのがこれ。

• 命令をつなげるのには IO BrainF_ck をつかう。
• 値を返すには return をつかう。

bfEvaluate は１つの命令を評価するようにして，次々に処理するのは 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 が入力されている（左から４番目）。

というわけで，何とかできたけど入出力は難しい。これで良いのかなぁ。もっとスマートにいかないものか。

今のままじゃテストするもの面倒なので，外部のファイルからプログラムを読み込めるようにした。
といっても手抜きで，命令列を頭から一直線に実行して無くなったら終わり。で，最後の状態を表示する。今のところはジャンプしたりはできないんだからこれでいいさ。

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,1,2 になって，ポインタは 1 （左から２番目を指している）になる。やってみよう。

>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]}

おお，なんだかうまくいってるみたい。

cf. キミならどう書く 2.0 – ROUND 3 –

前のエントリでは話が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記法

第２回が掲載されている。
けど ITproって会員にならないと記事一覧が見られないらしい。
せっかくだからこのエントリにリンクを作っておこう。

• 第１回 関数型プログラミングの世界へようこそ
• 第２回 多相型（ポリモーフィズム）への理解を深める
• 第３回 mapからモナドを理解する
• 第４回 「取り出し可能な値」のみを持つListモナド

　cf. 結城浩のHaskell日記 – type宣言

とりとめもない話なんだけど。
エントリのなかに 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?"

いや，こんな関数はあまり有用には思えないからいい例じゃないんだけど。

前置も中置もどちらもおなじ，というのを合わせて考えると，引数の順序もなんだか悩ましいなぁ，と。