スターリンソート in perl

19954 ワード
Perl ネタ スターリンソート Perl テキストリンク

内容

今最高にhotでrockでlockなO(n)でソートができちまうんだ！と話題のスターリンソートをperlで書きました

スターリンソートとは

https://qiita.com/Tatsuki-I/items/380d6bd06515b872b2b2
（多分）最初に紹介した方のところに全部載ってる

github:
https://github.com/gustavo-depaula/stalin-sort

perlないジャン！PR送れるネ！

実装してみる

5秒（大嘘）で書いたコード

splice_stalin_sort.pl
sub splice_stalin_sort {
    my @arr = @_;
    for (my $i = 1; $i <= $#arr; $i++) {
        if ($arr[$i] < $arr[$i-1]) {
            splice(@arr, $i, 1);
            $i--;
        }
    }
    return @arr;
}

このコードには問題があります！！！！！した
そうです splice です
https://perldoc.perl.org/functions/splice.html

だいたいの言語で共通してると思うのですが（知らん）
連結リストでないリストに対する splice は
1. 該当のelement削除
2. 削除したelementの次の要素をくっつける

という操作が走ります。圧倒的に2番が遅そうですね！そうですspliceはO(n)です
※注: 連結リストの場合の要素削除はO(1)、リンク張り替えるだけ。ただ連結リストは中間要素へのアクセスがO(n)のため、今回は使わない

なので最初に貼ったコードの計算量は恐らく O(n^2) ということが考えられます！なんてこったい

スターリンソートの特性上、ループ内で行う操作は必ずO(1)であることが求められるため、
perlのArrayにおいて実行可能な操作は以下となります。

- 添字アクセス
- delete (※undefになるだけ)
- 最後に追加
- 先頭に追加
- スワップ

ということで脳死修正したコードがこちら

push_stalin_sort.pl
sub push_stalin_sort {
    my @arr = @_;
    my @sorted;
    my $max = 0;
    for (my $i = 0; $i <= $#arr; $i++) {
        if ($arr[$i] >= $max) {
            push(@sorted, $arr[$i]);
            $max = $arr[$i];
        }
    }
    return @sorted;
}

これで1000の配列長をもつデータに対して各々を1000回実行して速度を測ると

>>> perl perl/stalin-sort.pl
splice_stalin_sort : 0.202442
push_stalin_sort : 0.111881

なんと！！！！驚きの2倍速！！！！！！凄ェ！！！！！！！

ただちょっと見た目が美しくないですよね。
我々には力があります。そう、先程も述べたとおりdeleteもO(1)です。
そしてgrepはO(n)であることが知られています。ということは

grep_stalin_sort.pl
sub grep_stalin_sort {
    my @arr = @_;
    my $max = $arr[0];
    for (my $i = 1; $i <= $#arr; $i++) {
        if ($arr[$i] < $max) {
            delete $arr[$i]
        } else {
            $max = $arr[$i];
        }
    }
   return grep defined $_, @arr;
}

こういうコードも書ける！！！！

>>> perl perl/stalin-sort.pl                                                                                                                             +[add_perl]
splice stalin_sort : 0.208253
push stalin_sort : 0.110466
delete stalin_sort : 0.118796

（オーダー記法とは異なりますが）厳密に言うと 2*O(n) となっているため
多少計算時間は増加してるのですが、deleteしてgrepでも速度を維持することが出来ます

そう！！！！これが！！！！！！！
アルゴ！！！！！リッズーーーー↑↑↑ム！！！！！！！！！！です！！！！！！！！！！１

卍おわり卍

テストコード含めた全部

stalin_sort.pl
use strict;
use warnings;

use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);

sub splice_stalin_sort {
    my @arr = @_;
    for (my $i = 1; $i <= $#arr; $i++) {
        if ($arr[$i] < $arr[$i-1]) {
            splice(@arr, $i, 1);
            $i--;
        }
    }
    return @arr;
}

sub push_stalin_sort {
    my @arr = @_;
    my @sorted;
    my $max = 0;
    for (my $i = 0; $i <= $#arr; $i++) {
        if ($arr[$i] >= $max) {
            push(@sorted, $arr[$i]);
            $max = $arr[$i];
        }
    }
    return @sorted;
}

sub grep_stalin_sort {
    my @arr = @_;
    my $max = $arr[0];
    for (my $i = 1; $i <= $#arr; $i++) {
        if ($arr[$i] < $max) {
            delete $arr[$i]
        } else {
            $max = $arr[$i];
        }
    }
    return grep defined $_, @arr;
}

my @arr1;
my $size  = 1000;
for (my $i = 0; $i < $size; $i++)
{
    my $n = int(rand $size);
    push @arr1, $n;
}

my $times = 1000;
{
    print "splice_stalin_sort : ";
    my $t0 = [gettimeofday];
    for (my $count = 0; $count < $times; $count++)
    {
        splice_stalin_sort(@arr1);
    }
    my $t1 = [gettimeofday];
    my $process_time = tv_interval($t0, $t1);
    print "$process_time\n";
}

{
    print "push_stalin_sort : ";
    my $t0 = [gettimeofday];
    for (my $count = 0; $count < $times; $count++)
    {
        push_stalin_sort(@arr1);
    }
    my $t1 = [gettimeofday];
    my $process_time = tv_interval($t0, $t1);
    print "$process_time\n";

}

{
    print "delete_stalin_sort : ";
    my $t0 = [gettimeofday];
    for (my $count = 0; $count < $times; $count++)
    {
        grep_stalin_sort(@arr1);
    }
    my $t1 = [gettimeofday];
    my $process_time = tv_interval($t0, $t1);
    print "$process_time\n";
}

1;

参考

https://www.perlmonks.org/?node_id=17890
https://notta55.hatenablog.com/entry/2014/09/13/171128
https://gihyo.jp/dev/serial/01/perl-hackers-hub/005503

追記

perlプロのみなさんあとはおねがいします