--
--
スポンサーサイト
--.--.--(--:--)
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
新しい記事を書く事で広告が消せます。
01
23
2013.01.23(23:45)
{-# OPTIONS -Wall -Werror #-} -- スタートHaskell2 最終回 14章 演習問題1 -- http://wiki.haskell.jp/Workshop/StartHaskell2/exercise14 module Exercise141 where -- import Control.Applicative import Control.Monad.Writer ------------------------------------------------------ -- | すごいHaskellたのしく学ぼう本の Writerモナドの例の改変版 logNumber :: Double -> Writer [String] Double logNumber x = writer (x, ["Got Nubmer: " ++ show x]) multWithLog :: Double->Double->Writer [String] Double multWithLog x y = do a <- logNumber x b <- logNumber y return (a*b) -- | モナドの中にいれたものを、もう一度ひっぱがして -- | 計算結果をモナドにいれて次に引き渡す。 ------------------------------------------------------ -- | すごいHaskellたのしく学ぼう本の 非モナド版 solveRPN1 :: String -> Double -- | 関数合成してできている。 --solveRPN1 formula = (head . foldl foldingFunction [] . words) formula -- | 右から、まず String->[String]にして、 -- | 次に[String]->[Double]にして、最後に[Double]->Doubleして解を得る。 -- | ポイントフリースタイルだとこうなる。 --solveRPN1 = head . foldl foldingFunction [] . words -- | 補助関数 rpn1 を使って、いったん置き換える -- | solveRPN1 = head . rpn1 -- | 左から右に書きたい p.290 (-:) :: t1 -> (t1 -> t) -> t x -: f = f x -- | 左から右につなげて書けると美しい。 -- | 結局これは、String->[String]->[Double]->Double solveRPN1 formula = formula -: words -: foldl foldingFunction [] -: head where -- | 以下のあちこちにある型宣言は、実はいらないけど、書いてもOK --rpn1 :: String -> [Double] --rpn1 = foldl foldingFunction [] . words foldingFunction :: [Double] -> String -> [Double] foldingFunction (x:y:ys) "*" = (y * x) : ys foldingFunction (x:y:ys) "+" = (y + x) : ys foldingFunction (x:y:ys) "-" = (y - x) : ys foldingFunction xs str = (read str::Double) : xs ------------------------------------------------------ -- | 演習問題 Exercise14-1 -- | Writerモナドを使ってみよう -- | 逆ポーランド記法で書かれた式を計算する関数 solveRPN (p.214) に、 -- | Writerモナドを使って計算経過ログをとる機能を追加してみよう。 -- solveRPN2 :: String -> Writerモナド型 Double solveRPN2 :: String -> Writer[String] Double --solveRPN2 formula = (liftM head <$> foldM foldingFunctionM [] <$> words) formula --solveRPN2 = liftM head <$> foldM foldingFunctionM [] <$> words --solveRPN2 = liftM head <$> (foldM foldingFunctionM [] . words) --solveRPN2 formula = liftM head ((foldM foldingFunctionM [] . words) formula) -- | 右から、まず String->[String]にして、 -- | 次に[String]->Writer[String]の[Double]にして、 -- | 最後に[Double]->Writer[String]のDoubleして解を得る。 -- | 補助関数 rpn2 を使って、いったん置き換える --solveRPN2 = fmap (liftM head) rpn2 --solveRPN2 = liftM head <$> rpn2 --solveRPN2 = (<$>) head <$> rpn2 --solveRPN2 formula = liftM head (rpn2 formula) --solveRPN2 formula = (<$>) head (rpn2 formula) -- | どう書いても美しくない {-- -- | do記法で書いたほうが少し美しい solveRPN2 formula = do ds <- rpn2 formula return $ head ds solveRPN2 formula = do ds <- rpn2 formula let d = head ds return d --} -- | バインドで書くと最も美しい -- | m aをとって(a->m b)な関数をバインドしてつなげて、最終的にm bを得る -- solveRPN2 formula = rpn2 formula >>= (\x -> return (head x)) -- | 結局これは、String->m String->Writer[String] [Double]->Writer[String] Double solveRPN2 formula = return (formula) >>= (\x -> return (words x)) >>= (foldM foldingFunctionM []) >>= (\x -> return (head x)) where -- rpn2 :: String -> Writerモナド型 [Double] -- rpn2 :: String -> Writer[String] [Double] -- rpn2 = foldM foldingFunctionM [] <$> words -- rpn2 = fmap (foldM foldingFunctionM []) words -- | 以下の型宣言はいらないけど、書いてもOK -- foldingFunctionM :: [Double] -> String -> Writer[String]モナド [Double] foldingFunctionM :: [Double] -> String -> Writer[String] [Double] -- | writerやtellをいろいろな形で使ってみる foldingFunctionM (x:y:ys) "*" = do (y1,x1) <- writer ((y,x), [show y ++ "*" ++ show x]) return ((y1*x1):ys) -- | これが一番シンプル。 -- | 計算結果とログに追加する文字列をセットしたWriterモナドを返す foldingFunctionM (x:y:ys) "+" = writer (((y+x):ys), [show y ++ "+" ++ show x]) -- | ログだけ追加するtellというのも使える foldingFunctionM (x:y:ys) "-" = do tell [show y ++ "-" ++ show x] return ((y-x):ys) foldingFunctionM xs str = do tell [str] return ((read str::Double):xs) -- | どちらで計算しても結果は同じ -- | solveRPN2は内部でWriterモナドを使っているけど純粋関数 solveRPNcomp::String->Bool solveRPNcomp formula = (solveRPN1 formula) == (fst . runWriter $ solveRPN2 formula) -- | main main :: IO () main = do putStrLn "hoo" let formula1 = "10 2 3 * +" print $ solveRPN1 formula1 {-- > :t runWriter runWriter :: Writer w a -> (a, w) モナドからタプルを取り出す関数は、純粋な関数からは呼べないが、mainからは呼べる 取り出したあとは、モナドではないが、取り出した値をそれ以降使う部分は、 純粋な部分にはいれられない。 > :t runWriter . solveRPN2 runWriter . solveRPN2 :: String -> (Double, [String]) > :t solveRPN2 solveRPN2 :: String -> Writer [String] Double --} -- | (演算結果,ログ)を出力する print . runWriter $ multWithLog 4.5 6.5 -- | (演算結果,ログ)を出力する print . runWriter $ solveRPN2 formula1 let (result,logs) = runWriter $ solveRPN2 formula1 print (result,logs) -- | 演算結果を出力する print . fst . runWriter $ solveRPN2 formula1 -- | ログだけ出力する print . execWriter $ solveRPN2 formula1 -- | テスト print $ solveRPNcomp formula1 return ()
hoo 16.0 (29.25,["Got Nubmer: 4.5","Got Nubmer: 6.5"]) (16.0,["10","2","3","2.0*3.0","10.0+6.0"]) (16.0,["10","2","3","2.0*3.0","10.0+6.0"]) 16.0 ["10","2","3","2.0*3.0","10.0+6.0"] True