帰ってきたネコブログ

シェルソートがあまりにも速いので、
まずは、何がどうなって、どうして速いのか検証してみる。

use strict;
use warnings;
use v5.10;

my @data = 1..9;

say join( ', ', @data );
say '-=' x 22;
my @sorted = shell_sort( @data );
say '-=' x 22;
say join( ', ', @sorted );

sub shell_sort {
    my @data = @_;

    my $cnt = scalar( @data );
    my $gap = $cnt;
    while ( ($gap = int($gap / 2)) ) {
        printf( "--- \$gap =%2d ---\n", $gap );
        say join( ', ', @data );

        for (my $i=$gap; $i<$cnt; $i++) {
            printf( "\$i =%2d\n", $i );
            dump_array( \@data, $i, $gap );

            my $wk = $data[$i];
            my $j = $i;
            for (; $gap<=$j; $j-=$gap) {
                if ( $wk <= $data[$j-$gap] ) {
                    last;
                }
                else {
                    $data[$j] = $data[$j-$gap];
                    dump_array( \@data, $i, $gap, ($j - $gap) );
                }
            }

            $data[$j] = $wk;
            dump_array( \@data, $i, $gap );
        }

        say join( ', ', @data );
    }
  
    return @data;
}

sub dump_array {
    my ( $ary_ref, $base, $gap ) = @_;
    my $invalid_index = $_[3] // -1;

    my @wk;
    my $cnt = scalar( @{$ary_ref} );
    for (my $i=0; $i<$cnt; $i++) {
        my $val = ( $invalid_index == $i ) ? 'x' : $ary_ref->[$i];
        if ( (($i - $base) % $gap) == 0 ) {
            push @wk, qq/[$val]/;
        }
        else {
            push @wk, qq/ $val /;
        }
    }

    say join( ', ', @wk );
}

実行結果はこんな感じ。
$ perl aaa.pl
1, 2, 3, 4, 5, 6, 7, 8, 9
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
--- $gap = 4 ---
1, 2, 3, 4, 5, 6, 7, 8, 9
$i = 4
[1], 2 , 3 , 4 , [5], 6 , 7 , 8 , [9]
[x], 2 , 3 , 4 , [1], 6 , 7 , 8 , [9]
[5], 2 , 3 , 4 , [1], 6 , 7 , 8 , [9]
$i = 5
5 , [2], 3 , 4 , 1 , [6], 7 , 8 , 9
5 , [x], 3 , 4 , 1 , [2], 7 , 8 , 9
5 , [6], 3 , 4 , 1 , [2], 7 , 8 , 9
$i = 6
5 , 6 , [3], 4 , 1 , 2 , [7], 8 , 9
5 , 6 , [x], 4 , 1 , 2 , [3], 8 , 9
5 , 6 , [7], 4 , 1 , 2 , [3], 8 , 9
$i = 7
5 , 6 , 7 , [4], 1 , 2 , 3 , [8], 9
5 , 6 , 7 , [x], 1 , 2 , 3 , [4], 9
5 , 6 , 7 , [8], 1 , 2 , 3 , [4], 9
$i = 8
[5], 6 , 7 , 8 , [1], 2 , 3 , 4 , [9]
[5], 6 , 7 , 8 , [x], 2 , 3 , 4 , [1]
[x], 6 , 7 , 8 , [5], 2 , 3 , 4 , [1]
[9], 6 , 7 , 8 , [5], 2 , 3 , 4 , [1]
9, 6, 7, 8, 5, 2, 3, 4, 1
--- $gap = 2 ---
9, 6, 7, 8, 5, 2, 3, 4, 1
$i = 2
[9], 6 , [7], 8 , [5], 2 , [3], 4 , [1]
[9], 6 , [7], 8 , [5], 2 , [3], 4 , [1]
$i = 3
9 , [6], 7 , [8], 5 , [2], 3 , [4], 1
9 , [x], 7 , [6], 5 , [2], 3 , [4], 1
9 , [8], 7 , [6], 5 , [2], 3 , [4], 1
$i = 4
[9], 8 , [7], 6 , [5], 2 , [3], 4 , [1]
[9], 8 , [7], 6 , [5], 2 , [3], 4 , [1]
$i = 5
9 , [8], 7 , [6], 5 , [2], 3 , [4], 1
9 , [8], 7 , [6], 5 , [2], 3 , [4], 1
$i = 6
[9], 8 , [7], 6 , [5], 2 , [3], 4 , [1]
[9], 8 , [7], 6 , [5], 2 , [3], 4 , [1]
$i = 7
9 , [8], 7 , [6], 5 , [2], 3 , [4], 1
9 , [8], 7 , [6], 5 , [x], 3 , [2], 1
9 , [8], 7 , [6], 5 , [4], 3 , [2], 1
$i = 8
[9], 8 , [7], 6 , [5], 4 , [3], 2 , [1]
[9], 8 , [7], 6 , [5], 4 , [3], 2 , [1]
9, 8, 7, 6, 5, 4, 3, 2, 1
--- $gap = 1 ---
9, 8, 7, 6, 5, 4, 3, 2, 1
$i = 1
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 2
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 3
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 4
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 5
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 6
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 7
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
$i = 8
[9], [8], [7], [6], [5], [4], [3], [2], [1]
[9], [8], [7], [6], [5], [4], [3], [2], [1]
9, 8, 7, 6, 5, 4, 3, 2, 1
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
9, 8, 7, 6, 5, 4, 3, 2, 1

このデータ列は、挿入ソートでは最悪の結果をもたらす。
しかし、$gapが1になる直前を見て欲しい。
すでに、ソートが終わっている！？
それどころか、$gapが2になる前に、
5より大きいものと、5より小さいものが入れ替わっている！！

自分が理解できる範囲でまとめると、
通常の挿入ソートを行う前に、挿入ソートで時間の掛かるケース、
つまり挿入先が遠くにある状態をあらかじめ回避している。
これなら、”ほとんど”ソートされた状態から挿入ソートが行われるので、
ソートが速くなるのも理解できる。

しかも、まだ改善の余地があるそうなので、
次回は、その辺を詰めてみようと思う。

続く。

カテゴリー: Perl, コンピューター by ネコ on 2013年09月12日 | タグ: アルゴリズム > ソート > メモ