[Haskell-cafe] Re: excercise - a completely lazy sorting algorithm
Heinrich Apfelmus
apfelmus at quantentunnel.de
Thu Jul 9 05:31:52 EDT 2009
Matthias Görgens wrote:
> Interesting. Can you make the definition of quicksort non-recursive,
> too? Perhaps with help of a bootstrapping combinator like the one
> implicit in the approach I have given earlier?
>
>> treeSort = bootstrap partitionOnMedian
>> bootstrap f = Fix . helper . f
>> where helper = fmap (Fix . helper . f)
>
>> partitionOnMedian :: forall a. (Ord a) => (S.Seq a) -> BTreeRaw a (S.Seq a)
>
> Extra points if you can give 'bootstrap' or an equivalent in terms of
> existing Haskell combinators.
Sure, no problem.
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
This scheme is a combination of the anamorphism which builds the tree of
recursive calls
data Fix f = In { out :: f (Fix f) }
ana :: Functor f => (a -> f a) -> a -> Fix f
ana f = In . fmap (ana f) . f
and a catamorphism which combines the results
cata :: Functor f => (f b -> b) -> Fix f -> b
cata g = g . fmap (cata g) . out
so we could also write
hylo f g = cata g . ana f
For quicksort, the call tree is the fixed point of the functor
type Size = Int
data Q a b = Empty | Merge Size a b b
instance Functor (Q a) where
fmap f (Merge n x b b') = Merge n x (f b) (f b')
fmap f Empty = Empty
The algorithm
quicksort = hylo partition merge
proceeds in the two well-known phases: first, the input list is
partitioned into two parts separated by a pivot
partition [] = Empty
partition (x:xs) = Merge (length xs + 1) x ls xs
where
ls = filter (<= x) xs
rs = filter (> x) xs
and then the sorted results are merged
merge Empty = []
merge (Merge _ x a b) = a ++ [x] ++ b
The random access tree implementation can be obtained by using a
different merge function. In particular, the quicksort from my
previous post was parametrized on merge (with a slightly different way
to indicate the list lengths); any function of type
(Size -> a -> b -> b -> b) -> b -> c
is equivalent to a function of type
(Q a b -> b) -> c
Incidentally, the random access tree *is* the call tree for quicksort,
so we'd have
merge = In
and we can shorten the whole thing to
quicksort = ana partition
which is essentially what you coded.
To read about hylo f g = cata g . ana f with quicksort as example
again in a slightly different light, see also the following blog post by
Ulisses Costa
http://ulissesaraujo.wordpress.com/2009/04/09/hylomorphisms-in-haskell/
Regards,
apfelmus
--
http://apfelmus.nfshost.com
More information about the Haskell-Cafe
mailing list