«     «

シェルソートを書いてみた（おまけ）

シェルソートのソート間隔に素数を使ってみました。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
use strict;
use warnings;
use v5.10;
use Array::Shuffle qw/shuffle_array/;
use Time::HiRes qw/time/;
 
my @data = 1..20000;
shuffle_array( @data );
 
{
    my $cnt = scalar( @data );
    my @prime = calc_prime( $cnt - 1 );
    unshift @prime, 1;
 
    my $st = time();
    my @sorted = shell_sort( \@data, \@prime );
    say 'Prime : ', time() - $st;
}
 
{
    my $cnt = scalar( @data );
    my @gap = ( 1 );
    while ( $gap[-1] < $cnt ) {
        push @gap, ($gap[-1] * 2) + 1;
    }
 
    pop @gap;
 
    my $st = time();
    my @sorted = shell_sort( \@data, \@gap );
    say 'Knuth1: ', time() - $st;
}
 
{
    my $cnt = scalar( @data );
    my @gap = ( 1 );
    while ( $gap[-1] < $cnt ) {
        push @gap, ($gap[-1] * 3) + 1;
    }
 
    pop @gap;
 
    my $st = time();
    my @sorted = shell_sort( \@data, \@gap );
    say 'Knuth2: ', time() - $st;
}
 
sub calc_prime {
    my $n = shift;
 
    my @ret = ();
    if ( $n < 2 ) {
        return @ret;
    }
 
    my @wk = 0..$n;
    $wk[0] = -1;
    $wk[1] = -1;
 
    for (my $i=0; $i<=$n; $i++) {
        next if $wk[$i] < 0;
 
        for (my $j=($i+$i); $j<=$n; $j+=$i) {
            $wk[$j] = -1;
        }
    }
 
    return grep { $_ != -1; } @wk;
}
 
sub shell_sort {
    my ( $data_ref, $gap_ref ) = @_;
    my @data = @{$data_ref};
    my $cnt = scalar( @data );
 
    foreach my $gap ( reverse @{$gap_ref} ) {
        for (my $i=$gap; $i<$cnt; $i++) {
            my $wk = $data[$i];
            my $j = $i;
            for (; $gap<=$j; $j-=$gap) {
                if ( $wk <= $data[$j-$gap] ) {
                    last;
                }
                else {
                    $data[$j] = $data[$j-$gap];
                }
            }
 
            $data[$j] = $wk;
        }
    }
    
    return @data;
}

実行結果はこんな感じ。
$ perl aaa.pl
Prime : 30.5675919055939
Knuth1: 0.555704116821289
Knuth2: 0.495223045349121

どの辺りから気付いてたかというと、
shell_sortの$gap_refをデバッグ出力した辺り。
「あ、これダメだ。」って思いました。

ちなみに、shell_sortの中で$gap_refの要素数だけ出力するとこんな感じ。
$ perl aaa.pl
scalar(@{$gap_ref) = 2263
Prime : 0.00201201438903809
scalar(@{$gap_ref) = 14
Knuth1: 0.00165200233459473
scalar(@{$gap_ref) = 9
Knuth2: 0.00163888931274414

クヌース先生は本当に偉大ですね。

おしまい。

カテゴリー: Perl, コンピューター by ネコ on 2013年09月24日 | タグ: > >

Leave a Comment

  • 2025年5月
    月 火 水 木 金 土 日
     1234
    567891011
    12131415161718
    19202122232425
    262728293031  

    固定ページ

    カテゴリー

    アーカイブ

    検索

    SNS

    メタ情報