Hylomorphisms (was: [Haskell-cafe] excercise - a completely lazy sorting algorithm)

Brent Yorgey byorgey at seas.upenn.edu
Sun Jul 12 13:33:50 EDT 2009


On Sun, Jul 12, 2009 at 07:01:11PM +0200, Raynor Vliegendhart wrote:
> On 7/12/09, Heinrich Apfelmus <apfelmus at quantentunnel.de> wrote:
> > Raynor Vliegendhart wrote:
> > > On 7/9/09, Heinrich Apfelmus <apfelmus at quantentunnel.de> wrote:
> > >> Of course, some part of algorithm has to be recursive, but this can be
> > >> outsourced to a general recursion scheme, like the hylomorphism
> > >>
> > >>    hylo :: Functor f => (a -> f a) -> (f b -> b) -> (a -> b)
> > >>    hylo f g = g . fmap (hylo f g) . f
> > >>
> > >
> > > Is that definition of hylo actually usable? A few on IRC tried to use
> > > that definition for a few examples, but the examples failed to
> > > terminate or blew up the stack.
> >
> > The implementation of  quicksort  with  hylo  works fine for me, given
> > medium sized inputs like for example  quicksort (reverse [1..1000]) .
> >
> > What were the examples you tried?
> >
> 
> One of the examples I tried was:
> 
>    hylo (unfoldr (\a -> Just (a,a))) head $ 42
> 
> This expression fails to determinate.
> 
> Here are two examples copumpkin tried on IRC:
> 
> <copumpkin> > let hylo f g = g . fmap (hylo f g) . f  in hylo (flip
> replicate 2) length 5
> <lambdabot>   5
> 
> <copumpkin> > let hylo f g = g . fmap (hylo f g) . f  in hylo (flip
> replicate 2) sum 5
> <lambdabot>   * Exception: stack overflow

[] is a strange functor to use with hylo, since it is already
recursive and its only base case (the empty list) doesn't contain any
a's.  Think about the intermediate structure that

  hylo (unfoldr (\a -> Just (a,a))) head

is building up: it is a list of lists of lists of lists of lists of
lists of.... no wonder it doesn't terminate! =)

Instead, it would be more normal to use something like 

  data ListF a l = Nil | Cons a l

  head :: ListF a l -> a
  head Nil = error "FLERG"
  head (Cons a _) = a

  instance Functor (ListF a) where
    fmap _ Nil = Nil
    fmap f (Cons a l) = Cons a (f l)

Taking the fixed point of (ListF a) gives us (something isomorphic to)
the normal [a], so we can do what you were presumably trying to do
with your example:

  hylo (\a -> Cons a a) head $ 42

The intermediate structure built up by this hylo is (isomorphic to) an
infinite list of 42's, and it evaluates to '42' just fine.

-Brent


More information about the Haskell-Cafe mailing list