"血をもって書け。そうすればあなたは、血が精神だということを経験するだろう。"

マージソート

use strict;
use warnings;

my $trials = 10;
my %h = map { int rand $trials => 1 } 1..$trials;
my @target = keys %h;

print join ("\t", @target) . "\n";

split_merge(0, $#target);

print join ("\t", @target) . "\n";

sub split_merge {
  my ($begin, $end) = @_;
  return if $begin == $end;
  my $middle = int(($begin + $end) / 2);
  split_merge($begin, $middle);
  split_merge($middle + 1, $end);
  merge($begin, $middle, $end);
}

sub merge {
  my ($x, $y, $z) = @_;
  my @ary1 = @target[$x .. $y];
  my @ary2 = @target[($y+1) .. $z];
  print "$_\t" for @target[0 .. $x-1];
  print "[";
  print join("\t", @ary1);
  print "]\t[";
  print join("\t", @ary2);
  print "]\t";
  print "$_\t" for @target[$z+1 .. $#target];
  print "\n";

  my @merged;
  while (1) {
    if ($#ary1 < 0){
      @merged = (@merged, @ary2);
      last;
    }
    elsif ($#ary2 < 0) {
      @merged = (@merged, @ary1);
      last;
    }
    else {
      my ($top1, $top2) = (shift @ary1, shift @ary2);
      if ($top1 < $top2) {
        @merged = (@merged, $top1);
        @ary2 = ($top2, @ary2);
      }
      else {
        @merged = (@merged, $top2);
        @ary1 = ($top1, @ary1);
      }
    }
  }
  @target[$x .. $z] = @merged;
}
8       6       4       3       0       7       2
[8]     [6]     4       3       0       7       2
6       8       [4]     [3]     0       7       2
[6      8]      [3      4]      0       7       2
3       4       6       8       [0]     [7]     2
3       4       6       8       [0      7]      [2]
[3      4       6       8]      [0      2       7]
0       2       3       4       6       7       8

もうちょいシンプルにした

グローバル変数への依存を除いた

use strict;
use warnings;

my $trials = 10;
my %h = map { int rand $trials => 1 } 1..$trials;
my @target = keys %h;

print join ("\t", @target) . "\n";

@target = msort(@target);

print join ("\t", @target) . "\n";

sub msort {
  my @ary = @_;
  return @ary unless $#ary;
  my $middle = int($#ary / 2);
  my @ary1 = msort(@ary[0 .. $middle]);
  my @ary2 = msort(@ary[$middle+1 .. $#ary]);
  my @merged;
  while (1) {
    return (@merged, @ary2) if ($#ary1 < 0);
    return (@merged, @ary1) if ($#ary2 < 0);
    my ($top1, $top2) = (shift @ary1, shift @ary2);
    if ($top1 < $top2) {
      @merged = (@merged, $top1);
      @ary2 = ($top2, @ary2);
    }
    else {
      @merged = (@merged, $top2);
      @ary1 = ($top1, @ary1);
    }
  }
  @merged;
}