帰ってきたネコブログ

最後は、「その安定/不安定判定がうまくいってるのは、たまたまじゃね？」
って思ってる勘の良い人のために。

use strict;
use warnings;
use v5.10;

my $shell_sort = sub {
    my @data = @_;

    my $cnt = scalar( @data );
    my $gap = 1;

    while ( $gap < $cnt ) {
        $gap = ($gap * 3) + 1;
    }

    while ( ($gap = ($gap - 1) / 3) ) {
        for (my $i=$gap; $i<$cnt; $i++) {
            my $wk = $data[$i];
            my $j = $i;
            for (; $gap<$j; $j-=$gap) {
                if ( $wk->[0] < $data[$j-$gap]->[0] ) {
                    $data[$j] = $data[$j-$gap];
                }
                else {
                    last;
                }
            }

            $data[$j] = $wk;
        }
    }

    return @data;
};

foreach my $n ( 8, 12, 16, 20 ) {
    say "--- n = $n ---";

    my @v = 1..$n;
    my @data = stable_shuffle( to_weighted(\@v, 4) );
    say join( ',', (map { $_->[0]; } @data) );

    @data = $shell_sort->( @data );
    say join( ',', (map { $_->[0]; } @data) );

    my @sorted = map { $_->[1]; } @data;
    my $ret = join(',', @v) eq join(',', @sorted);

    say 'shell_sort is ', ( $ret ? 'stable!' : 'not stable!' );
}

sub stable_shuffle {
    my @tmp = @_;

    my @src = ();
    while ( @tmp ) {
        my @wk = ( shift @tmp );
        if ( @tmp ) {
            while ( $wk[0]->[0] == $tmp[0]->[0] ) {
                push @wk, ( shift @tmp );
                last unless @tmp;
            }
        }
  
        push @src, \@wk;
    }

    my @dst = ();
    while ( @src ) {
        foreach ( @src ) {
            push @dst, shift @{$_};
        }
 
        @src = grep { @{$_}; } @src;
    }

    return @dst;
}

sub to_weighted {
    my ( $v_ref, $interval ) = @_;
    my $i = 0;
    my $w = 1;

    my @data = ();
    foreach ( @{$v_ref} ) {
        push @data, [ $w, $_ ];
        $i++;
        if ( $interval <= $i ) {
            $w++;
            $i = 0;
        }
    }

    return @data;
}

実行結果はこんな感じ。
$ perl aaa.pl
--- n = 8 ---
1,2,1,2,1,2,1,2
1,1,1,1,2,2,2,2
shell_sort is stable!
--- n = 12 ---
1,2,3,1,2,3,1,2,3,1,2,3
1,1,1,1,2,2,2,2,3,3,3,3
shell_sort is not stable!
--- n = 16 ---
1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4
1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4
shell_sort is stable!
--- n = 20 ---
1,2,3,4,5,1,2,3,4,5,1,2,3,4,5,1,2,3,4,5
1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5
shell_sort is not stable!

n=8で間隔が4の場合、4の段階で交換が行われず、
次のフェーズで挿入ソートになってしまう。
同様に、n=16の場合も間隔が13と4の段階で交換が行われず、
ただの挿入ソートになってしまう。

安定か不安定か判断するのに、
前回のように中途半端な数でグルーピングすればいんだけど、
今回みたいな特定の組み合わせだと判断できなくて、
ソートのアルゴリズムに関わらず、正確に判定するのって難しいですね。

おしまい。

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