-
-
Save bodil/c757af4a463b866026076eb9efe86295 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- | |
GHC's mergesort replaced by a better implementation, 24/12/2009. | |
This code originally contributed to the nhc12 compiler by Thomas Nordin | |
in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g. | |
http://www.mail-archive.com/haskell@haskell.org/msg01822.html | |
and possibly to bear similarities to a 1982 paper by Richard O'Keefe: | |
"A smooth applicative merge sort". | |
Benchmarks show it to be often 2x the speed of the previous implementation. | |
Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143 | |
-} | |
sort = sortBy compare | |
sortBy cmp = mergeAll . sequences | |
where | |
sequences (a:b:xs) | |
| a `cmp` b == GT = descending b [a] xs | |
| otherwise = ascending b (a:) xs | |
sequences xs = [xs] | |
descending a as (b:bs) | |
| a `cmp` b == GT = descending b (a:as) bs | |
descending a as bs = (a:as): sequences bs | |
ascending a as (b:bs) | |
| a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs | |
ascending a as bs = as [a]: sequences bs | |
mergeAll [x] = x | |
mergeAll xs = mergeAll (mergePairs xs) | |
mergePairs (a:b:xs) = merge a b: mergePairs xs | |
mergePairs xs = xs | |
merge as@(a:as') bs@(b:bs') | |
| a `cmp` b == GT = b:merge as bs' | |
| otherwise = a:merge as' bs | |
merge [] bs = bs | |
merge as [] = as |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
/// Sort a list using a comparator function. | |
pub fn sort_by(&self, cmp: &Fn(&A, &A) -> Ordering) -> List<A> { | |
fn merge<A>(la: &List<A>, lb: &List<A>, cmp: &Fn(&A, &A) -> Ordering) -> List<A> | |
where A: Clone | |
{ | |
match (la.uncons(), lb.uncons()) { | |
(Some((a, _)), Some((b, ref lb1))) if cmp(a, b) == Ordering::Greater => { | |
cons(b.clone(), &merge(la, &lb1, cmp)) | |
} | |
(Some((a, la1)), Some((_, _))) => cons(a.clone(), &merge(&la1, lb, cmp)), | |
(None, _) => lb.clone(), | |
(_, None) => la.clone(), | |
} | |
} | |
fn merge_pairs<A>(l: &List<List<A>>, cmp: &Fn(&A, &A) -> Ordering) -> List<List<A>> | |
where A: Clone | |
{ | |
match l.uncons2() { | |
Some((a, b, rest)) => cons(merge(a, b, cmp), &merge_pairs(&rest, cmp)), | |
_ => l.clone(), | |
} | |
} | |
fn merge_all<A>(l: &List<List<A>>, cmp: &Fn(&A, &A) -> Ordering) -> List<A> | |
where A: Clone | |
{ | |
match l.uncons() { | |
None => list![], | |
Some((a, ref d)) if d.null() => a.clone(), | |
_ => merge_all(&merge_pairs(l, cmp), cmp), | |
} | |
} | |
fn ascending<A>(a: &A, | |
f: &Fn(List<A>) -> List<A>, | |
l: &List<A>, | |
cmp: &Fn(&A, &A) -> Ordering) | |
-> List<List<A>> | |
where A: Clone | |
{ | |
match l.uncons() { | |
Some((b, ref lb)) if cmp(a, b) != Ordering::Greater => { | |
ascending(b, &|ys| f(cons(a.clone(), &ys)), &lb, cmp) | |
} | |
_ => cons(f(list![a.clone()]), &sequences(l, cmp)), | |
} | |
} | |
fn descending<A>(a: &A, | |
la: &List<A>, | |
lb: &List<A>, | |
cmp: &Fn(&A, &A) -> Ordering) | |
-> List<List<A>> | |
where A: Clone | |
{ | |
match lb.uncons() { | |
Some((b, ref bs)) if cmp(a, b) == Ordering::Greater => { | |
descending(b, &cons(a.clone(), &la), bs, cmp) | |
} | |
_ => cons(cons(a.clone(), &la), &sequences(&lb, cmp)), | |
} | |
} | |
fn sequences<A>(l: &List<A>, cmp: &Fn(&A, &A) -> Ordering) -> List<List<A>> | |
where A: Clone | |
{ | |
match l.uncons2() { | |
Some((a, b, ref xs)) if cmp(a, b) == Ordering::Greater => { | |
descending(b, &list![a.clone()], xs, cmp) | |
} | |
Some((a, b, ref xs)) => ascending(b, &|l| cons(a.clone(), &l), &xs, cmp), | |
None => list![l.clone()], | |
} | |
} | |
merge_all(&sequences(self, cmp), cmp) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment