Skip to content

Instantly share code, notes, and snippets.

@rcmlz
Last active October 2, 2023 11:03
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save rcmlz/04948c16df5aafc2b189e27144c74b0d to your computer and use it in GitHub Desktop.
merge-sort Raku implementation using multiple threads
#!/usr/bin/env raku --optimize=3
#| Recursive, single-thread, merge-sort 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;
}
}
#| Recursive, naive multi-thread, merge-sort implementation
sub mergesort-parallel-naive ( @a ) {
return @a if @a <= 1;
my $m = @a.elems div 2;
# recursion step
my @l = start { samewith @a[ 0 ..^ $m ] };
my @r = samewith @a[ $m ..^ @a ] ;
# as we went parallel on left side, we need to await the result
await @l[0] andthen @l = @l[0].result;
# 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;
}
}
#| Recursive, batch tuned multi-thread, merge-sort implementation
sub mergesort-parallel ( @a, $batch = 2**9 ) {
return @a if @a <= 1;
my $m = @a.elems div 2;
# recursion step
my @l = $m >= $batch
?? start { samewith @a[ 0 ..^ $m ], $batch }
!! samewith @a[ 0 ..^ $m ], $batch ;
# meanwhile recursively sort right side
my @r = samewith @a[ $m ..^ @a ], $batch;
# if we went parallel on left side, we need to await the result
await @l[0] andthen @l = @l[0].result if @l[0] ~~ Promise;
# 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;
}
}
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", 3) => (3, "a", "b"),
<h b a c d f e g> => <a b c d e f g h>,
<a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort
;
plan @testcases.elems * @functions-under-test.elems;
for @functions-under-test -> &fun {
say &fun.name;
is-deeply &fun(.key), .value, .key ~ " => " ~ .value for @testcases;
}
done-testing;
say "x" x 11 ~ " Benchmarking " ~ "x" x 11;
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) },
};
for %results.kv -> $name, ($start, $end, $diff, $avg) {
say "$name avg $avg secs"
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment