Sorting algorithms/Merge sort: Difference between revisions

m
→‎{{header|Standard ML}}: minor reformat of SML and extra example
imported>Rcmlz
m (→‎{{header|Standard ML}}: minor reformat of SML and extra example)
 
(23 intermediate revisions by 6 users not shown)
Line 2,868:
> (merge-sort 'list (list 1 3 5 7 9 8 6 4 2) #'<)
(1 2 3 4 5 6 7 8 9)
 
=={{header|Component Pascal}}==
{{works with|BlackBox Component Builder}}
 
Inspired by the approach used by the Modula-2[https://rosettacode.org/wiki/Sorting_algorithms/Merge_sort#Recursive_on_linked_list] application.
 
This an implementation of the stable merge sort algorithm for linked lists.
The merge sort algorithm is often the best choice for sorting a linked list.
 
The `Sort` procedure reduces the number of traversals by calculating the length only once at the beginning of the sorting process.
This optimization leads to a more efficient sorting process, making it faster, especially for large input lists.
 
Two modules are provided - for implementing and for using the merge sort .
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSort;
 
 
TYPE Template* = ABSTRACT RECORD END;
 
(* Abstract Procedures: *)
 
(* Return TRUE if list item`front` comes before list item `rear` in the sorted order, FALSE otherwise *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
 
(* Return the next item in the list after `s` *)
PROCEDURE (IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
 
(* Update the next pointer of list item `s` to the value of list `next` - Return the modified `s` *)
PROCEDURE (IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
 
(* Merge sorted lists `front` and `rear` - Return the merged sorted list *)
PROCEDURE (IN t: Template) Merge (front, rear: ANYPTR): ANYPTR, NEW;
BEGIN
IF front = NIL THEN RETURN rear END;
IF rear = NIL THEN RETURN front END;
IF t.Before(front, rear) THEN
RETURN t.Set(front, t.Merge(t.Next(front), rear))
ELSE
RETURN t.Set(rear, t.Merge(front, t.Next(rear)))
END
END Merge;
 
(* Sort the first `n` items in the list `s` and drop them from `s` *)
(* Return the sorted `n` items *)
PROCEDURE (IN t: Template) TakeSort (n: INTEGER; VAR s: ANYPTR): ANYPTR, NEW;
VAR k: INTEGER; front, rear: ANYPTR;
BEGIN
IF n = 1 THEN (* base case: if `n` is 1, return the head of `s` *)
front := s; s := t.Next(s); RETURN t.Set(front, NIL)
END;
(* Divide the first `n` items of `s` into two sorted parts *)
k := n DIV 2;
front := t.TakeSort(k, s);
rear := t.TakeSort(n - k, s);
RETURN t.Merge(front, rear) (* Return the merged parts *)
END TakeSort;
 
(* Perform a merge sort on `s` - Return the sorted list *)
PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
VAR n: INTEGER; r: ANYPTR;
BEGIN
IF s = NIL THEN RETURN s END; (* If `s` is empty, return `s` *)
(* Count of items in `s` *)
n := 0; r := s; (* Initialize the item to be counted to `s` *)
WHILE r # NIL DO INC(n); r := t.Next(r) END;
RETURN t.TakeSort(n, s) (* Return the sorted list *)
END Sort;
 
END RosettaMergeSort.
</syntaxhighlight>
Interface extracted from implementation:
<syntaxhighlight lang="oberon2">
DEFINITION RosettaMergeSort;
 
TYPE
Template = ABSTRACT RECORD
(IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
(IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Sort (s: ANYPTR): ANYPTR, NEW
END;
 
END RosettaMergeSort.
</syntaxhighlight>
Use the merge sort implementation from `RosettaMergeSort` to sort a linked list of characters:
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSortUse;
 
(* Import Modules: *)
IMPORT Sort := RosettaMergeSort, Out;
 
(* Type Definitions: *)
TYPE
(* a character list *)
List = POINTER TO RECORD
value: CHAR;
next: List
END;
 
(* Implement the abstract record type Sort.Template *)
Order = ABSTRACT RECORD (Sort.Template) END;
Asc = RECORD (Order) END;
Bad = RECORD (Order) END;
Desc = RECORD (Order) END;
 
(* Abstract Procedure Implementations: *)
 
(* Return the next node in the linked list *)
PROCEDURE (IN t: Order) Next (s: ANYPTR): ANYPTR;
BEGIN RETURN s(List).next END Next;
 
(* Set the next pointer of list item `s` to `next` - Return the updated `s` *)
PROCEDURE (IN t: Order) Set (s, next: ANYPTR): ANYPTR;
BEGIN
IF next = NIL THEN s(List).next := NIL
ELSE s(List).next := next(List) END;
RETURN s
END Set;
 
(* Ignoring case, compare characters to determine ascending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Asc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) <= CAP(rear(List).value)
END Before;
 
(* Unstable sort!!! *)
PROCEDURE (IN t: Bad) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) < CAP(rear(List).value)
END Before;
 
(* Ignoring case, compare characters to determine descending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Desc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) >= CAP(rear(List).value)
END Before;
 
(* Helper Procedures: *)
 
(* Takes a string and converts it into a linked list of characters *)
PROCEDURE Explode (str: ARRAY OF CHAR): List;
VAR i: INTEGER; h, t: List;
BEGIN
i := LEN(str$);
WHILE i # 0 DO
t := h; NEW(h);
DEC(i); h.value := str[i];
h.next := t
END;
RETURN h
END Explode;
 
(* Outputs the characters in a linked list as a string in quotes *)
PROCEDURE Show (s: List);
VAR i: INTEGER;
BEGIN
Out.Char('"');
WHILE s # NIL DO Out.Char(s.value); s := s.next END;
Out.Char('"')
END Show;
 
(* Main Procedure: *)
PROCEDURE Use*;
VAR a: Asc; b: Bad; d: Desc; s: List;
BEGIN
s := Explode("A quick brown fox jumps over the lazy dog");
Out.String("Before:"); Out.Ln; Show(s); Out.Ln;
s := a.Sort(s)(List); (* Ascending stable sort *)
Out.String("After Asc:"); Out.Ln; Show(s); Out.Ln;
s := b.Sort(s)(List); (* Ascending unstable sort *)
Out.String("After Bad:"); Out.Ln; Show(s); Out.Ln;
s := d.Sort(s)(List); (* Descending stable sort *)
Out.String("After Desc:"); Out.Ln; Show(s); Out.Ln
END Use;
 
 
END RosettaMergeSortUse.
</syntaxhighlight>
Execute: ^Q RosettaMergeSortUse.Use
{{out}}
<pre>
Before:
"A quick brown fox jumps over the lazy dog"
After Asc:
" Aabcdeefghijklmnoooopqrrstuuvwxyz"
After Bad:
" aAbcdeefghijklmnoooopqrrstuuvwxyz"
After Desc:
"zyxwvuutsrrqpoooonmlkjihgfeedcbaA "
</pre>
 
=={{header|Crystal}}==
Line 4,397 ⟶ 4,591:
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
<syntaxhighlight lang="julia">function mergesort(arr::Vector)
if length(arr) ≤ 1 return arr end
Line 4,417 ⟶ 4,609:
end
if li ≤ length(lpart)
copycopyto!(rst, i, lpart, li)
else
copycopyto!(rst, i, rpart, ri)
end
return rst
Line 6,484 ⟶ 6,676:
#| Recursive, single-thread, mergesort implementation
sub mergesort ( @a ) {
return @a if @a <= 1;
 
# recursion step
my $m = @a.elems div 2;
my @l = samewith @a[ 0 ..^ $m ];
my @r = samewith @a[ $m ..^ @a ];
 
# short cut - in case of no overlapping in left and right parts
return flat @l, @r if @l[*-1] !after @r[0];
return flat @r, @l if @r[*-1] !after @l[0];
 
# merge step
return flat gather {
take @l[0] before @r[0]
?? @l.shift
!! @r.shift
while @l and @r;
 
take @l, @r;
}
}
}</syntaxhighlight>
}
</syntaxhighlight>
Some intial testing
 
Line 6,516 ⟶ 6,707:
output = 1 2 3 4 5 6 7 8 9</pre>
 
===concurrent implementation===
Let's implement it using parallel sorting
 
Let's implement it using parallel sorting.
 
<syntaxhighlight lang="raku" line>
#| Recursive, naive parallelmulti-thread, mergesort implementation
protosub mergesort-parallel-naive (| -->@a Positional) {*}
return @a if @a <= 1;
multi mergesort-parallel-naive(@unsorted where @unsorted.elems < 2) { @unsorted }
multi mergesort-parallel-naive(@unsorted where @unsorted.elems == 2) {
@unsorted[0] after @unsorted[1]
?? (@unsorted[1], @unsorted[0])
!! @unsorted
}
multi mergesort-parallel-naive(@unsorted) {
my $mid = @unsorted.elems div 2;
my Promise $left-sorted = start { flat samewith @unsorted[ 0 ..^ $mid ] };
my @right-sorted = flat samewith @unsorted[ $mid ..^ @unsorted.elems ];
 
my $m = @a.elems div 2;
await $left-sorted andthen my @left-sorted = $left-sorted.result;
 
# recursion step launching new thread
return flat @left-sorted, @right-sorted if @left-sorted[*-1] !after @right-sorted[0];
my @l = start { samewith @a[ 0 ..^ $m ] };
return flat @right-sorted, @left-sorted if @right-sorted[*-1] !after @left-sorted[0];
# meanwhile recursively sort right side
return flat gather {
my @r = samewith @a[ $m ..^ @a ] ;
take @left-sorted[0] before @right-sorted[0]
 
?? @left-sorted.shift
# as we went parallel on left side, we need to await the result
!! @right-sorted.shift
await @l[0] andthen @l = @l[0].result;
while @left-sorted.elems and @right-sorted.elems;
 
take @left-sorted, @right-sorted;
# short cut - in case of no overlapping left and right parts
return flat @l, @r if @l[*-1] !after @r[0];
return flat @r, @l if @r[*-1] !after @l[0];
 
# merge step
return flat gather {
take @l[0] before @r[0]
?? @l.shift
!! @r.shift
while @l and @r;
 
take @l, @r;
}
}
</syntaxhighlight>
 
and tune the batch size required to launch a new thread.
and tune the parallel hyper-parameter - as creating a (potentially) huge number of new threads by the naive parallel approach is contra productive.
 
<syntaxhighlight lang="raku" line>
#| Recursive, parallel,batch tuned multi-thread, mergesort implementation
protosub mergesort-parallel (| -->@a, $batch = 2**9 Positional) {*}
return @a if @a <= 1;
multi mergesort-parallel(@unsorted where @unsorted.elems < 2) { @unsorted }
 
multi mergesort-parallel(@unsorted where @unsorted.elems == 2) {
my $m = @a.elems div 2;
@unsorted[0] after @unsorted[1]
?? (@unsorted[1], @unsorted[0])
!! @unsorted
}
multi mergesort-parallel(@unsorted) {
my $mid = @unsorted.elems div 2;
 
# recursion step
# atomically decide if we run left side on a new thread
my $left-sorted@l = $workerm >= 0 &&$batch
?? start { samewith @a[ 0 ..^ $m ], $midbatch > $BATCH-SIZE}
!! samewith @a[ 0 ..^ $m ], $batch ;
?? (
$worker⚛--;
start {
LEAVE $worker⚛++;
samewith @unsorted[ 0 ..^ $mid ]
}
)
!! samewith @unsorted[ 0 ..^ $mid ];
 
# recursionmeanwhile onrecursively thesort right side using current thread
my @right-sortedr = samewith @unsorteda[ $midm ..^ @unsorted.elemsa ], $batch;
 
# if we went parallel on left side, we need to await the result
# await calculation of left side
await $left-sorted@l[0] andthen $left-sorted@l = flat $left-sorted@l[0].result if @l[0] ~~ Promise;
if $left-sorted ~~ Promise;
my @left-sorted = flat $left-sorted;
 
# short cut - in case of no overlapping left and right parts
return flat @left-sortedl, @right-sortedr if @left-sortedl[*-1] !after @right-sortedr[0];
return flat @right-sortedr, @left-sortedl if @right-sortedr[*-1] !after @left-sortedl[0];
 
# merge step
return flat gather {
take @left-sortedl[0] before @right-sortedr[0]
?? @left-sortedl.shift
!! @right-sortedr.shift
while @left-sorted.elemsl and @right-sorted.elemsr;
 
take @left-sorted, @right-sorted;
take @l, @r;
}
}
</syntaxhighlight>
 
===testing===
And finaly some tests and benchmarking ( on my Laptop from 2013 )
 
Let's run some tests ...
 
<syntaxhighlight lang="raku" line>
say "x" x 10 ~ " Testing " ~ "x" x 10;
use Test;
my @functions-under-test = &mergesort, &mergesort-parallel-naive, &mergesort-parallel;
my @testcases =
() => (),
<a>.List => <a>.List,
<a a> => <a a>,
<("b", "a", b>3) => <(3, "a", "b>"),
<b a> => <a b>,
<h b a c d f e g> => <a b c d e f g h>,
(2, 3, 1, 4, 5) => (1, 2, 3, 4, 5),
<a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort
;
 
my @implementations = &mergesort, &mergesort-parallel, &mergesort-parallel-naive;
plan @testcases.elems * @implementationsfunctions-under-test.elems;
for @implementationsfunctions-under-test -> &fun {
say &fun.name;
is-deeply &fun(.key), .value, .key ~ " => " ~ .value for @testcases;
}
done-testing;
 
use Benchmark;
my $elem-length = 8;
my @unsorted of Str = ('a'..'z').roll($elem-length).join xx 10 * $worker * $BATCH-SIZE;
my $runs = 10;
 
say "Benchmarking by $runs times sorting {@unsorted.elems} strings of size $elem-length - using batches of $BATCH-SIZE strings and $worker workers for mergesort-parallel().";
say "Hint: watch the number of Raku threads in Activity Monitor on Mac, Ressource Monitor on Windows or htop on Linux.";
for @implementations -> &fun {
print &fun.name, " => avg: ";
my ($start, $end, $diff, $avg) = timethis $runs, sub { &fun(@unsorted) }
say "$avg secs, total $diff secs";
}
</syntaxhighlight>
{{out}}
<pre>xxxxxxxxxx Testing xxxxxxxxxx
<pre>1..24
1..18
mergesort
ok 1 - =>
ok 2 - a => a
ok 3 - a a => a a
ok 4 - b a b3 => 3 a b
ok 5 - h b a c d f e g => a b c d e f g h
ok 6 - h b a c🎮 d3 fz e4 g🐧 => a3 b4 c d ea fz g🎮 h🐧
ok 7 - 2 3 1 4 5 => 1 2 3 4 5
ok 8 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
mergesort-parallel
ok 9 - =>
ok 10 - a => a
ok 11 - a a => a a
ok 12 - a b => a b
ok 13 - b a => a b
ok 14 - h b a c d f e g => a b c d e f g h
ok 15 - 2 3 1 4 5 => 1 2 3 4 5
ok 16 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
mergesort-parallel-naive
ok 177 - =>
ok 188 - a => a
ok 199 - a a => a a
ok 2010 - b a b3 => 3 a b
ok 2111 - h b a c d f e g => a b c d e f g h
ok 2212 - h b a c🎮 d3 fz e4 g🐧 => a3 b4 c d ea fz g🎮 h🐧
mergesort-parallel
ok 23 - 2 3 1 4 5 => 1 2 3 4 5
ok 2413 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
ok 14 - a => a
Benchmarking by 10 times sorting 40960 strings of size 8 - using batches of 1024 strings and 4 workers for mergesort-parallel().
ok 15 - a a => a a
Hint: watch the number of Raku threads in Activity Monitor on Mac, Ressource Monitor on Windows or htop on Linux.
ok 16 - b a 3 => 3 a b
mergesort => avg: 5.2 secs, total 52 secs
ok 17 - h b a c d f e g => a b c d e f g h
mergesort-parallel => avg: 2.3 secs, total 23 secs
ok 18 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧</pre>
mergesort-parallel-naive => avg: 6.2 secs, total 62 secs
 
===benchmarking===
and some Benchmarking.
 
<syntaxhighlight lang="raku" line>
use Benchmark;
my $runs = 5;
my $elems = 10 * Kernel.cpu-cores * 2**10;
my @unsorted of Str = ('a'..'z').roll(8).join xx $elems;
my UInt $l-batch = 2**13;
my UInt $m-batch = 2**11;
my UInt $s-batch = 2**9;
my UInt $t-batch = 2**7;
 
say "elements: $elems, runs: $runs, cpu-cores: {Kernel.cpu-cores}, large/medium/small/tiny-batch: $l-batch/$m-batch/$s-batch/$t-batch";
 
my %results = timethese $runs, {
single-thread => { mergesort(@unsorted) },
parallel-naive => { mergesort-parallel-naive(@unsorted) },
parallel-tiny-batch => { mergesort-parallel(@unsorted, $t-batch) },
parallel-small-batch => { mergesort-parallel(@unsorted, $s-batch) },
parallel-medium-batch => { mergesort-parallel(@unsorted, $m-batch) },
parallel-large-batch => { mergesort-parallel(@unsorted, $l-batch) },
}, :statistics;
 
my @metrics = <mean median sd>;
my $msg-row = "%.4f\t" x @metrics.elems ~ '%s';
 
say @metrics.join("\t");
for %results.kv -> $name, %m {
say sprintf($msg-row, %m{@metrics}, $name);
}
</syntaxhighlight>
 
<pre>
elements: 40960, runs: 5, cpu-cores: 4, large/medium/small/tiny-batch: 8192/2048/512/128
mean median sd
7.7683 8.0265 0.5724 parallel-naive
3.1354 3.1272 0.0602 parallel-tiny-batch
2.6932 2.6599 0.1831 parallel-medium-batch
2.8139 2.7832 0.0641 parallel-large-batch
3.0908 3.0593 0.0675 parallel-small-batch
5.9989 5.9450 0.1518 single-thread
</pre>
 
Line 6,711 ⟶ 6,916:
a
]</pre>
 
=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, 7 6 5 9 8 4 3 1 2 0: e.Arr
= <Prout e.Arr>
<Prout <Sort e.Arr>>;
};
 
Sort {
= ;
s.N = s.N;
e.X, <Split e.X>: (e.L) (e.R) = <Merge (<Sort e.L>) (<Sort e.R>)>;
};
 
Split {
(e.L) (e.R) = (e.L) (e.R);
(e.L) (e.R) s.X = (e.L s.X) (e.R);
(e.L) (e.R) s.X s.Y e.Z = <Split (e.L s.X) (e.R s.Y) e.Z>;
e.X = <Split () () e.X>;
};
 
Merge {
(e.L) () = e.L;
() (e.R) = e.R;
(s.X e.L) (s.Y e.R), <Compare s.X s.Y>: {
'-' = s.X <Merge (e.L) (s.Y e.R)>;
s.Z = s.Y <Merge (s.X e.L) (e.R)>;
};
};</syntaxhighlight>
{{out}}
<pre>7 6 5 9 8 4 3 1 2 0
0 1 2 3 4 5 6 7 8 9</pre>
 
=={{header|REXX}}==
Line 7,109 ⟶ 7,346:
end func;</syntaxhighlight>
Original source: [http://seed7.sourceforge.net/algorith/sorting.htm#mergeSort2]
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program merge_sort;
test := [-8, 241, 9, 316, -6, 3, 413, 9, 10];
print(test, '=>', mergesort(test));
 
proc mergesort(m);
if #m <= 1 then
return m;
end if;
 
middle := #m div 2;
left := mergesort(m(..middle));
right := mergesort(m(middle+1..));
if left(#left) <= right(1) then
return left + right;
end if;
return merge(left, right);
end proc;
 
proc merge(left, right);
result := [];
loop while left /= [] and right /= [] do
if left(1) <= right(1) then
item fromb left;
else
item fromb right;
end if;
result with:= item;
end loop;
return result + left + right;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>[-8 241 9 316 -6 3 413 9 10] => [-8 -6 3 9 9 10 241 316 413]</pre>
 
=={{header|Sidef}}==
Line 7,143 ⟶ 7,415:
| merge cmp (xs, []) = xs
| merge cmp (xs as x::xs', ys as y::ys') =
case cmp (x, y) of GREATER => y :: merge cmp (xs, ys')
| _ GREATER => xy :: merge cmp (xs', ys')
| _ => x :: merge cmp (xs', ys)
;
 
fun merge_sort cmp [] = []
| merge_sort cmp [x] = [x]
Line 7,153 ⟶ 7,426:
in
merge cmp (merge_sort cmp ys, merge_sort cmp zs)
end</syntaxhighlight>
{{out|Poly/ML}}
;
<pre>
merge_sort Int.compare [8,6,4,2,1,3,5,7,9]</syntaxhighlight>
> merge_sort Int.compare [8,6,4,2,1,3,5,7,9];
val it = [1, 2, 3, 4, 5, 6, 7, 8, 9]: int list
> merge_sort String.compare ["Plum", "Pear", "Peach", "Each"];
val it = ["Each", "Peach", "Pear", "Plum"]: string list
>
</syntaxhighlight>
 
=={{header|Swift}}==
Line 7,217 ⟶ 7,496:
templates merge
@: $(2);
[ $(1)... -> \(#, $@...] !
 
when <?($@merge<[](0)>)
when | ..<?($@merge <[](10)> do)
| ..$@(1)> !do
otherwise$ !
otherwise
^@merge(1) !
^@(1) $ -> #!
\), $ -> #
$@...] !
end merge
$ -> #
Line 7,444 ⟶ 7,722:
 
=={{header|Wren}}==
<syntaxhighlight lang="ecmascriptwren">var merge = Fn.new { |left, right|
var result = []
while (left.count > 0 && right.count > 0) {
Line 7,476 ⟶ 7,754:
}
 
var asarray = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in asarray) {
System.print("Before: %(a)")
a = mergeSort.call(a)
Line 7,495 ⟶ 7,773:
Alternatively we can just call a library method.
{{libheader|Wren-sort}}
<syntaxhighlight lang="ecmascriptwren">import "./sort" for Sort
 
var asarray = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in asarray) {
System.print("Before: %(a)")
a = Sort.merge(a)
23

edits