|
=={{header|Raku}}==
<syntaxhighlight lang="raku" line>
#| Recursive, single-thread, mergesortmerge-sort implementation
sub mergesortmerge-sort ( @a ) {
return @a if @a <= 1;
<syntaxhighlight lang="raku" line>
# no I/O or other blocking operation included -> low thread number appropriate - saving one for the system
#| Recursive, naive parallel, mergesort implementation
$*SCHEDULER = ThreadPoolScheduler.new( max_threads => Kernel.cpu-cores - 1 );
proto mergesort-parallel-naive(| --> Positional) {*}
# many calculations but single calculation is fast -> large batch size appropriate
multi mergesort-parallel-naive(@unsorted where @unsorted.elems < 2) { @unsorted }
my UInt $BATCH = 2**10;
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 ];
#| Recursive, multi-thread, merge-sort implementation
await $left-sorted andthen my @left-sorted = $left-sorted.result;
multi merge-sort-parallel ( @a where @a.elems < 2) { @a }
multi merge-sort-parallel ( @a ) {
my $m = @a.elems div 2;
return flat @left-sorted, @right-sorted if @left-sorted[*-1] !after @right-sorted[0];
return flat @right-sorted, @left-sorted if @right-sorted[*-1] !after @left-sorted[0];
return flat gather {
take @left-sorted[0] before @right-sorted[0]
?? @left-sorted.shift
!! @right-sorted.shift
while @left-sorted.elems and @right-sorted.elems;
take @left-sorted, @right-sorted;
}
}
</syntaxhighlight>
my @l = $m > $BATCH
and tune the parallel hyper-parameter - as creating a (potentially) huge number of new threads by the naive parallel approach is contra productive.
?? start { samewith @a[ 0 ..^ $m ] }
!! samewith @a[ 0 ..^ $m ];
# meanwhile recursively sort right side
<syntaxhighlight lang="raku" line>
my @r = samewith @a[ $m ..^ @a ];
# if we went parallel on left side, we need to await the result
constant $BATCH-SIZE = 2**10;
await @l[0] andthen @l = @l[0].result if @l[0] ~~ Promise;
my atomicint $worker = $*KERNEL.cpu-cores;
#| Recursive, parallel, tuned, mergesort implementation
proto mergesort-parallel(| --> Positional) {*}
multi mergesort-parallel(@unsorted where @unsorted.elems < 2) { @unsorted }
multi mergesort-parallel(@unsorted where @unsorted.elems == 2) {
@unsorted[0] after @unsorted[1]
?? (@unsorted[1], @unsorted[0])
!! @unsorted
}
multi mergesort-parallel(@unsorted) {
my $mid = @unsorted.elems div 2;
# atomically decide if we run left side on a new thread
my $left-sorted = ⚛$worker > 0 &&
$mid > $BATCH-SIZE
?? (
$worker⚛--;
start {
LEAVE $worker⚛++;
samewith @unsorted[ 0 ..^ $mid ]
}
)
!! samewith @unsorted[ 0 ..^ $mid ];
# recursion on the right side using current thread
my @right-sorted = samewith @unsorted[ $mid ..^ @unsorted.elems ];
# await calculation of left side
await $left-sorted andthen $left-sorted = flat $left-sorted.result
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>
Let's run some tests and a minimal benchmark
And finaly some tests and benchmarking ( on my Laptop from 2013 )
<syntaxhighlight lang="raku" line>
<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 * @implementations.elems;
for @implementations -> &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 * $workerKernel.cpu-cores * $BATCH-SIZE2**10;
my $runs = 10;
sub test-and-benchmark(&function) {
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 &function.name;
say "Hint: watch the number of Raku threads in Activity Monitor on Mac, Ressource Monitor on Windows or htop on Linux.";
say "Testing";
for @implementations -> &fun {
is-deeply &function(.key), .value, .key ~ " => " ~ .value for @testcases;
print &fun.name, " => avg: ";
say "Benchmarking";
my ($start, $end, $diff, $avg) = timethis $runs, sub { &fun(@unsorted) }
my ($start, $end, $diff, $avg) = timethis $runs, sub { &function(@unsorted) }
say "$avg secs, total $diff secs";
say "$runs runs avg: $avg secs";
}
&test-and-benchmark(&merge-sort);
&test-and-benchmark(&merge-sort-parallel);
</syntaxhighlight>
{{out}}
<pre>1..24merge-sort
Testing
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🐧
Benchmarking
ok 7 - 2 3 1 4 5 => 1 2 3 4 5
10 runs avg: 5 secs
ok 8 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
mergesortmerge-sort-parallel
Testing
ok 9 - =>
ok 107 - a => a
ok 118 - a a => a a
ok 129 - a ba => a ba
ok 1310 - b a 3 => 3 a b
ok 1411 - h b a c d f e g => a b c d e f g h
ok 1512 - 2a 🎮 3 1z 4 5🐧 => 1 2 3 4 5a z 🎮 🐧
Benchmarking
ok 16 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
10 runs avg: 3.6 secs</pre>
mergesort-parallel-naive
ok 17 - =>
ok 18 - a => a
ok 19 - a a => a a
ok 20 - a b => a b
ok 21 - b a => a b
ok 22 - h b a c d f e g => a b c d e f g h
ok 23 - 2 3 1 4 5 => 1 2 3 4 5
ok 24 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
Benchmarking by 10 times sorting 40960 strings of size 8 - using batches of 1024 strings and 4 workers for mergesort-parallel().
Hint: watch the number of Raku threads in Activity Monitor on Mac, Ressource Monitor on Windows or htop on Linux.
mergesort => avg: 5.2 secs, total 52 secs
mergesort-parallel => avg: 2.3 secs, total 23 secs
mergesort-parallel-naive => avg: 6.2 secs, total 62 secs
</pre>
=={{header|REBOL}}==
|