Catamorphisms for Church-encoded lists - haskell

I want to be able to use cata from recursion-schemes package for lists in Church encoding.
type ListC a = forall b. (a -> b -> b) -> b -> b
I used a second rank type for convenience, but I don't care. Feel free to add a newtype, use GADTs, etc. if you feel it is necessary.
The idea of Church encoding is widely known and simple:
three :: a -> a -> a -> List1 a
three a b c = \cons nil -> cons a $ cons b $ cons c nil
Basically "abstract unspecified" cons and nil are used instead of "normal" constructors. I believe everything can be encoded this way (Maybe, trees, etc.).
It's easy to show that List1 is indeed isomorphic to normal lists:
toList :: List1 a -> [a]
toList f = f (:) []
fromList :: [a] -> List1 a
fromList l = \cons nil -> foldr cons nil l
So its base functor is the same as of lists, and it should be possible to implement project for it and use the machinery from recursion-schemes.
But I couldn't, so my question is "how do I do that?". For normal lists, I can just pattern match:
decons :: [a] -> ListF a [a]
decons [] = Nil
decons (x:xs) = Cons x xs
Since I cannot pattern-match on functions, I have to use a fold to deconstruct the list. I could write a fold-based project for normal lists:
decons2 :: [a] -> ListF a [a]
decons2 = foldr f Nil
where f h Nil = Cons h []
f h (Cons hh t) = Cons h $ hh : t
However I failed to adapt it for Church-encoded lists:
-- decons3 :: ListC a -> ListF a (ListC a)
decons3 ff = ff f Nil
where f h Nil = Cons h $ \cons nil -> nil
f h (Cons hh t) = Cons h $ \cons nil -> cons hh (t cons nil)
cata has the following signature:
cata :: Recursive t => (Base t a -> a) -> t -> a
To use it with my lists, I need:
To declare the base functor type for the list using type family instance Base (ListC a) = ListF a
To implement instance Recursive (List a) where project = ...
I fail at both steps.

The newtype wrapper turned out to be the crucial step I missed. Here is the code along with a sample catamorphism from recursion-schemes.
{-# LANGUAGE LambdaCase, Rank2Types, TypeFamilies #-}
import Data.Functor.Foldable
newtype ListC a = ListC { foldListC :: forall b. (a -> b -> b) -> b -> b }
type instance Base (ListC a) = ListF a
cons :: a -> ListC a -> ListC a
cons x (ListC xs) = ListC $ \cons' nil' -> x `cons'` xs cons' nil'
nil :: ListC a
nil = ListC $ \cons' nil' -> nil'
toList :: ListC a -> [a]
toList f = foldListC f (:) []
fromList :: [a] -> ListC a
fromList l = foldr cons nil l
instance Recursive (ListC a) where
project xs = foldListC xs f Nil
where f x Nil = Cons x nil
f x (Cons tx xs) = Cons x $ tx `cons` xs
len = cata $ \case Nil -> 0
Cons _ l -> l + 1

Related

Transform list in type fixed length in haskell

With the answer to this question I was able to define a list in witch the length is part of the type:
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
data Nat = Z | S Nat
data ListF (n :: Nat) a where
Nil :: (ListF 'Z a)
Cons :: a -> ListF m a -> ListF ('S m) a
I would like be able to convert a normal list in to these kind of list. If a make these:
toListF :: [a] -> ListF n a
toListF [] = Nil
toListF (x:xs) = Cons x (toListF xs)
It does't type-check, because for [a] -> ListF n a to type-check, the function should return any Nat that the caller needs:
ListF.hs:11:14: error:
• Couldn't match type ‘n’ with ‘'Z’
‘n’ is a rigid type variable bound by
the type signature for:
toListF :: forall a (n :: Nat). [a] -> ListF n a
at ListF.hs:10:1-27
Expected type: ListF n a
Actual type: ListF 'Z a
• In the expression: Nil
In an equation for ‘toListF’: toListF [] = Nil
• Relevant bindings include
toListF :: [a] -> ListF n a (bound at ListF.hs:11:1)
|
11 | toListF [] = Nil
| ^^^
Failed, no modules loaded.
The logical type for toListF I think it wold be something like exists n. [a] -> ListF n a or [a] -> (exists n. ListF n a), but of course those are not valid haskell types.
It is possible to do what I am trying to do in haskell? And how?
There are existential types in Haskell.
{-# LANGUAGE DataKinds, GADTs, KindSignatures, RankNTypes #-}
data Nat = Z | S Nat
data ListF (n :: Nat) a where
Nil :: (ListF 'Z a)
Cons :: a -> ListF m a -> ListF ('S m) a
data SomeListF a = forall n . AList (ListF n a)
You cam convert from a regular list to SomeListF:
fromList :: [a] -> SomeListF a
fromList [] = AList Nil
fromList (x:xs) = someCons x (fromList xs) where
someCons x (AList zs) = AList (Cons x zs)
You can also recover ListF from SomeListF, but only in a restricted scope. The n in forall n cannot escape, so you cannot have something like
toListF :: SomeListF a -> ListF n a
but you can have this:
withSomeList :: (forall n . ListF n a -> b) -> SomeListF a -> b
withSomeList f (AList zs) = f zs
Inside the f argument, n is known and you can for example map your list and the length of the result is statically known to be the same as the length of the argument. Here's a silly example:
zipF :: ListF n a -> ListF n b -> ListF n (a, b)
zipF Nil Nil = Nil
zipF (Cons y ys) (Cons z zs) = Cons (y, z) (zipF ys zs)
mapF :: (a->b) -> ListF n a -> ListF n b
mapF _ Nil = Nil
mapF f (Cons z zs) = Cons (f z) (mapF f zs)
zipMapF :: (a->b) -> ListF n a -> ListF n (a, b)
zipMapF f zs = zipF zs (mapF f zs)
zipMapAny :: (a->b) -> ListF n a -> SomeListF (a, b)
zipMapAny f zs = AList (zipMapF f zs)
nums = fromList [1,2,3,4,5]
numsAndSquares = withSomeList (zipMapAny (\x -> x * x)) nums
zipMapAny "knows" that the length of all the lists inside it is the same, but it cannot leak that length to the result. You cannot have for example withSomeList (zipMapF (\x -> x * x)) nums because n would escape.

How to update a structure with recursion schemes?

In recursion schemes, how can I construct something with type definition like (Recursive t, CoRecursive t) -> t -> ? -> t
I try to use recursion-schemes to update nodes. Taking list as an example, I can come up with two methods like:
update :: [a] -> Natural -> a -> [a]
update = para palg where
palg Nil _ _ = []
palg (Cons a (u, _)) 0 b = b : u
palg (Cons a (u, f)) n b = a : f (n-1) b
update' :: [a] -> Natural -> a -> [a]
update' = c2 (apo acoalg) where
c2 f a b c = f (a,b,c)
acoalg ([], _, _) = Nil
acoalg (_:as , 0, b) = Cons b $ Left as
acoalg (a:as , n, b) = Cons a $ Right (as, n-1, b)
However, these two implementations are good. In these two implementations, the constructor of ListF and [] appears in both sides of the equation. And the definition does not appear to be unique. Is there a better way to perform List update with recursion schemes?
Recursion schemes is flexible approach. You can also implement your own variant.
(Reuse cata)
zipo :: (Recursive g, Recursive h) => (Base g (h -> c) -> Base h h -> c) -> g -> h -> c
zipo alg = cata zalg
where
zalg x = alg x <<< project
update :: forall a. [a] -> Natural -> a -> [a]
update xs n a = zipo alg n xs
where
alg :: Maybe ([a] -> [a]) -> ListF a [a] -> [a]
alg _ Nil = []
alg Nothing (Cons y ys) = a:ys
alg (Just n') (Cons y ys) = y:(n' ys)
Also u can implement some parallel version like
zipCata :: (Recursive g, Recursive h) => ((g -> h -> r) -> Base g g -> Base h h -> r) -> g -> h -> r
zipCata phi x y = phi (zipCata phi) (project x) (project y)
update' :: forall a. [a] -> Natural -> a -> [a]
update' xs n a = zipCata alg n xs
where
alg :: (Natural -> [a] -> [a]) -> Maybe Natural -> ListF a [a] -> [a]
alg _ _ Nil = []
alg _ Nothing (Cons _ ys) = a:ys
alg f (Just n) (Cons y ys) = y:(f n ys)
Both variants (also as your) will be get the same result
PS. I hate approach for code sample on SO

Histomorphism a la Mendler

Using a histomorphism (histo) from recursion-schemes I can get the a list containing only the odd indexes from an initial list:
import Data.Functor.Foldable
odds :: [a] -> [a]
odds = histo $ \case
Nil -> []
Cons h (_ :< Nil) -> [h]
Cons h (_ :< Cons _ (t :< _)) -> h:t
How can get the same thing using mhisto?
nil = Fix Nil
cons a b = Fix $ Cons a b
list = cons 1 $ cons 2 $ cons 3 $ nil
modds :: Fix (ListF a) -> [a]
modds = mhisto alg where
alg _ _ Nil = []
alg f g (Cons a b) = ?
This is it:
modds :: Fix (ListF a) -> [a]
modds = mhisto alg
where
alg _ _ Nil = []
alg odd pre (Cons a b) = a : case pre b of
Nil -> []
Cons _ b' -> odd b'
GHCi> list = cata embed [1..10] :: Fix (ListF Int)
GHCi> odds (cata embed list)
[1,3,5,7,9]
GHCi> modds list
[1,3,5,7,9]
odd folds the rest of the list, while pre digs the predecessor. Note how the availability of an y -> f y function in the Mendler algebra mirrors the introduction of Cofree in the ordinary histomorphism algebra (in which digging back can be done by reaching for the tail of the Cofree stream):
cata :: Functor f => (f c -> c) -> Fix f -> c
histo :: Functor f => (f (Cofree f c) -> c) -> Fix f -> c
mcata :: (forall y. (y -> c) -> f y -> c) -> Fix f -> c
mhisto :: (forall y. (y -> c) -> (y -> f y) -> f y -> c) -> Fix f -> c
For further reading on mcata and mhisto, see chapters 5 and 6 of Categorical programming with inductive and coinductive types, by Varmo Vene.

An example for chronomorphism

I don't understand how can I create some example with chronomorphism.
I know about hylomorphism (cata, ana) also I know about histo and futu.
But I don't realize some example for chronomorphism (maybe some behavior as in Tardis monad).
Also related link https://github.com/ekmett/recursion-schemes/issues/42
This isn't related with Histomorphisms, Zygomorphisms and Futumorphisms specialised to lists because doesn't has some example with chronomorphism.
Probably the biggest use of chronomorphisms is collapsing a named syntax tree. In particular, you can refer to names that haven't been processed yet as well as names that have already been processed.
Another thing you can do with chronomorphisms is rewrite dynamorphisms! You can read more about dynamorphisms here. One of the examples they cite is the Catalan numbers. I've translated it to Haskell below.
import Data.Functor.Foldable
import Control.Arrow
import Control.Comonad.Cofree
dyna :: (Functor f) => (f (Cofree f a) -> a) -> (c -> f c) -> c -> a
dyna a c = extract . h where h = (uncurry (:<)) . (a &&& id) . fmap h . c
natural :: Int -> ListF Int Int
natural 0 = Nil
natural n = Cons n (n - 1)
takeCofree :: Int -> Cofree (ListF Int) a -> [a]
takeCofree 0 _ = []
takeCofree _ (a :< Nil) = [a]
takeCofree n (a :< Cons _ c) = a : takeCofree (n - 1) c
catalan :: Int -> Int
catalan = dyna coa natural where
coa :: ListF Int (Cofree (ListF Int) Int) -> Int
coa Nil = 1
coa (Cons x table) = sum $ zipWith (*) xs (reverse xs)
where xs = takeCofree x table
You might also find this useful. It has an example that uses a futumorphism to build a tree and a catamorphism to tear it down (though this is occluded). Of course, this map is in fact another specialization of the chronomorphism.

Recursion scheme in Haskell for repeatedly breaking datatypes into "head" and "tail" and yielding a structure of results

In Haskell, I recently found the following function useful:
listCase :: (a -> [a] -> b) -> [a] -> [b]
listCase f [] = []
listCase f (x:xs) = f x xs : listCase f xs
I used it to generate sliding windows of size 3 from a list, like this:
*Main> listCase (\_ -> take 3) [1..5]
[[2,3,4],[3,4,5],[4,5],[5],[]]
Is there a more general recursion scheme which captures this pattern? More specifically, that allows you to generate a some structure of results by repeatedly breaking data into a "head" and "tail"?
What you are asking for is a comonad. This may sound scarier than monad, but is a simpler concept (YMMV).
Comonads are Functors with additional structure:
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> w a -> w b
(extendand duplicate can be defined in terms of each other)
and laws similar to the monad laws:
duplicate . extract = id
duplicate . fmap extract = id
duplicate . duplicate = fmap duplicate . duplicate
Specifically, the signature (a -> [a] -> b) takes non-empty Lists of type a. The usual type [a] is not an instance of a comonad, but the non-empty lists are:
data NE a = T a | a :. NE a deriving Functor
instance Comonad NE where
extract (T x) = x
extract (x :. _) = x
duplicate z#(T _) = T z
duplicate z#(_ :. xs) = z :. duplicate xs
The comonad laws allow only this instance for non-empty lists (actually a second one).
Your function then becomes
extend (take 3 . drop 1 . toList)
Where toList :: NE a -> [a] is obvious.
This is worse than the original, but extend can be written as =>> which is simpler if applied repeatedly.
For further information, you may start at What is the Comonad typeclass in Haskell?.
This looks like a special case of a (jargon here but it can help with googling) paramorphism, a generalisation of primitive recursion to all initial algebras.
Reimplementing ListCase
Let's have a look at how to reimplement your function using such a combinator. First we define the notion of paramorphism: a recursion principle where not only the result of the recursive call is available but also the entire substructure this call was performed on:
The type of paraList tells me that in the (:) case, I will have access to the head, the tail and the value of the recursive call on the tail and that I need to provide a value for the base case.
module ListCase where
paraList :: (a -> [a] -> b -> b) -- cons
-> b -- nil
-> [a] -> b -- resulting function on lists
paraList c n [] = n
paraList c n (x : xs) = c x xs $ paraList c n xs
We can now give an alternative definition of listCase:
listCase' :: (a -> [a] -> b) -> [a] -> [b]
listCase' c = paraList (\ x xs tl -> c x xs : tl) []
Considering the general case
In the general case, we are interested in building a definition of paramorphism for all data structures defined as the fixpoint of a (strictly positive) functor. We use the traditional fixpoint operator:
newtype Fix f = Fix { unFix :: f (Fix f) }
This builds an inductive structure layer by layer. The layers have an f shape which maybe better grasped by recalling the definition of List using this formalism. A layer is either Nothing (we're done!) or Just (head, tail):
newtype ListF a as = ListF { unListF :: Maybe (a, as) }
type List a = Fix (ListF a)
nil :: List a
nil = Fix $ ListF $ Nothing
cons :: a -> List a -> List a
cons = curry $ Fix . ListF .Just
Now that we have this general framework, we can define para generically for all Fix f where f is a functor:
para :: Functor f => (f (Fix f, b) -> b) -> Fix f -> b
para alg = alg . fmap (\ rec -> (rec, para alg rec)) . unFix
Of course, ListF a is a functor. Meaning we could use para to reimplement paraList and listCase.
instance Functor (ListF a) where fmap f = ListF . fmap (fmap f) . unListF
paraList' :: (a -> List a -> b -> b) -> b -> List a -> b
paraList' c n = para $ maybe n (\ (a, (as, b)) -> c a as b) . unListF
listCase'' :: (a -> List a -> b) -> List a -> List b
listCase'' c = paraList' (\ x xs tl -> cons (c x xs) tl) nil
You can implement a simple bijection toList, fromList to test it if you want. I could not be bothered to reimplement take so it's pretty ugly:
toList :: [a] -> List a
toList = foldr cons nil
fromList :: List a -> [a]
fromList = paraList' (\ x _ tl -> x : tl) []
*ListCase> fmap fromList . fromList . listCase'' (\ _ as -> toList $ take 3 $ fromList as). toList $ [1..5]
[[2,3,4],[3,4,5],[4,5],[5],[]]

Resources