Create a sorted list from n sorted sublists (efficiently)

user_8893864 0
Viewed 167

I was playing around with parallel sorting tonight. 

creating sort file
naive-sort ...
1000000
23.61265496
partial-hyper-sort ...
4
7.4924575
simple-hyper-sort ...
1000000
141.7945921
naive-hyper-sort ...
1000000
23.5756172

Two things stand out.

a) naive-hyper-sort is just as fast as ordinary sort b) The sorting in partial-hyper-sort is 66% faster than ordinary sort.

My problem: partial-hyper-sort is exactly that: "partial". It returns (on my system) 4 sublists, but you want of course one. My attempt to merge them into one (simple-hyper-sort) is an order of magnitude slower than the whole sorting!

So how do I get this faster? And if someone can explain why naive-hyper-sort is not faster than naive-sort, bonus points and a cookie (seriously, a literal cookie).

create-sortfile
    unless "tosort.txt".IO.e;

my $start = DateTime.now;
say "naive-sort ...";
say naive-sort.elems;
say DateTime.now - $start;

$start = DateTime.now;
say "partial-hyper-sort ...";
say partial-hyper-sort.elems;
say DateTime.now - $start;

$start = DateTime.now;
say "simple-hyper-sort ...";
say simple-hyper-sort.elems;
say DateTime.now - $start;


$start = DateTime.now;
say "naive-hyper-sort ...";
say naive-hyper-sort.elems;
say DateTime.now - $start;

sub create-sortfile
{
    say "creating sort file";
    my $to-sort = "tosort.txt".IO.open(:w);
    $to-sort.say( ( 10_000 .. 99_999 ).pick )
        for ( 1 .. 1_000_000  );

    $to-sort.close;
}

sub simple-hyper-sort
{
    my $to-sort = "tosort.txt".IO.open( :r );
    my $lines   = $to-sort.lines;
    my $degrees = $*KERNEL.cpu-cores;
    my $batch   = $lines.elems div $degrees;
    my @parts   = $lines.batch( $batch ).hyper( :batch(1) ).map({ .sort });
    my @index   = 0 xx $degrees;

    return gather loop
    {
        my $smallest        = Inf;
        my $smallest-index  = -1;
        my $smallest-degree = -1;

        for ^$degrees -> $degree
        {
            my $index = @index[$degree];

            if ( $index < $batch )
            {
                my $value = @parts[$degree;$index];

                if $value < $smallest
                {
                    $smallest = $value;
                    $smallest-index = $index;
                    $smallest-degree = $degree;
                }
            }
        }

        last if $smallest-index < 0;
        @index[$smallest-degree]++;
        take $smallest;
    }
}


sub partial-hyper-sort
{
    my $to-sort = "tosort.txt".IO.open( :r );
    my $lines   = $to-sort.lines;
    my $degrees = $*KERNEL.cpu-cores;
    my $batch   = $lines.elems div $degrees;
    my @parts   = $lines.batch( $batch ).hyper( :batch(1) ).map({ .sort });
}

multi sub naive-hyper-sort
{
    my $to-sort = "tosort.txt".IO.open( :r );
    my $lines   = $to-sort.lines;
    my $degrees = $*KERNEL.cpu-cores;
    my $batch   = $lines.elems div $degrees;
    $lines.hyper( :$batch, :$degrees ).sort;
}

sub naive-sort {
    my $to-sort = "tosort.txt".IO.open( :r );
    $to-sort.lines.sort;
}
parallel-processing raku sorting
1 Answers

Using .hyper and .race only results in a speedup if there is a parallel implementation of the operation that follows. At the time of writing, there is not a parallel sort implementation in Rakudo, which means that it will fall back to using the regular sort implementation. So, this answers why native-hyper-sort doesn't come out faster right now (however it almost certainly will in the future).

The idea in simple-hyper-sort is along the right lines: break the data up into sublists, sort the sublists, and then merge them. We can therefore parallelize the sorting of the sublists. As you've observed, this achieving a win is dependent on the merge operation itself being fast enough, and so we'd need to carefully optimize that.

It's much easier to write a tight (not to mention correct!) merge operation if it only needs to merge two sublists. Thus, we need to structure the problem in a way that gives us that. This points to a different approach:

  1. Break the list in half
  2. start a task to sort each half
  3. await the two tasks
  4. Merge the results of the two tasks

Note that step 2 involves recursion. We stop recursing when the size of a partition is too small, and use the built-in sort on such partitions. (We can choose to define "too small" by dividing the input list size by the number of CPU cores, along the lines of your example.)

Thus we get a solution like this:

sub parallel-merge-sort {
    my $to-sort = "tosort.txt".IO.open( :r );
    my $lines = $to-sort.lines;
    return do-sort $lines, ceiling($lines.elems / $*KERNEL.cpu-cores);

    sub do-sort(@in, $limit) {
        if @in.elems < $limit {
            @in.sort
        }
        else {
            my $pivot = @in.elems div 2;
            merge |await
                (start do-sort @in[0..$pivot], $limit),
                (start do-sort @in[$pivot^..@in.end], $limit)
        }
    }

    sub merge(@a, @b) {
        my @result;
        my int $a-idx = 0;
        my int $a-elems = +@a;
        my int $b-idx = 0;
        my int $b-elems = +@b;
        my int $r-idx = 0;
        while $a-idx < $a-elems && $b-idx < $b-elems {
            my $a := @a[$a-idx];
            my $b := @b[$b-idx];
            if $a before $b {
                $a-idx++;
                @result[$r-idx++] := $a;
            }
            else {
                $b-idx++;
                @result[$r-idx++] := $b;
            }
        }
        if $a-idx < $a-elems {
            @result[$r-idx++] := $_ for @a[$a-idx..*];
        }
        elsif $b-idx < $b-elems {
            @result[$r-idx++] := $_ for @b[$b-idx..*];
        }
        return @result;
    }
}

I didn't spend terribly long optimizing this (haven't profiled, etc.), but did take care to use natives and binding in order to reduce allocations. On My Machine, this does give a speedup over the serial sorting, however.

One other easy speedup we can get on this - at the cost of a tad more complexity in the code - comes from realizing that we don't need to slice the input in do-sort until the point that we actually need to send it to the built-in sort:

sub do-sort(@in, $limit, $from = 0, $to = @in.end) {
    my $elems = $to - $from;
    if $elems < $limit {
        @in[$from..$to].sort
    }
    else {
        my $pivot = $from + $elems div 2;
        merge |await
            (start do-sort @in, $limit, $from, $pivot),
            (start do-sort @in, $limit, $pivot + 1, $to)
    }
}

Which saves some work; by this point, I measure a factor of two speedup on the machine I'm testing it on, which isn't amazing, but given we've an enforced serial O(n) step, and a bunch more parallelized O(n) steps, over the serial sort algorithm, it's perhaps not so disappointing after all.

user_78325840
Related