読者です 読者をやめる 読者になる 読者になる

bitterharvest’s diary

A Bitter Harvestは小説の題名。作者は豪州のPeter Yeldham。苦闘の末に勝ちえた偏見からの解放は命との引換になったという悲しい物語

Haskellで分野向けの機械を開発する(2)

1.数式から木構造を作成する機械

「Haskellで数式をビジュアルに」のところでも説明したが、一次元に書かれた数式を二次元の木構造に変換することができる。例は以下のとおりである。
f:id:bitterharvest:20140819074932p:plain

そこで、オペレーショナル・モナドを利用して、数式から木構造を作成する機械を実現する。

2.命令の集合

最初に決めるのは、命令の集合である。ここでは、ノードとリーフを作成する命令に分け、前者をInsOp、後者をInsValとする。InsOpは加算か乗算を引数として取り、InsValは整数を引数として取ることとし、型コンストラクタTreeIを次のように定める。

data TreeI a where
  InsOp   :: Char -> TreeI ()
  InsVal  :: Int  -> TreeI ()

なお、ここでaは型引数、InsOp,InsValは値コンストラクタである。

また、命令ツリーで構成されるプログラムTreePを次のように用意する。

type TreeP a = Program TreeI a

また、それぞれの命令をプログラムの内で使えるようにするため、関数singletonを適応し、その名前を次のように用意する。

命令InsOpに対して、

insOp  :: Char -> TreeP ()
insOp  = singleton.InsOp

命令InsValに対して、

insVal :: Int -> TreeP ()
insVal = singleton.InsVal 

3.プログラムの実行

プログラムの解釈実行は次のように定義する。

interpret :: TreeP a -> Tree -> Tree
interpret = eval . view
  where
    eval :: ProgramView TreeI a -> Tree -> Tree
    eval (InsOp  x :>>= is) tree   = interpret (is ()) $ operation x tree
    eval (InsVal x :>>= is) tree   = interpret (is ()) $ number x tree 
    eval (Return _)         tree   = tree 

それぞれの命令に対して、命令を実行した後の木構造を求めればよい。従って、これは、「Haskellで数式をビジュアルに」のところで説明したものと同じである。ただ、演算に対する部分が、前の説明ではそれぞれ別々になっていたが、今回のプルグラムでは、演算が引数で渡されるので、場合分けする必要がある。その結果、次のようになる。

operation :: Char -> Tree -> Tree
operation x tree
  | x == '+'  = plus tree
  | x == '*'  = mult tree
  | otherwise = tree

plus :: Tree -> Tree
plus tree = Node Plus tree Empty

number :: Int -> Tree -> Tree
number x Empty = Leaf x
number x (Node op t1 t2)
  | t2 == Empty = Node op t1 $ Leaf x
  | otherwise   = Node op t1 $ number x t2

mult :: Tree -> Tree
mult (Leaf t2) = Node Mult (Leaf t2) Empty 
mult (Node op t1 t2) = Node op t1 $ mult t2

4.利用する

スタックマシンが出来上がってので、早速利用してみる。命令ツリーを関数transformで次のように用意する。

transform :: TreeP ()
transform = do
  insVal 3
  insOp '+'
  insVal 5
  insOp '*'suta
  insVal 9
  insOp '+'
  insVal 7
  insOp '*'
  insVal 6
  insOp '*'
  insVal 5  
  insOp '+'
  insVal 3
  insOp '*'
  insVal 2

これを関数mainで次のように実行する

main :: IO ()
main = (putStrLn . show) $ interpret transform Empty

なお、これに先立って、前回定義したTreeちOpをdataで定義しておく必要がある。

5.プルグラムコード

最後にプログラム全体を提示する。

{-# LANGUAGE GADTs #-}

import Control.Monad
import Control.Monad.Operational

data Tree =  Empty | Leaf Int | Node Op Tree Tree deriving (Eq, Show)
data Op = Plus | Mult deriving (Eq, Ord, Show)

data TreeI a where
  InsOp   :: Char -> TreeI ()
  InsVal  :: Int  -> TreeI ()

type TreeP a = Program TreeI a

insOp  :: Char -> TreeP ()
insOp  = singleton.InsOp

insVal :: Int -> TreeP ()
insVal = singleton.InsVal  

interpret :: TreeP a -> Tree -> Tree
interpret = eval . view
  where
    eval :: ProgramView TreeI a -> Tree -> Tree
    eval (InsOp  x :>>= is) tree   = interpret (is ()) $ operation x tree
    eval (InsVal x :>>= is) tree   = interpret (is ()) $ number x tree 
    eval (Return _)         tree   = tree 

operation :: Char -> Tree -> Tree
operation x tree
  | x == '+'  = plus tree
  | x == '*'  = mult tree
  | otherwise = tree

plus :: Tree -> Tree
plus tree = Node Plus tree Empty

number :: Int -> Tree -> Tree
number x Empty = Leaf x
number x (Node op t1 t2)
  | t2 == Empty = Node op t1 $ Leaf x
  | otherwise   = Node op t1 $ number x t2

mult :: Tree -> Tree
mult (Leaf t2) = Node Mult (Leaf t2) Empty 
mult (Node op t1 t2) = Node op t1 $ mult t2

--exp ="3+5*9+7*6*5+3*2"
transform :: TreeP ()
transform = do
  insVal 3
  insOp '+'
  insVal 5
  insOp '*'suta
  insVal 9
  insOp '+'
  insVal 7
  insOp '*'
  insVal 6
  insOp '*'
  insVal 5  
  insOp '+'
  insVal 3
  insOp '*'
  insVal 2

 
main :: IO ()
main = (putStrLn . show) $ interpret transform Empty