内容
今最高にhotでrockでlockなO(n)でソートができちまうんだ！と話題のスターリンソートをperlで書きました
スターリンソートとは
https://qiita.com/Tatsuki-I/items/380d6bd06515b872b2b2
（多分）最初に紹介した方のところに全部載ってる
github:
https://github.com/gustavo-depaula/stalin-sort
perlないジャン！PR送れるネ！
実装してみる
5秒（大嘘）で書いたコード
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になるだけ)
- 最後に追加
- 先頭に追加
- スワップ
ということで脳死修正したコードがこちら
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)であることが知られています。ということは
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でも速度を維持することが出来ます
そう！！！！これが！！！！！！！
アルゴ！！！！！リッズーーーー↑↑↑ム！！！！！！！！！！です！！！！！！！！！！１
卍おわり卍
テストコード含めた全部
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プロのみなさんあとはおねがいします