帰ってきたネコブログ

Perlのソートと挿入ソートとシェルソートの性質を確認してみた。

use strict;
use warnings;
use v5.10;

my $perl_sort = sub {
    return sort { $a->[0] <=> $b->[0] } @_;
};

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

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

        $data[$j] = $wk;
    }

    return @data;
};

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;
};

my %h = (
    perl   => $perl_sort,
    insert => $insert_sort,
    shell  => $shell_sort
);

foreach my $k ( keys %h ) {
    say "${k}_sort is " . ( is_stable($h{$k}) ? 'stable!' : 'not stable!' );
}

sub is_stable {
    my $func = shift;

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

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

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

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
1,2,3,4,5,6,1,2,3,4,5,1,2,3,4,5
1,4,7,10,13,16,2,5,8,11,14,3,6,9,12,15
1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16
perl_sort is stable!
1,2,3,4,5,6,1,2,3,4,5,1,2,3,4,5
1,4,7,10,13,16,2,5,8,11,14,3,6,9,12,15
1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16
insert_sort is stable!
1,2,3,4,5,6,1,2,3,4,5,1,2,3,4,5
1,4,7,10,13,16,2,5,8,11,14,3,6,9,12,15
1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6
1,2,3,4,6,5,9,7,8,11,12,10,13,14,15,16
shell_sort is not stable!

この結果を見ると、シェルソートだけが不安定なのが分かる。
昨日作った「安定なシャッフル」は、stable_shuffleって関数名にして、
順番にマージするだけにした。
っていうのも、ランダムに処理すると何も変わらない場合も考えられるので、
今回の実装の方が安全な気がする。

あと気付いたのは、
今まで安定だと思ってた挿入ソートが不安定に判定されて、
見直してみたら交換する条件にバグが見つかって、
過去に書いた挿入ソートの記事から見直す必要がある。。。(*1)

続く。

(*1) 過去を記事を、すべて修正しました。

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