非再帰版マージソート

天泣記 2006-09-10 #1より。
はてなブックマークで「あとで考える」とコメントしたので、考えてみる。

とりあえず、もとのプログラムはRuby(だと思うけど自信なかったので実行したらエラーが出なかったからRubyで合ってるんだろう)で、ややこしいビット操作なんかも入っていてよくわからんのでPerlに移植してみた。

#!/usr/bin/perl

use strict;
use warnings;

sub print_array {
    my ($ary) = @_;

    printf "[%s]\n", join(',', map { sprintf "%3d", $_ } @{$ary});
}

sub merge {
    my ($ary, $i1, $w1, $i2, $w2) = @_;

    &print_array($ary);
    print " " x ($i1 * 4 + 3), "^";
    print "_" x ($w1 * 4 - 4);
    print " " x (($i2 - $i1 - $w1) * 4 + 3), "^";
    print "_" x ($w2 * 4 - 4);
    print "\n";

    my $as = $i1;
    my $ae = $i1 + $w1 - 1;
    my $b = [ @{$ary}[$i2 .. $i2 + $w2 - 1] ];
    my $bs = 0;
    my $be = $w2 - 1;
    my $c = $i2 + $w2 - 1;

    while (($as <= $ae) && ($bs <= $be)) {
        if ($ary->[$ae] < $b->[$be]) {
            $ary->[$c--] = $b->[$be--];
        } elsif ($ary->[$ae] > $b->[$be]) {
            $ary->[$c--] = $ary->[$ae--];
        } else {
            $ary->[$c--] = $b->[$be--];
            $ary->[$c--] = $ary->[$ae--];
        }
    }

    while ($bs <= $be) {
        $ary->[$c--] = $b->[$be--];
    }
}

sub msort {
    my ($ary) = @_;

    print "--- Phase 1:\n";

    my $len = scalar @{$ary};
    foreach my $i (1 .. ($len >> 1)) {
        my $bits = ($i - 1) ^ $i;
        print "#$i\n";
        my $w = 1;
        while ($bits != 0) {
            if (($bits & $w) != 0) {
                &merge($ary, $i * 2 - $w - $w, $w, $i * 2 - $w, $w);
                $bits ^= $w;
            }
            $w <<= 1;
        }
    }

    print "--- Phase 2:\n";

    my $bits = $len;
    my $w1 = $bits & (-$bits);
    $bits ^= $w1;
    while ($bits != 0) {
        my $w2 = $bits & (-$bits);
        &merge($ary, $bits - $w2, $w2, $bits, $len - $bits);
        $w1 = $w2;
        $bits ^= $w1;
    }

    print "--- done.\n";
}

sub test {
    my $ary = [1, 3, 5, 2, 6, 4, 0];
    &msort($ary);
    &print_array($ary);
}
&test;

テスト実行結果(等幅フォントでないと崩れる):

$ perl msort.pl
--- Phase 1:
#1
[  1,  3,  5,  2,  6,  4,  0]
   ^   ^
#2
[  1,  3,  5,  2,  6,  4,  0]
           ^   ^
[  1,  3,  2,  5,  6,  4,  0]
   ^____   ^____
#3
[  1,  2,  3,  5,  6,  4,  0]
                   ^   ^
--- Phase 2:
[  1,  2,  3,  5,  4,  6,  0]
                   ^____   ^
[  1,  2,  3,  5,  0,  4,  6]
   ^____________   ^________
--- done.
[  0,  1,  2,  3,  4,  5,  6]

これを見るとなんとなく動作は分かった気がする。でも細かいところで何しているかまだ理解できてないなあ。特に$bits = ($i - 1) ^ $iとか、$w1 = $bits & (-$bits)とかの辺りはさっぱり。
また「あとで考える」。