Add instance Monad ZipList
Carter Schonwald
carter.schonwald at gmail.com
Thu Jun 4 23:47:28 UTC 2020
ONe point worth mentioning, is that for *sized* lists, I believe a ziplist
monad instance *is* possible? I think ?
i have an example of the functor/ applicative sized list stuff here
https://github.com/wellposed/numerical/blob/master/src/Numerical/Array/Shape.hs#L252-L271
*i believe* the way to write the monad instance would be to implement a
join :: SizedLIst n (SizedList n a) -> SizedList n a
that picks the diagonal. But i could be wrong? it wasn't a priority for me
at the time, but would that "diagonal" / trace be the right way to induce a
bind?
On Thu, Jun 4, 2020 at 4:04 PM Roman Cheplyaka <roma at ro-che.info> wrote:
> On 04/06/2020 09.53, Dannyu NDos wrote:
> > instance Monad ZipList where
> > ZipList [] >>= _ = ZipList []
> > ZipList (x:xs) >>= f = ZipList $ do
> > let ZipList y' = f x
> > guard (not (null y'))
> > let ZipList ys = ZipList xs >>= ZipList . join . maybeToList .
> fmap snd . uncons . getZipList . f
> > head y' : ys
> >
> > instance MonadFail ZipList where
> > fail _ = empty
> >
> > instance MonadPlus ZipList
>
> While others have commented on the general feasibility of the idea, the
> problem with this specific instance is that it appears to violate the
> associativity law:
>
> % ./ziplist --smallcheck-depth=3
>
> Monad laws
> Right identity: OK
> 21 tests completed
> Left identity: OK
> 98 tests completed
> Associativity: FAIL (0.04s)
> there exist {True->ZipList {getZipList = [True]};False->ZipList
> {getZipList = [False,True]}} {True->ZipList {getZipList =
> [True,True]};False->ZipList {getZipList = []}} ZipList {getZipList =
> [True,False]} such that
> condition is false
>
> 1 out of 3 tests failed (0.05s)
>
>
> Here's the code I used for testing:
>
> {-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses
> #-}
> import Control.Applicative
> import Control.Monad
> import Data.List
> import Data.Maybe
> import Test.SmallCheck.Series
> import Test.Tasty
> import Test.Tasty.SmallCheck
>
> instance Monad ZipList where
> ZipList [] >>= _ = ZipList []
> ZipList (x:xs) >>= f = ZipList $ do
> let ZipList y' = f x
> guard (not (null y'))
> let ZipList ys = ZipList xs >>= ZipList . join . maybeToList .
> fmap snd . uncons . getZipList . f
> head y' : ys
>
> instance Serial m a => Serial m (ZipList a) where
> series = ZipList <$> series
>
> main = defaultMain $ testGroup "Monad laws"
> [ testProperty "Right identity" $ \(z :: ZipList Int) ->
> (z >>= return) == z
> , testProperty "Left identity" $ \(b :: Bool) (f :: Bool -> ZipList
> Bool) ->
> (return b >>= f) == f b
> , testProperty "Associativity" $
> \(f1 :: Bool -> ZipList Bool)
> (f2 :: Bool -> ZipList Bool)
> (z :: ZipList Bool) ->
> (z >>= (\x -> f1 x >>= f2)) == ((z >>= f1) >>= f2)
> ]
>
> Roman
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20200604/7167eeda/attachment.html>
More information about the Libraries
mailing list