1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

スターリンソート in perl

Posted at

内容

今最高に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でも速度を維持することが出来ます

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

卍おわり卍

テストコード含めた全部

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

追記

image.png

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

1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?