Re: Add instance Monad ZipList

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 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 , 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@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries