New monads/MonadSplit
Jump to navigation
Jump to search
> module Control.Monad.MonadSplit where
> import Control.Monad
> import qualified Data.Sequence as S
MonadSplit, in a sense, represents the class of monads which have both
"mplus" and a new decomposition operator: "msplit" such that
l == (msplit l >>= \(x,xs) -> return x `mplus` xs)
> class MonadPlus m => MonadSplit m where
> msplit :: m a -> m (a, m a)
> miszero :: m a -> Bool
> instance MonadSplit [] where
> msplit [] = mzero
> msplit (x:xs) = return (x,xs)
> miszero = null
> instance MonadSplit Maybe where
> msplit Nothing = mzero
> msplit (Just x) = return (x, Nothing)
> miszero Nothing = True
> miszero (Just _) = False
This class allows us to implement several functions which were
previously implemented over lists only.
> foldMSl :: (MonadSplit m) => (a -> b -> m a) -> a -> m b -> m a
> foldMSl m i n | miszero n = return i
> | otherwise = do
> (x,xs) <- msplit n
> i' <- m i x
> foldMSl m i' xs
> foldMSr :: (MonadSplit m) => (a -> b -> m b) -> b -> m a -> m b
> foldMSr m i n | miszero n = return i
> | otherwise = do
> (x,xs) <- msplit n
> i' <- foldMSr m i xs
> m x i'
> scanMSl :: (MonadSplit m) => (a -> b -> m a) -> a -> m b -> m (m a)
> scanMSl m i n | miszero n = return (return i)
> | otherwise = do
> (x,xs) <- msplit n
> i' <- m i x
> return (return i) `mplus` scanMSl m i' xs
> scanMSr :: (MonadSplit m) => (a -> b -> m b) -> b -> m a -> m (m b)
> scanMSr m i n | miszero n = return (return i)
> | otherwise = do
> (x,xs) <- msplit n
> i' <- scanMSr m i xs
> (return . m x =<< i') `mplus` return i'
> initsM :: (MonadSplit m) => m a -> m (m a)
> initsM m | miszero m = return mzero
> | otherwise = return mzero `mplus` do
> (x,xs) <- msplit m
> a <- initsM xs
> return $ return x `mplus` a
> tailsM :: (MonadSplit m) => m a -> m (m a)
> tailsM m | miszero m = return mzero
> | otherwise = msplit m >>= \(x,xs) -> return m `mplus` tailsM xs
With cuts l = zip (inits l) (tails l), cutsM is the equivalent for MonadSplit.
> cutsM :: (MonadSplit m) => m a -> m (m a, m a)
> cutsM m | miszero m = return (mzero, mzero)
> | otherwise = return (mzero, m) `mplus` do
> (x,xs) <- msplit m
> (a,b) <- cutsM xs
> return $ (return x `mplus` a, b)
> insertM :: (MonadSplit m) => a -> m a -> m (m a)
> insertM i m = do
> (a,b) <- cutsM m
> return $ a `mplus` return i `mplus` b
> permuteM :: (MonadSplit m) => m a -> m (m a)
> permuteM m | miszero m = return mzero
> | otherwise = do
> (x,xs) <- msplit m
> xs' <- permuteM xs
> insertM x xs'
As it happens, permuteM can be expressed with foldMSr.
> permuteM2 :: (MonadSplit m) => m b -> m (m b)
> permuteM2 m = foldMSr insertM mzero m
permuteWithDel means to permute the list and all sublists.
> permuteWithDelM m | miszero m = return mzero
> | otherwise = do
> (x,xs) <- msplit m
> xs' <- permuteWithDelM xs
> insertM x xs' `mplus` return xs'
> permuteWithDelM2 m = foldMSr (\x xs -> insertM x xs `mplus` return xs) mzero m
An example instance for another datatype.
> instance MonadSplit S.Seq where
> miszero = S.null
> msplit s = case S.viewl s of
> S.EmptyL -> return (undefined,
> fail "msplit used on empty sequence")
> x S.:< xs -> return (x, xs)
A "generalized" searching function:
g is "generator", a function which accepts the current search space, an
element of input, and produces a new search space.
t is "tester", a function which evaluates generated solutions
and finally, i is "input".
> search :: (MonadSplit s, MonadPlus p) =>
> (b -> p a -> s (p a)) -> (p a -> Bool) -> s b -> s (p a)
> search g t i = (foldMSr g mzero i) >>= (\x -> guard (t x) >> return x)
> test1 = search insertM (all (<4))
test1 [1..2] => [[1,2],[2,1]]
test1 [1..4] => []
> test2 = search (\x xs -> insertM x xs `mplus` return xs) (all (<4))
test2 [1..4] => [[1,2,3],[2,1,3],[2,3,1],[2,3],[1,3,2],[3,1,2],[3,2,1],
[3,2],[1,3],[3,1],[3],[1,2],[2,1],[2],[1],[]]