Sorting algorithms/Merge sort: Difference between revisions

<syntaxhighlight lang="raku" line>

#| Recursive, single-thread, mergesort implementation

sub mergesort ( @a ) {

# recursion step

my @l = samewith @a[ 0 ..^ $m ];

my @r = samewith @a[ $m ..^ @a ];

# 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

take @l[0] before @r[0]

?? @l.shift

!! @r.shift

while @l and @r;

</syntaxhighlight>

Some intial testing

<syntaxhighlight lang="raku" line>

Let's implement it using parallel sorting

<syntaxhighlight lang="raku" line>

#| Recursive, naive parallel, mergesort implementation

proto mergesort-parallel-naive(| --> Positional) {*}

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 ];

await $left-sorted andthen my @left-sorted = $left-sorted.result;

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>

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>

constant $BATCH-SIZE = 2**10;

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-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];

# merge step

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>

And finaly some tests and benchmarking ( on my Laptop from 2013 )

<syntaxhighlight lang="raku" line>

use Test;

my @testcases =

() => (),

<a>.List => <a>.List,

<a a> => <a a>,

<a b> => <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 * $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>1..24

mergesort

ok 1 - =>

ok 2 - a => a

ok 3 - a a => a a

ok 4 - a b => a b

ok 5 - b a => a b

ok 6 - h b a c d f e g => a b c d e f 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 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>