[Haskell-cafe] Set monad
Petr Pudlák
petr.mvd at gmail.com
Thu Apr 11 11:02:08 CEST 2013
One problem with such monad implementations is efficiency. Let's define
step :: (MonadPlus m) => Int -> m Int
step i = choose [i, i + 1]
-- repeated application of step on 0:
stepN :: (Monad m) => Int -> m (S.Set Int)
stepN = runSet . f
where
f 0 = return 0
f n = f (n-1) >>= step
Then `stepN`'s time complexity is exponential in its argument. This is
because `ContT` reorders the chain of computations to right-associative,
which is correct, but changes the time complexity in this unfortunate way.
If we used Set directly, constructing a left-associative chain, it produces
the result immediately:
step' :: Int -> S.Set Int
step' i = S.fromList [i, i + 1]
stepN' :: Int -> S.Set Int
stepN' 0 = S.singleton 0
stepN' n = stepN' (n - 1) `setBind` step'
where
setBind k f = S.foldl' (\s -> S.union s . f) S.empty k
See also: Constructing efficient monad instances on `Set` (and other
containers with constraints) using the continuation monad <
http://stackoverflow.com/q/12183656/1333025>
Best regards,
Petr Pudlak
2013/4/11 <oleg at okmij.org>
>
> The question of Set monad comes up quite regularly, most recently at
> http://www.ittc.ku.edu/csdlblog/?p=134
>
> Indeed, we cannot make Data.Set.Set to be the instance of Monad type
> class -- not immediately, that it. That does not mean that there is no
> Set Monad, a non-determinism monad that returns the set of answers,
> rather than a list. I mean genuine *monad*, rather than a restricted,
> generalized, etc. monad.
>
> It is surprising that the question of the Set monad still comes up
> given how simple it is to implement it. Footnote 4 in the ICFP
> 2009 paper on ``Purely Functional Lazy Non-deterministic Programming''
> described the idea, which is probably folklore. Just in case, here is
> the elaboration, a Set monad transformer.
>
> {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
>
> module SetMonad where
>
> import qualified Data.Set as S
> import Control.Monad.Cont
>
> -- Since ContT is a bona fide monad transformer, so is SetMonadT r.
> type SetMonadT r = ContT (S.Set r)
>
> -- These are the only two places the Ord constraint shows up
>
> instance (Ord r, Monad m) => MonadPlus (SetMonadT r m) where
> mzero = ContT $ \k -> return S.empty
> mplus m1 m2 = ContT $ \k -> liftM2 S.union (runContT m1 k) (runContT
> m2 k)
>
> runSet :: (Monad m, Ord r) => SetMonadT r m r -> m (S.Set r)
> runSet m = runContT m (return . S.singleton)
>
> choose :: MonadPlus m => [a] -> m a
> choose = msum . map return
>
> test1 = print =<< runSet (do
> n1 <- choose [1..5]
> n2 <- choose [1..5]
> let n = n1 + n2
> guard $ n < 7
> return n)
> -- fromList [2,3,4,5,6]
>
> -- Values to choose from might be higher-order or actions
> test1' = print =<< runSet (do
> n1 <- choose . map return $ [1..5]
> n2 <- choose . map return $ [1..5]
> n <- liftM2 (+) n1 n2
> guard $ n < 7
> return n)
> -- fromList [2,3,4,5,6]
>
> test2 = print =<< runSet (do
> i <- choose [1..10]
> j <- choose [1..10]
> k <- choose [1..10]
> guard $ i*i + j*j == k * k
> return (i,j,k))
> -- fromList [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]
>
> test3 = print =<< runSet (do
> i <- choose [1..10]
> j <- choose [1..10]
> k <- choose [1..10]
> guard $ i*i + j*j == k * k
> return k)
> -- fromList [5,10]
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130411/4b32a2bf/attachment.htm>
More information about the Haskell-Cafe
mailing list