[Haskell-cafe] Re: excercise - a completely lazy sorting algorithm
Heinrich Apfelmus
apfelmus at quantentunnel.de
Wed Jul 8 14:31:13 EDT 2009
Matthias Görgens wrote:
>> So, a tree like Matthias implements it is the way to go. Basically, it
>> reifies the recursive calls of quicksort as a lazy data struture which
>> can be evaluated piecemeal.
>
> Yes. I wonder if it is possible to use a standard (randomized
> quicksort) and employ some type class magic (like continuations) to
> make the reification [1] transparent to the code.
>
> Matthias.
> [1] I reified reify.
Well, you can perform an abstraction similar to what leads to the
definition of fold .
Starting with say
sum [] = 0
sum (x:xs) = x + sum xs
we can replace the special values 0 and + by variables, leading to a
function
(fold f z) [] = z
(fold f z) (x:xs) = x `f` (fold f z) xs
In other words, if we specialize the variables to 0 and + again, we get
fold (+) 0 = sum
Similarly, we can start with quicksort
quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort ls ++ [x] ++ quicksort rs
where
ls = filter (<= x) xs
rs = filter (> x) xs
and replace the operations on the return type with variables
quicksort :: Ord a => (a -> b -> b -> b) -> b -> [a] -> b
quicksort f z [] = z
quicksort f z (x:xs) = f x (quicksort f z ls) (quicksort f z rs)
where
ls = filter (<= x) xs
rs = filter (> x) xs
Note however that this is not quite enough to handle the case of a
random access tree like you wrote it, because the latter depends on the
fact that quicksorts *preserves* the length of the list. What I mean is
that we have to keep track of the lengths of the lists, for instance
like this:
quicksort :: Ord a =>
(a -> (Int,b) -> (Int,b) -> b) -> b -> [a] -> (Int,b)
quicksort f z [] = (0,z)
quicksort f z (x:xs) =
(length xs + 1, f x (quicksort f z ls) (quicksort f z rs))
where
ls = filter (<= x) xs
rs = filter (> x) xs
And we can implement a random access tree
type Sized a = (Int, a)
size = fst
data Tree a = Empty
| Branch a (Sized (Tree a)) (Sized (Tree a))
mySort :: [a] -> Sized (Tree a)
mySort = quicksort Branch Empty
index :: Sized (Tree a) -> Int -> Maybe a
index (0,Empty) _ = Nothing
index (n,Branch x a b) k
| 1 <= k && k <= size a = index a k
| k == size a + 1 = Just x
| size a + 1 < k && k <= n = index b (k - size a - 1)
| otherwise = Nothing
or an ordinary sort
qsort :: Ord a => [a] -> [a]
qsort = quicksort (\x a b -> snd a ++ [x] ++ snd b) []
Regards,
apfelmus
--
http://apfelmus.nfshost.com
More information about the Haskell-Cafe
mailing list