I've been using the Free datatype in Control.Monad.Free from the free package. Now I'm trying to convert it to use F in Control.Monad.Free.Church but can't figure out how to map the functions.
For example, a simple pattern matching function using Free would look like this -
-- Pattern match Free
matchFree
:: (a -> r)
-> (f (Free f a) -> r)
-> Free f a
-> r
matchFree kp _ (Pure a) = kp a
matchFree _ kf (Free f) = kf f
I can easily convert it to a function that uses F by converting to/from Free -
-- Pattern match F (using toF and fromF)
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = matchF' . fromF
where
matchF' (Pure a) = kp a
matchF' (Free f) = kf (fmap toF f)
However I can't figure out how to get it done without using toF and fromF -
-- Pattern match F (without using toF)???
-- Doesn't compile
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf f = f kp kf
There must be a general pattern I am missing. Can you help me figure it out?
You asked for the "general pattern you are missing". Let me give my own attempt at explaining it, though Petr Pudlák's answer is also pretty good. As user3237465 says, there are two encodings that we can use, Church and Scott, and you're using Scott rather than Church. So here's the general review.
How encodings work
By continuation passing, we can describe any value of type x by some unique function of type
data Identity x = Id { runId :: x }
{- ~ - equivalent to - ~ -}
newtype IdentityFn x = IdFn { runIdFn :: forall z. (x -> z) -> z }
The "forall" here is very important, it says that this type leaves z as an unspecified parameter. The bijection is that Id . ($ id) . runIdFn goes from IdentityFn to Identity while IdFn . flip ($) . runId goes the other way. The equivalence comes because there is essentially nothing one can do with the type forall z. z, no manipulations are sufficiently universal. We can equivalently state that newtype UnitFn = UnitFn { runUnitFn :: forall z. z -> z } has only one element, namely UnitFn id, which means that it corresponds to the unit type data Unit = Unit in a similar way.
Now the currying observation that (x, y) -> z is isomorphic to x -> y -> z is the tip of a continuation-passing iceberg which allows us to represent data structures in terms of pure functions, with no data structures, because clearly the type Identity (x, y) is equivalent therefore to forall z. (x -> y -> z) -> z. So "gluing" together two items is the same as creating a value of this type, which just uses pure functions as "glue".
To see this equivalence, we have to just handle two other properties.
The first is sum-type constructors, in the form of Either x y -> z. See, Either x y -> z is isomorphic to
newtype EitherFn x y = EitherFn { runEitherFn :: forall z. (x -> z) -> (y -> z) -> z }
from which we get the basic idea of the pattern:
Take a fresh type variable z that does not appear in the body of the expression.
For each constructor of the data type, create a function-type which takes all of its type-arguments as parameters, and returns a z. Call these "handlers" corresponding to the constructors. So the handler for (x, y) is (x, y) -> z which we curry to x -> y -> z, and the handlers for Left x | Right y are x -> z and y -> z. If there are no parameters, you can just take a value z as your function rather than the more cumbersome () -> z.
Take all of those handlers as parameters to an expression forall z. Handler1 -> Handler2 -> ... -> HandlerN -> z.
One half of the isomorphism is basically just to hand the constructors in as the desired handlers; the other pattern-matches on the constructors and applies the correponding handlers.
Subtle missing things
Again, it's fun to apply these rules to various things; for example as I noted above, if you apply this to data Unit = Unit you find that any unit type is the identity function forall z. z -> z, and if you apply this to data Bool = False | True you find the logic functions forall z. z -> z -> z where false = const while true = const id. But if you do play with it you will notice that something's missing still. Hint: if we look at
data List x = Nil | Cons x (List x)
we see that the pattern should look like:
data ListFn x = ListFn { runListFn :: forall z. z -> (x -> ??? -> z) -> z }
for some ???. The above rules don't pin down what goes there.
There are two good options: either we use the power of the newtype to its fullest to put ListFn x there (the "Scott" encoding), or we can preemptively reduce it with the functions we've been given, in which case it becomes a z using the functions that we already have (the "Church" encoding). Now since the recursion is already being performed for us up-front, the Church encoding is only perfectly equivalent for finite data structures; the Scott encoding can handle infinite lists and such. It can also be hard to understand how to encode mutual recursion in the Church form whereas the Scott form is usually a little more straightforward.
Anyway, the Church encoding is a little harder to think about, but a little more magical because we get to approach it with wishful thinking: "assume that this z is already whatever you're trying to accomplish with tail list, then combine it with head list in the appropriate way." And this wishful thinking is precisely why people have trouble understanding foldr, as the one side of this bijection is precisely the foldr of the list.
There are some other problems like "what if, like Int or Integer, the number of constructors is big or infinite?". The answer to this particular question is to use the functions
data IntFn = IntFn { runIntFn :: forall z. (z -> z) -> z -> z }
What is this, you ask? Well, a smart person (Church) has worked out that this is a way to represent integers as the repetition of composition:
zero f x = x
one f x = f x
two f x = f (f x)
{- ~ - increment an `n` to `n + 1` - ~ -}
succ n f = f . n f
Actually on this account m . n is the product of the two. But I mention this because it is not too hard to insert a () and flip arguments around to find that this is actually forall z. z -> (() -> z -> z) -> z which is the list type [()], with values given by length and addition given by ++ and multiplication given by >>.
For greater efficiency, you might Church-encode data PosNeg x = Neg x | Zero | Pos x and use the Church encoding (keeping it finite!) of [Bool] to form the Church encoding of PosNeg [Bool] where each [Bool] implicitly ends with an unstated True at its most-significant bit at the end, so that [Bool] represents the numbers from +1 to infinity.
An extended example: BinLeaf / BL
One more nontrivial example, we might think about the binary tree which stores all of its information in leaves, but also contains annotations on the internal nodes: data BinLeaf a x = Leaf x | Bin a (BinLeaf a x) (BinLeaf a x). Following the recipe for Church encoding we do:
newtype BL a x = BL { runBL :: forall z. (x -> z) -> (a -> z -> z -> z) -> z}
Now instead of Bin "Hello" (Leaf 3) (Bin "What's up?" (Leaf 4) (Leaf 5) we construct instances in lowercase:
BL $ \leaf bin -> bin "Hello" (leaf 3) (bin "What's up?" (leaf 4) (leaf 5)
The isomorphism is thus very easy one way: binleafFromBL f = runBL f Leaf Bin. The other side has a case dispatch, but is not too bad.
What about recursive algorithms on the recursive data? This is where it gets magical: foldr and runBL of Church encoding have both run whatever our functions were on the subtrees before we get to the trees themselves. Suppose for example that we want to emulate this function:
sumAnnotate :: (Num n) => BinLeaf a n -> BinLeaf (n, a) n
sumAnnotate (Leaf n) = Leaf n
sumAnnotate (Bin a x y) = Bin (getn x' + getn y', a) x' y'
where x' = sumAnnotate x
y' = sumAnnotate y
getn (Leaf n) = n
getn (Bin (n, _) _ _) = n
What do we have to do?
-- pseudo-constructors for BL a x.
makeLeaf :: x -> BL a x
makeLeaf x = BL $ \leaf _ -> leaf x
makeBin :: a -> BL a x -> BL a x -> BL a x
makeBin a l r = BL $ \leaf bin -> bin a (runBL l leaf bin) (runBL r leaf bin)
-- actual function
sumAnnotate' :: (Num n) => BL a n -> BL n n
sumAnnotate' f = runBL f makeLeaf (\a x y -> makeBin (getn x + getn y, a) x y) where
getn t = runBL t id (\n _ _ -> n)
We pass in a function \a x y -> ... :: (Num n) => a -> BL (n, a) n -> BL (n, a) n -> BL (n, a) n. Notice that the two "arguments" are of the same type as the "output" here. With Church encoding, we have to program as if we've already succeeded -- a discipline called "wishful thinking".
The Church encoding for the Free monad
The Free monad has normal form
data Free f x = Pure x | Roll f (Free f x)
and our Church encoding procedure says that this becomes:
newtype Fr f x = Fr {runFr :: forall z. (x -> z) -> (f z -> z) -> z}
Your function
matchFree p _ (Pure x) = p x
matchFree _ f (Free x) = f x
becomes simply
matchFree' p f fr = runFr fr p f
Let me describe the difference for a simpler scenario - lists. Let's focus on how one can consume lists:
By a catamorphism, which essentially means that we can express it using
foldr :: (a -> r -> r) -> r -> [a] -> r
As we can see, the folding functions never get hold of the list tail, only its processed value.
By pattern matching we can do somewhat more, in particular we can construct a generalized fold of type
foldrGen :: (a -> [a] -> r) -> r -> [a] -> r
It's easy to see that one can express foldr using foldrGen. However, as foldrGen isn't recursive, this expression involves recursion.
To generalize both concepts, we can introduce
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
which gives the consuming function even more power: Both the reduced value of the tail, as well as the tail itself. Clearly this is more generic than both previous ones. This corresponds to a paramorphism which “eats its argument and keeps it too”.
But it's also possible to do it the other way round. Even though paramorphisms are more general, they can be expressed using catamorphisms (at some overhead cost) by re-creating the original structure on the way:
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
foldrPara f z = snd . foldr f' ([], z)
where
f' x t#(xs, r) = (x : xs, f x t)
Now Church-encoded data structures encode the catamorphism pattern, for lists it's everything that can be constructed using foldr:
newtype List a = L (forall r . r -> (a -> r -> r) -> r)
nil :: List a
nil = L $ \n _ -> n
cons :: a -> List a -> List a
cons x (L xs) = L $ \n c -> c x (xs n c)
fromL :: List a -> [a]
fromL (L f) = f [] (:)
toL :: [a] -> List a
toL xs = L (\n c -> foldr c n xs)
In order to see the sub-lists, we have take the same approach: re-create them on the way:
foldrParaL :: (a -> (List a, r) -> r) -> r -> List a -> r
foldrParaL f z (L l) = snd $ l (nil, z) f'
where
f' x t#(xs, r) = (x `cons` xs, f x t)
This applies generally to Church-encoded data structures, like to the encoded free monad. They express catamorphisms, that is folding without seeing the parts of the structure, only with the recursive results. To get hold of sub-structures during the process, we need to recreate them on the way.
Your
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
looks like the Scott-encoded Free monad. The Church-encoded version is just
matchF
:: Functor f
=> (a -> r)
-> (f r -> r)
-> F f a
-> r
matchF kp kf f = runF f kp kf
Here are Church- and Scott-encoded lists for comparison:
newtype Church a = Church { runChurch :: forall r. (a -> r -> r) -> r -> r }
newtype Scott a = Scott { runScott :: forall r. (a -> Scott a -> r) -> r -> r }
It's a bit of a nasty one. This problem is a more general version of a puzzle everyone struggles with the first time they're exposed to it: defining the predecessor of a natural number encoded as a Church numeral (think: Nat ~ Free Id ()).
I've split my module into a lot of intermediate definitions to highlight the solution's structure. I've also uploaded a self-contained gist for ease of use.
I start with nothing exciting: redefining F given that I don't have this package installed at the moment.
{-# LANGUAGE Rank2Types #-}
module MatchFree where
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
Now, even before considering pattern-matching, we can start by defining the counterpart of the usual datatype's constructors:
pureF :: a -> F f a
pureF a = F $ const . ($ a)
freeF :: Functor f => f (F f a) -> F f a
freeF f = F $ \ pr fr -> fr $ fmap (\ inner -> runF inner pr fr) f
Next, I'm introducing two types: Open and Close. Close is simply the F type but Open corresponds to having observed the content of an element of F f a: it's Either a pure a or an f (F f a).
type Open f a = Either a (f (F f a))
type Close f a = F f a
As hinted by my hand-wavy description, these two types are actually equivalent and we can indeed write functions converting back and forth between them:
close :: Functor f => Open f a -> Close f a
close = either pureF freeF
open :: Functor f => Close f a -> Open f a
open f = runF f Left (Right . fmap close)
Now, we can come back to your problem and the course of action should be pretty clear: open the F f a and then apply either kp or kf depending on what we got. And it indeed works:
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = either kp kf . open
Coming back to the original comment about natural numbers: predecessor implemented using Church numeral is linear in the size of the natural number when we could reasonably expect a simple case analysis to be constant time. Well, just like for natural numbers, this case analysis is pretty expensive because, as show by the use of runF in the definition of open, the whole structure is traversed.
Related
lens offers holesOf, which is a somewhat more general and powerful version of this hypothetical function:
holesList :: Traversable t
=> t a -> [(a, a -> t a)]
Given a container, holesList produces a list of elements of the container along with functions for replacing those elements.
The type of holesList, like that of the real holesOf, fails to capture the fact that the number of pairs produced will equal the number of elements of the container. A much more beautiful type, therefore, would be
holes :: Traversable t
=> t a -> t (a, a -> t a)
We could implement holes by using holesList to make a list and then traversing in State to slurp the elements back in. But this is unsatisfactory for two reasons, one of which has practical consequences:
The slurping code will have an unreachable error call to handle the case where the list runs empty before the traversal is complete. This is disgusting, but probably doesn't matter much to someone using the function.
Containers that extend infinitely to the left, or that bottom out on the left, won't work at all. Containers that extend very far to the left will be very inefficient to handle.
I'm wondering if there's any way around these problems. It's quite possible to capture the shape of the traversal using something like Magma in lens:
data FT a r where
Pure :: r -> FT a r
Single :: a -> FT a a
Map :: (r -> s) -> FT a r -> FT a s
Ap :: FT a (r -> s) -> FT a r -> FT a s
instance Functor (FT a) where
fmap = Map
instance Applicative (FT a) where
pure = Pure
(<*>) = Ap
runFT :: FT a t -> t
runFT (Pure t) = t
runFT (Single a) = a
runFT (Map f x) = f (runFT x)
runFT (Ap fs xs) = runFT fs (runFT xs)
Now we have
runFT . traverse Single = id
traverse Single makes a tree full of elements along with the function applications needed to build them into a container. If we replace an element in the tree, we can runFT the result to get a container with that element replaced. Unfortunately, I am stuck: I don't know what the next step might look like.
Vague thoughts: adding another type parameter might help change element types. The Magma type does something like this, and it goes back at least as far as Zemyla's comment on Van Laarhoven's blog post about FunList.
Your existing solution calls runMag once for every branch in the tree defined by Ap constructors.
I haven't profiled anything, but as runMag is itself recursive, this might slow things down in a large tree.
An alternative would be to tie the knot so you're only (in effect) calling runMag once for the entire tree:
data Mag a b c where
One :: a -> Mag a b b
Pure :: c -> Mag a b c
Ap :: Mag a b (c -> d) -> Mag a b c -> Mag a b d
instance Functor (Mag a b) where
fmap = Ap . Pure
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes = \t ->
let m :: Mag a b (t b)
m = traverse One t
in fst $ go id m m
where
go :: (x -> y)
-> Mag a (a, a -> y) z
-> Mag a a x
-> (z, x)
go f (One a) (One _) = ((a, f), a)
go _ (Pure z) (Pure x) = (z, x)
go f (Ap mg mi) (Ap mh mj) =
let ~(g, h) = go (f . ($j)) mg mh
~(i, j) = go (f . h ) mi mj
in (g i, h j)
go _ _ _ = error "only called with same value twice, constructors must match"
I have not managed to find a really beautiful way to do this. That might be because I'm not clever enough, but I suspect it is an inherent limitation of the type of traverse. But I have found a way that's only a little bit ugly! The key indeed seems to be the extra type argument that Magma uses, which gives us the freedom to build a framework expecting a certain element type and then fill in the elements later.
data Mag a b t where
Pure :: t -> Mag a b t
Map :: (x -> t) -> Mag a b x -> Mag a b t
Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
One :: a -> Mag a b b
instance Functor (Mag a b) where
fmap = Map
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
-- We only ever call this with id, so the extra generality
-- may be silly.
runMag :: forall a b t. (a -> b) -> Mag a b t -> t
runMag f = go
where
go :: forall u. Mag a b u -> u
go (Pure t) = t
go (One a) = f a
go (Map f x) = f (go x)
go (Ap fs xs) = go fs (go xs)
We recursively descend a value of type Mag x (a, a -> t a) (t (a, a -> t a)) in parallel with one of type Mag a a (t a) using the latter to produce the a and a -> t a values and the former as a framework for building t (a, a -> t) from those values. x will actually be a; it's left polymorphic to make the "type tetris" a little less confusing.
-- Precondition: the arguments should actually be the same;
-- only their types will differ. This justifies the impossibility
-- of non-matching constructors.
smash :: forall a x t u.
Mag x (a, a -> t) u
-> Mag a a t
-> u
smash = go id
where
go :: forall r b.
(r -> t)
-> Mag x (a, a -> t) b
-> Mag a a r
-> b
go f (Pure x) _ = x
go f (One x) (One y) = (y, f)
go f (Map g x) (Map h y) = g (go (f . h) x y)
go f (Ap fs xs) (Ap gs ys) =
(go (f . ($ runMag id ys)) fs gs)
(go (f . runMag id gs) xs ys)
go _ _ _ = error "Impossible!"
We actually produce both Mag values (of different types!) using a single call to traverse. These two values will actually be represented by a single structure in memory.
holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes t = smash mag mag
where
mag :: Mag a b (t b)
mag = traverse One t
Now we can play with fun values like
holes (Reverse [1..])
where Reverse is from Data.Functor.Reverse.
Here is an implementation that is short, total (if you ignore the circularity), doesn't use any intermediate data structures, and is lazy (works on any kind of infinite traversable):
import Control.Applicative
import Data.Traversable
holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runKA id $ for t $ \a ->
KA $ \k ->
let f a' = fst <$> k (a', f)
in (a, f)
newtype KA r a = KA { runKA :: (a -> r) -> a }
instance Functor (KA r) where fmap f a = pure f <*> a
instance Applicative (KA r) where
pure a = KA (\_ -> a)
liftA2 f (KA ka) (KA kb) = KA $ \cr ->
let
a = ka ar
b = kb br
ar a' = cr $ f a' b
br b' = cr $ f a b'
in f a b
KA is a "lazy continuation applicative functor". If we replace it with the standard Cont monad, we also get a working solution, which is not lazy, however:
import Control.Monad.Cont
import Data.Traversable
holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runCont id $ for t $ \a ->
cont $ \k ->
let f a' = fst <$> k (a', f)
in k (a, f)
This doesn't really answer the original question, but it shows another angle. It looks like this question is actually tied rather deeply to a previous question I asked. Suppose that Traversable had an additional method:
traverse2 :: Biapplicative f
=> (a -> f b c) -> t a -> f (t b) (t c)
Note: This method can actually be implemented legitimately for any concrete Traversable datatype. For oddities like
newtype T a = T (forall f b. Applicative f => (a -> f b) -> f (T b))
see the illegitimate ways in the answers to the linked question.
With that in place, we can design a type very similar to Roman's, but with a twist from rampion's:
newtype Holes t m x = Holes { runHoles :: (x -> t) -> (m, x) }
instance Bifunctor (Holes t) where
bimap f g xs = Holes $ \xt ->
let
(qf, qv) = runHoles xs (xt . g)
in (f qf, g qv)
instance Biapplicative (Holes t) where
bipure x y = Holes $ \_ -> (x, y)
fs <<*>> xs = Holes $ \xt ->
let
(pf, pv) = runHoles fs (\cd -> xt (cd qv))
(qf, qv) = runHoles xs (\c -> xt (pv c))
in (pf qf, pv qv)
Now everything is dead simple:
holedOne :: a -> Holes (t a) (a, a -> t a) a
holedOne x = Holes $ \xt -> ((x, xt), x)
holed :: Traversable t => t a -> t (a, a -> t a)
holed xs = fst (runHoles (traverse2 holedOne xs) id)
Recently I've finally started to feel like I understand catamorphisms. I wrote some about them in a recent answer, but briefly I would say a catamorphism for a type abstracts over the process of recursively traversing a value of that type, with the pattern matches on that type reified into one function for each constructor the type has. While I would welcome any corrections on this point or on the longer version in the answer of mine linked above, I think I have this more or less down and that is not the subject of this question, just some background.
Once I realized that the functions you pass to a catamorphism correspond exactly to the type's constructors, and the arguments of those functions likewise correspond to the types of those constructors' fields, it all suddenly feels quite mechanical and I don't see where there is any wiggle room for alternate implementations.
For example, I just made up this silly type, with no real concept of what its structure "means", and derived a catamorphism for it. I don't see any other way I could define a general-purpose fold over this type:
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
xCata a b c d v = case v of
A i x -> a i x
B -> b
C f x -> c f (xCata a b c d x)
D x -> d x
My question is, does every type have a unique catamorphism (up to argument reordering)? Or are there counterexamples: types for which no catamorphism can be defined, or types for which two distinct but equally reasonable catamorphisms exist? If there are no counterexamples (i.e., the catamorphism for a type is unique and trivially derivable), is it possible to get GHC to derive some sort of typeclass for me that does this drudgework automatically?
The catamorphism associated to a recursive type can be derived mechanically.
Suppose you have a recursively defined type, having multiple constructors, each one with its own arity. I'll borrow OP's example.
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
Then, we can rewrite the same type by forcing each arity to be one, uncurrying everything. Arity zero (B) becomes one if we add a unit type ().
data X a b f = A (Int, b)
| B ()
| C (f a, X a b f)
| D a
Then, we can reduce the number of constructors to one, exploiting Either instead of multiple constructors. Below, we just write infix + instead of Either for brevity.
data X a b f = X ((Int, b) + () + (f a, X a b f) + a)
At the term-level, we know we can rewrite any recursive definition
as the form x = f x where f w = ..., writing an explicit fixed point equation x = f x. At the type-level, we can use the same method
to refector recursive types.
data X a b f = X (F (X a b f)) -- fixed point equation
data F a b f w = F ((Int, b) + () + (f a, w) + a)
Now, we note that we can autoderive a functor instance.
deriving instance Functor (F a b f)
This is possible because in the original type each recursive reference only occurred in positive position. If this does not hold, making F a b f not a functor, then we can't have a catamorphism.
Finally, we can write the type of cata as follows:
cata :: (F a b f w -> w) -> X a b f -> w
Is this the OP's xCata type? It is. We only have to apply a few type isomorphisms. We use the following algebraic laws:
1) (a,b) -> c ~= a -> b -> c (currying)
2) (a+b) -> c ~= (a -> c, b -> c)
3) () -> c ~= c
By the way, it's easy to remember these isomorphisms if we write (a,b) as a product a*b, unit () as1, and a->b as a power b^a. Indeed they become
c^(a*b) = (c^a)^b
c^(a+b) = c^a*c^b
c^1 = c
Anyway, let's start to rewrite the F a b f w -> w part, only
F a b f w -> w
=~ (def F)
((Int, b) + () + (f a, w) + a) -> w
=~ (2)
((Int, b) -> w, () -> w, (f a, w) -> w, a -> w)
=~ (3)
((Int, b) -> w, w, (f a, w) -> w, a -> w)
=~ (1)
(Int -> b -> w, w, f a -> w -> w, a -> w)
Let's consider the full type now:
cata :: (F a b f w -> w) -> X a b f -> w
~= (above)
(Int -> b -> w, w, f a -> w -> w, a -> w) -> X a b f -> w
~= (1)
(Int -> b -> w)
-> w
-> (f a -> w -> w)
-> (a -> w)
-> X a b f
-> w
Which is indeed (renaming w=r) the wanted type
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
The "standard" implementation of cata is
cata g = wrap . fmap (cata g) . unwrap
where unwrap (X y) = y
wrap y = X y
It takes some effort to understand due to its generality, but this is indeed the intended one.
About automation: yes, this can be automatized, at least in part.
There is the package recursion-schemes on hackage which allows
one to write something like
type X a b f = Fix (F a f b)
data F a b f w = ... -- you can use the actual constructors here
deriving Functor
-- use cata here
Example:
import Data.Functor.Foldable hiding (Nil, Cons)
data ListF a k = NilF | ConsF a k deriving Functor
type List a = Fix (ListF a)
-- helper patterns, so that we can avoid to match the Fix
-- newtype constructor explicitly
pattern Nil = Fix NilF
pattern Cons a as = Fix (ConsF a as)
-- normal recursion
sumList1 :: Num a => List a -> a
sumList1 Nil = 0
sumList1 (Cons a as) = a + sumList1 as
-- with cata
sumList2 :: forall a. Num a => List a -> a
sumList2 = cata h
where
h :: ListF a a -> a
h NilF = 0
h (ConsF a s) = a + s
-- with LambdaCase
sumList3 :: Num a => List a -> a
sumList3 = cata $ \case
NilF -> 0
ConsF a s -> a + s
A catamorphism (if it exists) is unique by definition. In category theory a catamorphism denotes the unique homomorphism from an initial algebra into some other algebra. To the best of my knowledge in Haskell all catamorphisms exists because Haskell's types form a Cartesian Closed Category where terminal objects, all products, sums and exponentials exist. See also Bartosz Milewski's blog post about F-algebras, which gives a good introduction to the topic.
Can someone please help me understand this map definition in Professor Wadler's original paper Monads for Functional Programming (Haskell).
map :: (a → b) →(M a →M b)
map f m =m >= λa.unit(f a)
I understand why it is declared as a morphism from f::a -> b to g::Ma -> Mb. Why is it confusingly defined as seemingly taking 2 args f and m. m is a computation ( function with side effects) that I assume can be defined as data or type.
A definition of the form
foo x y z = bar
is equivalent to all of the following ones
foo x y = \z -> bar
foo x = \y z -> bar
foo = \x y z -> bar
Hence, the posted code could also be written as
map :: (a → b) → (M a → M b)
map f = \m -> m >= \a -> unit (f a)
-- which is parsed as
-- map f = \m -> (m >= (\a -> (unit (f a))))
The above indeed emphasizes that map maps functions to functions, and is arguably clearer. However, it is a bit more verbose, so it is common in Haskell to move the arguments to the left side of = as much as possible.
The second argument is the first argument for the returned function:
map : (a -> b) -> m a -> m b
map = \(f : a -> b) -> \(x : m a) ->
x >>= (\a -> return (f a))
I was reviewing some code and came across the following gem, which I'd wager is a copy-paste of pointfree output:
(I thought the following would more appropriate than the usual foo/bar for this particular question :P)
import Control.Monad (liftM2)
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x' y' = Battleship { x = x', y = y' }
coordinates :: Battleship -> (Int, Int)
coordinates = liftM2 (,) x y
Would someone be kind enough to explain the steps needed to simplify from: (i) coordinates b = (x b, y b) to: (ii) coordinates = liftM2 (,) x y? In particular, I'm a bit confused as to the use of liftM2 as I wasn't even aware that a monad was lurking in the background.
I know that (i) can also be represented as: coordinates s = (,) (x s) (y s) but I'm not sure where/how to proceed.
P.S. The following is why I suspect it's from pointfree (output is from GHCI and :pl is aliased to pointfree):
λ: :pl coordinates s = (x s, y s)
coordinates = liftM2 (,) x y
This takes advantage of the Monad instance for (->) r, also called the "reader monad". This is the monad of functions from a specific type to a. (Take a look here for motivation on why it exists in the first place.)
To see how it works for various functions, replace m with (r -> in m a. For example, if we just do liftM, we get:
liftM :: (a -> b) -> (m a -> m b)
liftM :: (a -> b) -> ((r -> a) -> (r -> b))
:: (a -> b) -> (r -> a) -> (r -> b) -- simplify parentheses
...which is just function composition. Neat.
We can do the same thing for liftM2:
liftM2 :: (a -> b -> c) -> m a -> m b -> m c
liftM2 :: (a -> b -> c) -> (r -> a) -> (r -> b) -> (r -> c)
So what we see is a way to compose two one-argument functions with a two-argument function. It's a way of generalizing normal function composition to more than one argument. The idea is that we create a function that takes a single r by passing that through both of the one-argument functions, getting two arguments to pass into the two-argument function. So if we have f :: (r -> a), g :: (r -> b) and h :: (a -> b -> c), we produce:
\ r -> h (f r) (h r)
Now, how does this apply to your code? (,) is the two-argument function, and x and y are one-argument functions of the type Battleship -> Int (because that's how field accessors work). With this in mind:
liftM2 (,) x y = \ r -> (,) (x r) (y r)
= \ r -> (x r, y r)
Once you've internalized the idea of multiple function composition like this, point-free code like this becomes quite a bit more readable—no need to use the pointfree tool! In this case, I think the non-pointfree version is still better, but the pointfree one isn't terrible itself.
The monad liftM2 is working over here is the function monad (->) a. This is equivalent to the Reader monad, as you may have seen before.
Recall the definition of liftM2:
liftM2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r
liftM2 f ma mb = do
a <- ma
b <- mb
return $ f a b
So now if we substitute in (,) for f, x for ma, and y for mb, we get
liftM2 (,) x y = do
a <- x
b <- y
return $ (,) a b
Since x, y :: Battleship -> Int which is equivalent to ((->) Battleship) Int, then m ~ (->) Battleship. The function monad is defined as
instance Monad ((->) a) where
return x = const x
m >>= f = \a -> f (m a) a
Essentially what the function monad does is allow you to extract the output from several functions provided they all have the same input. A more clear example might be something like
test = do
a <- (^2)
b <- (^3)
c <- (^4)
d <- show
return (a, b, c, d)
> test 2
(4, 8, 16, "2")
You could easily rewrite
data Battleship = Battleship { x :: Int
, y :: Int
} deriving Show
placeBattleship :: Int -> Int -> Battleship
placeBattleship x y = Battleship x y
coordinates :: Battleship -> (Int, Int)
coordinates (Battleship x y) = (x, y)
It isn't point-free style, but quite simple
Or to be specific, why do we use foldr to encode lists and iteration to encode numbers?
Sorry for the longwinded introduction, but I don't really know how to name the things I want to ask about so I'll need to give some exposition first. This draws heavily from this C.A.McCann post that just not quite satisfies my curiosity and I'll also be handwaving the issues with rank-n-types and infinite lazy things.
One way to encode datatypes as functions is to create a "pattern matching" function that receives one argument for each case, each argument being a function that receives the values corresponding to that constructor and all arguments returning a same result type.
This all works out as expected for non-recursive types
--encoding data Bool = true | False
type Bool r = r -> r -> r
true :: Bool r
true = \ct cf -> ct
false :: Bool r
false = \ct cf -> cf
--encoding data Either a b = Left a | Right b
type Either a b r = (a -> r) -> (b -> r) -> r
left :: a -> Either a b r
left x = \cl cr -> cl x
right :: b -> Either a b r
right y = \cl cr -> cr y
However, the nice analogy with pattern matching breaks down with recursive types. We might be tempted to do something like
--encoding data Nat = Z | S Nat
type RecNat r = r -> (RecNat -> r) -> r
zero = \cz cs -> cz
succ n = \cz cs -> cs n
-- encoding data List a = Nil | Cons a (List a)
type RecListType a r = r -> (a -> RecListType -> r) -> r
nil = \cnil ccons -> cnil
cons x xs = \cnil ccons -> ccons x xs
but we can't write those recursive type definitions in Haskell! The usual solution is to force the callback of the cons/succ case to be applied to all levels of recursion instead of just the first one (ie, writing a fold/iterator). In this version we use the return type r where the recursive type would be:
--encoding data Nat = Z | S Nat
type Nat r = r -> (r -> r) -> r
zero = \cz cf -> cz
succ n = \cz cf -> cf (n cz cf)
-- encoding data List a = Nil | Cons a (List a)
type recListType a r = r -> (a -> r -> r) -> r
nil = \z f -> z
cons x xs = \z f -> f x (xs z f)
While this version works, it makes defining some functions much harder. For example, writing a "tail" function for lists or a "predecessor" function for numbers is trivial if you can use pattern matching but gets tricky if you need to use the folds instead.
So onto my real questions:
How can we be sure that the encoding using folds is as powerful as the hypothetical "pattern matching encoding"? Is there a way to take an arbitrary function definition via pattern matching and mechanically convert it to one using only folds instead? (If so, this would also help make tricky definitions such as tail or foldl in terms of foldr as less magical)
Why doesn't the Haskell type system allow for the recursive types needed in the "pattern matching" encoding?. Is there a reason for only allowing recursive types in datatypes defined via data? Is pattern matching the only way to consume recursive algebraic datatypes directly? Does it have to do with the type inferencing algorithm?
Given some inductive data type
data Nat = Succ Nat | Zero
we can consider how we pattern match on this data
case n of
Succ n' -> f n'
Zero -> g
it should be obvious that every function of type Nat -> a can be defined by giving an appropriate f and g and that the only ways to make a Nat (baring bottom) is using one of the two constructors.
EDIT: Think about f for a moment. If we are defining a function foo :: Nat -> a by giving the appropriate f and g such that f recursively calls foo than we can redefine f as f' n' (foo n') such that f' is not recursive. If the type a = (a',Nat) than we can instead write f' (foo n). So, without loss of generality
foo n = h $ case n
Succ n' -> f (foo n)
Zero -> g
this is the formulation that makes the rest of my post make sense:
So, we can thus think about the case statement as applying a "destructor dictionary"
data NatDict a = NatDict {
onSucc :: a -> a,
onZero :: a
}
now our case statement from before can become
h $ case n of
Succ n' -> onSucc (NatDict f g) n'
Zero -> onZero (NatDict f g)
given this we can derive
newtype NatBB = NatBB {cataNat :: forall a. NatDict a -> a}
we can then define two functions
fromBB :: NatBB -> Nat
fromBB n = cataNat n (NatDict Succ Zero)
and
toBB :: Nat -> NatBB
toBB Zero = Nat $ \dict -> onZero dict
toBB (Succ n) = Nat $ \dict -> onSucc dict (cataNat (toBB n) dict)
we can prove these two functions are witness to an isomorphism (up to fast and lose reasoning) and thus show that
newtype NatAsFold = NatByFold (forall a. (a -> a) -> a -> a)
(which is just the same as NatBB) is isomorphic to Nat
We can use the same construction with other types, and prove that the resulting function types are what we want just by proving that the underlying types are isomorphic with algebraic reasoning (and induction).
As to your second question, Haskell's type system is based on iso-recursive not equi-recursive types. This is probably becuase the theory and type inference is easier to work out with iso-recursive types, and they have all the power they just impose a little more work on the programmers part. I like to claim that you can get your iso-recursive types without any overhead
newtype RecListType a r = RecListType (r -> (a -> RecListType -> r) -> r)
but apparently GHCs optimizer chokes on those sometimes :(.
The Wikipedia page on Scott encoding has some useful insights. The short version is, what you're referring to is the Church encoding, and your "hypothetical pattern-match encoding" is the Scott encoding. Both are sensible ways of doing things, but the Church encoding requires lighter type machinery to use (in particular, it does not require recursive types).
The proof that the two are equivalent uses the following idea:
churchfold :: (a -> b -> b) -> b -> [a] -> b
churchfold _ z [] = z
churchfold f z (x:xs) = f x (churchfold f z xs)
scottfold :: (a -> [a] -> b) -> b -> [a] -> b
scottfold _ z [] = z
scottfold f _ (x:xs) = f x xs
scottFromChurch :: (a -> [a] -> b) -> b -> [a] -> b
scottFromChurch f z xs = fst (churchfold g (z, []) xs)
where
g x ~(_, xs) = (f x xs, x : xs)
The idea is that since churchfold (:) [] is the identity on lists, we can use a Church fold that produces the list argument it is given as well as the result it is supposed to produce. Then in the chain x1 `f` (x2 `f` (... `f` xn) ... ) the outermost f receives a pair (y, x2 : ... : xn : []) (for some y we don't care about), so returns f x1 (x2 : ... : xn : []). Of course, it also has to return x1 : ... : xn : [] so that any more applications of f could also work.
(This is actually a little similar to the proof of the mathematical principle of strong (or complete) induction, from the "weak" or usual principle of induction).
By the way, your Bool r type is a bit too big for real Church booleans – e.g. (+) :: Bool Integer, but (+) isn't really a Church boolean. If you enable RankNTypes then you can use a more precise type: type Bool = forall r. r -> r -> r. Now it is forced to be polymorphic, so genuinely only contains two (ignoring seq and bottom) inhabitants – \t _ -> t and \_ f -> f. Similar ideas apply to your other Church types, too.