2010年05月07日 金曜日
■ [文法][QuickCheck]応用文法(モナド変換子1)
対応しているモナドによって動作が変わるので、なかなか面倒...
基本的に内部モナドと合成モナド(外殻みたいな感じ)に分けて考えるらしい。一応、２つのモナドの性質を持つのだけど、これが組み合わせ、順番によって変わるので、モナド変換子のbindの定義をよく調べないと予期しない動作をする。基本的には通常、姿の見えない内部モナドの性質の方が強い...
大抵の場合、合成モナドのbindの際に内部モナドのbindも行われる。これが厄介で内部モナドがListやMaybeだと複雑な演算になる。Treeだと何が起こるかわからないくらいになる。内部モナドは逆にIOとかの方が扱いやすいかも...
lift演算は、基本的に内部モナドをbindした値をそのまま取り出せるように実装されているので、逆に安心して(？)使える。定義も簡単。合成モナドのbindを理解する方が難しい...気がする...
見た感じ、継続モナドとIOモナドとか意外と相性が良さそう。モナドの殻を外す時は、基本的に外殻のモナドから外してゆく。つまり、内部モナドの方が演算の基本部分に強く関わっている(？)。つか、モナド変換子のliftとかbindの定義を見ても、内部モナドの演算が核で、それに付加する感じで機能を付け足している...
語弊があるかもしれないけど、基本的な演算は内部モナドに依存すると考えていいかもしれない(姿が見えないだけに混乱する)。数学分かる人なら説明できるかも...
とりあえず、色々試してみる...
import System.Random (newStdGen) import Control.Applicative ((<$>)) import Test.QuickCheck import Test.QuickCheck.Gen (Gen (..)) import Control.Monad.List import Control.Monad.State import Control.Monad.Cont -- Genモナドに生成器とサイズパラメータを与え、乱数値を生成するIOアクションを生成する... genToIO n g = flip (unGen g) n <$> newStdGen -- 合成((Gen)) - 内部モナドほど、括弧の内側... -- 自然数乱数値を生成... test1 = (>>= print) . (genToIO 10) $ do arbitrary `suchThat` (> 0) :: Gen Int -- $> test1 -- 14 -- 合成(ListT(Gen)) -- ５個の自然数乱数値のリストを生成... test2 = (>>= print) . (genToIO 10) . runListT $ do i <- ListT $ return [1 .. 5] x <- lift $ (arbitrary `suchThat` (> 0) :: Gen Int) return x -- $> test2 -- [16,16,3,31,6] -- 合成(StateT(ListT(Gen))) -- ５個の自然数乱数値のリストを生成。但し、その自然数は１０回の自然数を生成した時の最大値... -- Stateが５個に分かれてる(StateTより内部モナドのListTの影響(？)が強い？)... test3 = (>>= print) . (genToIO 10) . runListT . (`execStateT` 0) $ do i <- lift $ ListT $ return [1 .. 5] forM_ [1 .. 10] $ \i -> do x <- lift . lift $ (arbitrary `suchThat` (> 0) :: Gen Int) modify $ max x -- $> test3 -- [30,52,46,31,60] -- 合成(ContT(StateT(ListT(Gen)))) -- ５個の自然数乱数値のリストを生成。但し、その自然数は１０回の自然数を生成した時の最大値。 -- 但し、１０回の試行内、１度でも１０以上の値が出たら、生成を止めてそれまでの最大値を採用... test4 = (>>= print) . (genToIO 10) . runListT . (`execStateT` 0) . (`runContT` return) $ do callCC $ \exit1 -> do i <- lift . lift $ ListT $ return [1 .. 5] forM_ [1 .. 10] $ \i -> do x <- lift . lift . lift $ (arbitrary `suchThat` (> 0) :: Gen Int) when (x >= 10) $ exit1 () lift . modify $ max x -- $> test4 -- [0,0,7,0,0]
内部モナドが演算の基本っぽいこと(持ち上げという意味)が確認できた気がする...
通常は、lift . liftなどは持ち上げの順番がわかるような名前の関数にすると良いらしい...
test4の[0, 0, 7, 0, 0]とかあり得ないのが、多分、生成器の精度があんまり良くないため(だと思う)。標準ライブラリの乱数生成の精度は良くないらしい。最近、乱数生成系の関数をよく使うけど、初回評価時とか同じ数が連続する気がする。まぁ、いいけど...(追記: よく考えたら、そうでもなかった。Haskell >>= say "ゴメンナサイ")
test4とかモナドのキメラ、又はフランケンシュタイン。なんか最強の合成モナドを作るとか流行らないかな。内部モナドがPokemonモナドとかなら対戦できるな。誰もやらないだろうけど...
複雑なので理解が間違ってる可能性のほうが高いです...orz
■ [文法][fromC/C++]応用文法(モナド変換子2)
前にやったListTのモナド変換子(内部モナドがMaybeの場合)を復習してみる...
この場合の、Maybeのリフト演算はC/C++的な局所領域脱出(？)に相当する。MaybeがNothingを返すと､計算結果はNothingになってしまうので。内部モナドのMaybeが演算の柱となっていることがわかる。guardは、合成モナドで使うとcontinue相当になるかな...
あんまり、いい記述の仕方じゃないけど。C/C++に変換して考えた方が最初はいいかもと思ったので...
import Control.Monad.List import Control.Monad _MAYBE = lift _FOREACH = ListT . return _CONTINUE = guard . not maybeList :: [Maybe Int] -> Maybe [Int] maybeList xs = runListT $ do m <- _FOREACH xs ; do x <- _MAYBE m _CONTINUE $ x `rem` 7 == 0 return x -- $> maybeList [Just 5, Just 7] -- Just [5]
Cっぽく書くとこんな感じ...
/* C-ish pseudo code */ #define N 100 typedef int bool_t; struct{ bool_t b; int x; } maybes[N]; int result[N], i, count = 0; /* 適当にmaybesを初期化... */ ... for(i = 0; i < N; i++){ if(!maybes[i].b){ /* 多重ループじゃなければ、count = 0; break; でいいけど、 空の時もあるので一応... */ goto FAILED; }else if(x % 7 == 0){ continue; }else{ result[count++] = maybes[i].x; } } /* SUCCEEDED */ if(count > 0) ... return; debugbreak; FAILED: ...
よく考えたら、内部モナドが演算の根底にあって、それを合成して(対応するパラレルワールドに持ち込んで)いるのだから、内部モナドが演算を支配しているのは当たり前だった...
多分、数学的に適切な概念があるのだろうけどわからない...orz
■ [ライブラリ][Parsec]Parsec1(Road to Parsec)
やっと、Parsec...
見る限り、今のところ最強のモナドっぽい。これで出来ないことなんてあるのだろうかと...
モナドなので、例によってbindのカラクリを調べてみる。とりあえず、ParsecTはモナド変換子で、
data ParsecT s u m a = ParsecT { runParsecT :: State s u -> m (Consumed (m (Reply s u a))) }
と定義されてる。sは状態、uはユーザー状態(一応、正格らしい)、mは内部モナド、aは多分、任意の型。基本仕様でユーザー状態を扱えるという豪華さ...
Consumed、Replyの構造はシンプルなので先にやってしまうと、
data Consumed a = Consumed a -- 入力を消費した場合(多分...) | Empty !a -- しなかった場合 data Reply s u a = Ok a !(State s u) ParseError -- 成功 | Error ParseError -- 失敗
で、入力を消費したかしないかで、ComsumedかEmptyに分岐、そのそれぞれについてOkかErrorに分岐という２段階分岐で、結果は結局、OkかErrorの２種類...
で、bind(>>=)の実装はと言うとシンプルで、まず、入力を消費したかをbindすることで確認、ComsumedかEmptyのそれぞれについてOkかErrorかをbindすることで確認するといった感じ...
fmapはOkの値を修正するだけで、Errorの場合は何もしない...
MonadPlusのインスタンスとしては、動作はMaybeに似ていて、mzeroが失敗、mplusが
最初に見つかった成功値のようだ...
MonadReader r m => MonadReader r (ParsecT s u m) MonadState s m => MonadState s (ParsecT s' u m) MonadError e m => MonadError e (ParsecT s u m) MonadTrans (ParsecT s u) Monad m => Monad (ParsecT s u m) Monad m => Functor (ParsecT s u m) Monad m => MonadPlus (ParsecT s u m) Monad m => Applicative (ParsecT s u m) Monad m => Alternative (ParsecT s u m) MonadCont m => MonadCont (ParsecT s u m) MonadIO m => MonadIO (ParsecT s u m)
MonadPlus(モノイド)のインスタンスなら、Alternativeのインスタンスにもできるはずだけど、Alternativeのメソッド(many、some)はListやMaybeでは使えなかった(戻ってこない)。でもParsecTでは使える。
通常使うモナド版のParsecはIdentityモナドを使って、
type Parsec s u = ParsecT s u Identity
と定義されている。この状態でも十分に強力なのだけど、Identityモナドの代わりにIOモナドと合成すれば格段に強力になる。入力を受け取り、その内容をパースして出力を行うという演算を簡単に実現できると思うし、速度が必要なら純粋関数を使えばいいし...
bindが素直な定義なのでIO、Cont系とは相性が良さそう...
-- 最初なので、Alternativeのmany、someだけ使ってみる... import Control.Applicative ((<$>), Applicative (..), Alternative (..)) import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Text.ParserCombinators.Parsec.Char (char) t :: Parser () t = do char 'a' return () testMany = parseTest (many t) "bcd" testSome = parseTest (some t) "bcd" -- 期待通りの結果になった... -- $> testMany -- [] -- $> testSome -- parse error at (line 1, column 1): -- unexpected "b" -- expecting "a"
■ [ライブラリ][Parsec]Parsec2
持ち上げ演算さえしなければ、気が付かないのではないかと思うくらい相性がいい気がする...
import Control.Applicative ((<$>), Applicative (..), Alternative (..)) import Control.Monad.Cont (ContT (..), lift, liftIO) import Text.Parsec import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Text.ParserCombinators.Parsec.Combinator import Text.ParserCombinators.Parsec.Char -- import qualified Data.Set as Set -- import qualified Data.Map as Map type MyParser a u = ParsecT String u (ContT (Either ParseError a) IO) a liftIOToParsec :: IO a -> MyParser a u liftIOToParsec = liftIO liftContToParsec :: ContT (Either ParseError a) IO a -> MyParser a u liftContToParsec = lift runMyParser :: (Show a, Show u) => MyParser a u -> u -> String -> IO (Maybe a) runMyParser p u s = do res <- (`runContT` return) $ runPT p u "" s case res of Left err -> return $ Nothing Right x -> return $ Just x main = solution >>= putStrLn . maybe "failed." show where solution = getContents >>= runMyParser begin () -- (Set.empty :: Set.Set Integer) -- (Map.empty :: Map.Map Integer Integer) -- runMyParserまでしっかり型を書いたので、後は推論してくれるはず。 -- コンビネータの使い方が全くわからないけど、とりあえず入力を確認してみる... begin = do c <- anyChar liftIOToParsec $ print c c <- begin return ()
無限ループなので、適当に止めてください...
地道に使い方を覚えないと...
■ [ライブラリ][Parsec]Parsec３
Parsec2のコードが酷すぎる(型とか間違っていたので)ので書き直してみた...
コンビネータを少し覚えた。何度も演習に使っているCode Jam 2009 Alien Languageを解いてみた(と言うよりも、入出力ができているかの確認)。
最新のParsecライブラリはText.ParserCombinators.Parsecではなく、Text.Parsecのものらしい...
import Control.Applicative ((<$>), Applicative (..), Alternative (..)) import Control.Monad.Cont (ContT (..), lift, liftIO) import Control.Monad import Text.Parsec hiding (many, (<|>)) import Text.Parsec.Combinator import Text.Parsec.Char import Text.Printf type MyParser r u a = ParsecT String u (ContT (Either ParseError r) IO) a -- 連結ってないのかな... (<&>) :: MyParser r u a -> MyParser r u b -> MyParser r u b a <&> b = a >> b ; infixl 5 <&> -- F#(OCaml？)っぽく... ignore :: Monad m => a -> m () ignore = const (return ()) liftIOToParsec :: IO a -> MyParser r u a liftIOToParsec = liftIO liftIOToCont :: IO a -> ContT (Either ParseError r) IO a liftIOToCont = liftIO liftContToParsec :: ContT (Either ParseError r) IO a -> MyParser r u a liftContToParsec = lift runMyParser :: (Show a, Show u) => MyParser a u a -> u -> String -> IO (Either String a) runMyParser p u s = do res <- (`runContT` return) $ runPT p u "" s case res of Left err -> return $ Left (show err) Right x -> return $ Right x main :: IO () main = solution >>= either putStrLn ignore where solution = readFile "./A-large-practice.in" >>= runMyParser solve () integer :: MyParser r u Int integer = read <$> spaces <&> some digit <?> "integer" line :: MyParser r u String line = spaces <&> some lower <?> "line" word :: MyParser r u String word = between (char '(') (char ')') (some lower) <|> return <$> lower <?> "word" -- 一応、ParsecTの合成モナドなんだけど、IOモナドとして全く違和感が無い... solve :: MyParser r u () solve = do [l, d, n] <- count 3 integer ass <- count d line bss <- count n (spaces <&> count l word) liftIOToParsec $ zipWithM_ (display ass) [1 .. n] bss where display ass i bs = printf "Case #%d: %d\n" i (sum [fromEnum . and $ zipWith elem as bs | as <- ass])
Parsec最強!
コード長くなるけど...
あと、珍しく型を全部書いてるけど、モノイドだからコピペでほとんど終わる...
■ [メモ][CodeJam]CodeJam 2010
なんかカウントダウンが始まってる...
一応、参加登録はしてあるから、多分、参戦するけどコンテストとか苦手...
templateだけ、作っておこう...
問題を読み取るパーサーと、解を表示する高階関数に渡す関数を記述するだけの状態にしといた。Parsecのいい演習になるかも...
予選はまだ時間的な余裕があるけど、本戦とか上位者でもかなり下準備しないと難しそう...
■ [メモ][CodeJam][Parsec]CodeJam 2010 Templete
２４時間あるっていっても、コピペで済むに越したこと無いから...
やば、貼り付けてみるとimportライブラリだけで結構あるなぁ...
でも、説明読んだら、1ファイル100KB(複数でMax:1MB)らしい。それ考えるともの足りない。１０万行くらい書いてもzipすれば100KB多分いかないからなぁ...
------------------------------ Templates begin ------------------------------ -- ##### Language extensions ##### {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns, PatternGuards, BangPatterns, TupleSections #-} -- {-# OPTIONS_GHC -fglasgow-exts #-} {-# OPTIONS_GHC -cpp #-} {-# OPTIONS_GHC -O2 -fvia-C -optc-O3 #-} -- ##### Import libraries ##### -- import System.Random (getStdRandom, newStdGen, random, randomR, randoms, randomRs) import Control.Applicative ((<$>), Applicative (..), Alternative (..)) import Control.Monad.Cont (ContT (..), lift, liftIO) import Control.Monad.State import Control.Monad.ST import Control.Monad.List import Control.Monad import Control.Arrow ((&&&), (***), first, second, app) -- import Control.DeepSeq -- import Data.Bits import Data.Ord (comparing) import Data.Function (on) -- import Data.Ratio import Data.Char -- import Data.Maybe import Data.Array -- import Data.Array.Unboxed -- import Data.Array.IO import Data.Array.ST -- import Data.IORef import Data.STRef import Data.List import Data.Tree -- import Data.Monoid (Monoid (..), mconcat) -- import Data.MemoTrie (memo, memo2) import Numeric (showIntAtBase) -- import qualified Data.Set as Set -- import qualified Data.Map as Map -- import qualified Data.Foldable as Foldable -- import Data.Sequence (ViewR (..), ViewL (..), viewr, viewl) import Foreign.Marshal.Utils (fromBool, toBool) import Text.Parsec hiding (many, (<|>)) import Text.Parsec.Combinator import Text.Parsec.Char import Text.Printf (printf, PrintfArg) import System.Win32.Types (maybeNum, numToMaybe) -- import Test.QuickCheck -- import Test.QuickCheck.Arbitrary -- import Test.QuickCheck.Gen (Gen (..)) -- import Test.QuickCheck.Property -- import Test.QuickCheck.Instances.Char -- import Test.QuickCheck.Instances.List -- import Test.QuickCheck.Instances.Num import Debug.Trace (trace, traceShow) -- ##### Debug & Trace ##### #define _DEBUG infixr 0 .$. infixr 9 ... #ifdef _DEBUG (.$.) f x = traceShow x $ f x (...) f g x = let x' = g x in traceShow x' $ f x' _TRACE x = traceShow x x _TRACEM x = traceShow x (ignore x) _TRACEP x = liftIOToParsec $ print x #else (.$.) = ($) (...) = (.) #define _TRACE(x) x #define _TRACEM(x) #define _TRACEP(x) #endif (?) b x y = if b then x else y ; infixr 1 ? (??) x y b = (?) b x y ; infixr 1 ?? -- ##### Utils ##### ignore :: Monad m => a -> m () ignore = const (return ()) space' = (>> putChar ' ') endl' = (>> putChar '\n') readInt = read :: String -> Int readInteger = read :: String -> Integer readInts = map readInt readIntegers = map readInteger -- ##### List ##### splitBy n = takeWhile (not . null) . map (take n) . iterate (drop n) elim, sortR :: Ord a => [a] -> [a] elim = map head . group . sort sortR = sortBy (flip compare) sortByFst, sortBySnd, sortByFstR, sortBySndR :: (Ord a, Ord b) => [(a, b)] -> [(a, b)] sortByFst = sortBy (comparing fst) sortBySnd = sortBy (comparing snd) sortByFstR = sortBy (flip (comparing fst)) sortBySndR = sortBy (flip (comparing snd)) groupByFst, groupBySnd :: (Eq a, Eq b) => [(a, b)] -> [[(a, b)]] groupByFst = groupBy ((==) `on` fst) groupBySnd = groupBy ((==) `on` snd) -- ##### Array ##### array1D x = listArray (0, x - 1) array2D (y, x) = listArray ((0, 0), (y - 1, x - 1)) arrayToLists n a = splitBy n $ elems a arrayToList n a = concat $ arrayToLists n a arrayST1D' a = runST $ do let b@(lb, ub) = bounds a let r = range b ma <- thaw a :: ST s (STArray s Int Int) -- mr <- newSTRef 0 :: ST s (STRef s Int) forM_ r $ \x -> do -- Do something here return () -- getElems ma arrayST2D' a = runST $ do let b@(lb, ub) = bounds a let r = range b ma <- thaw a :: ST s (STArray s (Int, Int) Int) -- mr <- newSTRef 0 :: ST s (STRef s Int) forM_ r $ \p@(y, x) -> do -- Do something here return () -- getElems ma -- ##### Tree ##### searchTree fM f initData = evalState (fM f initData) -- dfs dfsTree = searchTree unfoldTreeM -- bfs bfsTree = searchTree unfoldTreeM_BF -- ##### Parser ##### type MyParser r u a = ParsecT String u (ContT (Either ParseError r) IO) a (<&>) :: MyParser r u a -> MyParser r u b -> MyParser r u b a <&> b = a >> b ; infixl 5 <&> liftIOToParsec :: IO a -> MyParser r u a liftIOToParsec = liftIO liftIOToCont :: IO a -> ContT (Either ParseError r) IO a liftIOToCont = liftIO liftContToParsec :: ContT (Either ParseError r) IO a -> MyParser r u a liftContToParsec = lift runMyParser :: MyParser a u a -> u -> String -> IO (Either String a) runMyParser p u s = do res <- (`runContT` return) $ runPT p u "" s case res of Left err -> return $ Left (show err) Right x -> return $ Right x run :: IO String -> MyParser a u a -> u -> IO () run ios p userData = solution >>= either putStrLn ignore where solution = ios >>= runMyParser p userData integer :: MyParser r u Int integer = read <$> spaces <&> some digit <?> "integer" word :: MyParser r u String word = spaces <&> some alphaNum <?> "word" test p = run getContents p userData main = run input myParser userData -- ##### Resources ##### -- GHC: "http://www.haskell.org/ghc/docs/6.12.2/html/libraries/" -- Parsec: "http://hackage.haskell.org/package/parsec" -- QuickCheck: "http://hackage.haskell.org/package/QuickCheck-2.1.0.3" ------------------------------- Templates end ------------------------------- input = getContents -- readFile "./A-large-practice.in" -- readFile "./A-small-practice.in" userData = undefined -- Not used. -- (0 :: Int) -- (0 :: Integer) -- (Set.empty :: Set.Set Int) -- (Map.empty :: Map.Map Int Int) line :: MyParser r u String line = spaces <&> some alphaNum <?> "line" -- ##### Solution ##### myParser :: MyParser r u () myParser = do [a :: Int] <- count 1 integer -- [a, b :: Int] <- count 2 integer -- [a, b, c :: Int] <- count 3 integer as <- count a line -- bs <- count b line -- cs <- count c line _TRACEP(a) _TRACEP(as) -- _TRACEP(b) -- _TRACEP(bs) -- _TRACEP(c) -- _TRACEP(cs) liftIOToParsec $ zipWithM_ f [1 .. ] (map solve as) where f i x = printf "Case #%d: %d\n" (i :: Int) (x :: Integer) -- f i s = printf "Case #%d: %s\n" (i :: Int) (s :: String) solve = const undefined
コメント