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:[email protected] 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 -- To unsubscribe from the list, just send an email to lists at rebol.com with unsubscribe as the subject.
