Add instance Monad ZipList

Fri Jun 5 22:51:46 UTC 2020

Does this add anything in the sized list case?

On Fri, Jun 5, 2020 at 2:50 AM Gershom B <gershomb at gmail.com> wrote:

> Anything of kind (* -> *) gives a codensity monad. What’s important is
> that only monad-like things (like the “bad” ziplist monad instance) can be
> lifted _into_ codensity in a universal way  (otherwise you only get the
> “free” pure from codensity itself). And furthermore, only at least
> applicatives can be lowered back into the underlying functor via
> lowerCodensity.  Note in particular:
>
> instance Serial m a => Serial m (Codensity ZL a) where
>
> series = lift <$> series
>
>
> where lift in turn packs in the “bad” bind.
>
> So  in particular, with codensity over ziplist, we get back something that
> zips like a ziplist but also has a valid monad instance. So that doesn’t
> say that ZipList [a] has a monad instance. But it does say that we can get
> something which acts as an applicative just like ZipList [a], but does have
> a valid monad instance.  We just need a richer underlying type to express
> that algebraic structure.
>
> You might see this more clearly if you change the tests to not operate
> directly on “Codensity ZL” but instead to take arguments of “ZL” and
> manually lift them.
>
> More generally if you have something that is “almost a monad” but whose
> candidate bind does not associate, I think you can create something else
> which behaves the same in all other respects, but which is a monad, by
> using codensity to reassociate the bind.
>
> Maybe to highlight that something is happening at all, note that this
> trick can’t be done with the Const applicative, since there’s no good
> candidate bind operator that yields the desired <*>.
>
>
> -g
> On Jun 5, 2020, 1:50 AM -0400, David Feuer <david.feuer at gmail.com>, wrote:
>
> I'm not really sure what you're getting at here. Codensity will turn
> anything into a Monad. How does that relate to the question of whether
> there's a valid `Monad ZipList` instance?
>
> On Fri, Jun 5, 2020 at 1:42 AM Gershom B <gershomb at gmail.com> wrote:
>
>
> Using Roman’s smallcheck code (thanks!) here’s some evidence that
> codensity turns a bad diagonalizing ziplist instance into a good one, by
> fixing associativity. I’ve been pondering this for some time, and I’m glad
> this thread kicked me into making it work out. Also, as David noted, this
> works with or without the “take i” in the code, which enforces that minimum
> criteria I mentioned. So I suppose there’s a range of possibilities here.
>
> If this works out, it looks like this also shows that a “purely algebraic”
> argument as to why ZipList can’t be a monad doesn't exist. I.e. there’s no
> conflict in the laws. It’s just that using a plain list as the underlying
> datastructure can’t force a uniform associativity.
>
> To make a real “monadic ziplist” out of this, I think the codensity stuff
> would just need to be inlined under the ziplist constructor.
>
> Cheers,
> Gershom
>
> import Data.List
> import Data.Maybe
> import Test.SmallCheck.Series
> import Test.Tasty
> import Test.Tasty.SmallCheck
> import Control.Monad
> import Control.Applicative
> import System.Environment
>
> data ZL a = ZL {unZL :: [a]} deriving (Eq, Show)
>
>
> instance Functor ZL where
> fmap f (ZL xs) = ZL (fmap f xs)
>
> joinZL :: ZL (ZL a) -> ZL a
> joinZL (ZL []) = ZL []
> joinZL (ZL zs) = ZL (chop . diag (0,[]) $ map unZL zs)
> where diag :: (Int,[a]) -> [[a]] -> (Int,[a])
> diag (i,acc) [] = (i,acc)
> diag (i,acc) (x:xs) = case drop i x of
> [] -> (length x, acc)
> (y:_) ->diag (i+1, (y : acc)) xs
> chop (i,acc) = take i $ reverse acc
>
> instance Applicative ZL where
> pure = return
> f <*> x = joinZL $ fmap (\g -> fmap g x) f
>
> instance Monad ZL where
> return x = ZL (repeat x)
> x >>= f = joinZL $ fmap (f $) x
>
>
> newtype Codensity m a = Codensity { runCodensity :: forall b. (a -> m b)
> -> m b }
>
> instance Functor (Codensity k) where fmap f (Codensity m) = Codensity (\k
> -> m (\x -> k (f x)))
>
> instance Applicative (Codensity f) where
> pure x = Codensity (\k -> k x)
> Codensity f <*> Codensity g = Codensity (\bfr -> f (\ab -> g (\x -> bfr
> (ab x))))
>
> instance Monad (Codensity f) where
> return = pure
> m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))
>
> lowerCodensity :: Monad m => Codensity m a -> m a
> lowerCodensity a = runCodensity a return
>
> lift m = Codensity (m >>=)
>
> -- tests
>
> instance Serial m a => Serial m (ZL a) where
> series = ZL <$> series
>
> instance Serial m a => Serial m (Codensity ZL a) where
> series = lift <$> series
>
> instance Show (Codensity ZL Int) where
> show x = show (lowerCodensity x)
>
> instance Show (Codensity ZL Bool) where
> show x = show (lowerCodensity x)
>
> main = do
> setEnv "TASTY_SMALLCHECK_DEPTH" "4"
> defaultMain $ testGroup "Monad laws"
> [ testProperty "Right identity" $ \(z :: Codensity ZL Int) ->
> lowerCodensity (z >>= return) == lowerCodensity z
> , testProperty "Left identity" $ \(b :: Bool) (f :: Bool -> Codensity ZL
> Bool) ->
> lowerCodensity (return b >>= f) == lowerCodensity (f b)
> , testProperty "Associativity" $
> \(f1 :: Bool -> Codensity ZL Bool)
> (f2 :: Bool -> Codensity ZL Bool)
> (z :: Codensity ZL Bool) ->
> lowerCodensity (z >>= (\x -> f1 x >>= f2)) == lowerCodensity ((z >>= f1)
> >>= f2)
> ]
> On Jun 4, 2020, 4:04 PM -0400, 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
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
> _______________________________________________
> 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/20200605/d6bdce2b/attachment-0001.html>