[REBOL] Sort, history and present
From: lmecir:volny:cz at: 13-Dec-2010 15:13
A sort-related discussion from the Core group in Rebol3 AltMe world
reminded me my post to this list (in discussion with Tim Peters):
***Msort0***
#[[Ladislav-1998
A few remarks to the Quick Sort benchmark. The source was criticized,
because of it's lack to handle the special cases. The problem is, that when
you improved it, it didn't correspond to the source, so there was no way,
how to compare the times. But, for me, it served well. It has proven the
capability of Rebol to "mechanically" translate some usual constructs in
other languages in no time. That feature may be needed some time. Here is
another sorting method - The Merge Sort. You may try to compare the times,
it looks good, here is the example:
elem time
10 0:00
100 0:00:02
500 0:00:09
1000 0:00:20
REBOL[
Title: "Merge Sort"
Author: Ladislav Mecir
Email:lmecir-geocities.com
Date: 8/2/1998
Purpose: {
sort a series
}
]
compare: func [a b] [
return a< b
]
div2: func [x] [
if (x // 2) = 0 [return x / 2]
else [return (x - 1) / 2]
]
msort: func [a] [
msort_do a length? a
]
msort_do: function [a l] [b lb c lc] [
if l<= 1 [return a]
else [
lb: div2 l
b: (msort_do a lb)
lc: l - lb
c: (msort_do skip a lb lc)
merge b lb c lc
]
]
merge: function [a la b lb] [res cont] [
res: head insert/part tail copy/part a la b lb
cont: true
while [cont] [
if (compare first a first b) [
change res first a
a: next a
la: la - 1
cont: la> 0
] else [
change res first b
b: next b
lb: lb - 1
cont: lb> 0
]
res: next res
]
if la> 0 [change/part res a la]
else [change/part res b lb]
return head res
]
Ladislav-1998]]
Since the code is 1.x, it uses ELSE. A translation not using ELSE and workable in R3
can look as follows:
compare: :lesser-or-equal?
div2: func [x][to integer! x / 2]
msort0: func [a][msort_do a length? a]
msort_do: function [a l][b lb c lc][
either l<= 1 [return a][
lb: div2 l
b: (msort_do a lb)
lc: l - lb
c: (msort_do skip a lb lc)
merge b lb c lc
]
]
merge: function [a la b lb][res cont][
res: make block! la + lb
cont: true
while [cont][
either (compare first a first b)[
append/only res first a
a: next a
la: la - 1
cont: la> 0
][
append/only res first b
b: next b
lb: lb - 1
cont: lb> 0
]
res: next res
]
either la> 0 [append/part res a la][append/part res b lb]
head res
]
Results:
a: copy [] repeat i 500 [append a i]
random/seed 0
random a
>> time-block [msort0 copy a] 0,05
== 0.009
***Msort1***
Since the memory consumption of the above code was O(N*log N), I almost immediately rewrote
it to consume only O(N) memory instead. The code:
msort1: function [a compare] [msort-do merge] [
if (length? a)< 2 [return a]
; define a recursive Msort-do function
msort-do: function [a b l] [mid] [
either l< 4 [
if l = 3 [msort-do next b next a 2]
merge a b 1 next b l - 1
] [
mid: make integer! l / 2
msort-do b a mid
msort-do skip b mid skip a mid l - mid
merge a b mid skip b mid l - mid
]
]
; function Merge is the key part of the algorithm
merge: func [a b lb c lc] [
until [
either (compare first b first c) [
change/only a first b
b: next b
a: next a
zero? lb: lb - 1
] [
change/only a first c
c: next c
a: next a
zero? lc: lc - 1
]
]
loop lb [
change/only a first b
b: next b
a: next a
]
loop lc [
change/only a first c
c: next c
a: next a
]
]
msort-do a copy a length? a
a
]
Since the code consumed less memory, it also ran faster:
>> time-block [msort1 copy a :lesser-or-equal?] 0,05
== 0.00825
***Msort(2)***
While the above code is using less memory, there is a way how to make the merge even
"more in place", which leads to the code:
msort: function [
{merge-sort a series in place}
a [series!]
compare [any-function!]
][msort-do merge][
; define a recursive Msort-do function
msort-do: function [a l][mid b][
either l<= 2 [
unless any [
l< 2
compare first a second a
][
set/any 'b first a
change/only a second a
change/only next a get/any 'b
]
][
mid: to integer! l / 2
msort-do a mid
msort-do skip a mid l - mid
merge a mid skip a mid l - mid
]
]
; the Merge function is the key part of the algorithm
merge: func [a la b lb /local c][
c: copy/part a la
until [
either (compare first b first c)[
change/only a first b
b: next b
a: next a
zero? lb: lb - 1
][
change/only a first c
c: next c
a: next a
zero? length? c
]
]
unless zero? length? c [change a c]
]
msort-do a length? a
a
]
I guess, that it will be no surprise for you, that since the code does less shuffling
again, it runs even faster:
>> time-block [msort copy a :lesser-or-equal?] 0,05
== 0.007375
-Ladislav
