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