無精・短気・傲慢

perlの事 いろいろ

アルゴリズム(algorithm)

再帰(recursion)などでONELINERで書ける物を集めてみる

1~10までを足す

perl -E 'sub f{$_[0]>1?$_[0]+f($_[0]-1):$_[0]} say f(10)'

・1回で計算出来ればその方が良いに決まっている

perl -E 'sub f{($_[0]+$_[1])*($_[1]-$_[0]+1)/2} say f(1,10)'

2つの数字の最大公約数

perl -E 'sub gcd{$_[1]?gcd($_[1],$_[0]%$_[1]):$_[0]} say gcd(1071,1029)'

3の倍数で'foo',5の倍数で'baz'と1から30まで数える

perl -E 'map{say $_%15?$_%5?$_%3?$_:"baz":"foo":"foobaz"}(1..30)'
perl -E 'say +(foo)[$_%3] . (baz)[$_%5]||$_ for 1..30 '

4段のハノイの塔を積む

perl -E 'sub h{return if(!$_[0]);push(@_,$_[0]-1);h(@_[-1,1,3,2,4]);$_[4]->(@_);h(@_[-1,2,1,3,4]);} h(pop,A..C,sub {say "$_[1]($_[0])=>$_[3]";})' 4

5つのソート

クイックソート

perl -E 'sub qsrt{my $op=shift;my $n=int(rand(@_+0));(@_+0)<=1?@_:(qsrt($op,grep{$op->($_,$_[$n])<0} @_),(grep{$op->($_,$_[$n])==0} @_),qsrt($op,grep{$op->($_,$_[$n])>0} @_))} say join ",",qsrt(sub {$_[1]<=>$_[0]},0..10,2..5,undef)'  

マージソート

perl -E 'sub marge{my $f=shift;my @m;while(@{$_[0]}+0 and @{$_[1]}+0){$a=$_[0]->[0];$b=$_[1]->[0];push(@m,$f->()?shift(@{$_[0]}):shift(@{$_[1]}))};@m,@{$_[0]},@{$_[1]};} sub msrt{my $f=shift;@_+0>1?marge($f,[msrt($f,@_[0..int(@_/2)-1])],[msrt($f,@_[int(@_/2)..@_-1])]):@_} say join ",",msrt(sub {$b <= $a},0..10,2..5,undef)'

・挿入ソート

perl -E 'sub ins{$op=shift;return $_[0] if(@{$_[1]}==0); $a=$_[0];$b=shift(@{$_[1]});my $x=$b;$op->()?($_[0],$x,@{$_[1]}):($x,ins($op,$_[0],$_[1]))} sub isrt{my $f=shift;return @_ if(@_+0<=1);my $x=shift;ins($f,$x,[isrt($f,@_)])} say join ",",isrt(sub {$b <= $a},0..10,2..5,undef)'

・・再帰の排除

perl -E 'sub isrt{my $f=shift;my @x = @_;for(my $i=1;$i<=$#x;$i++){my $j=$i;while($j){($a,$b)=@x[$j-1,$j];last if($f->());@x[$j-1,$j]=@x[$j,$j-1];$j--;}}return @x;}say join ",",isrt(sub {$b < $a},0..10,2..5,undef,1..100)'

シェルソート

perl -E 'sub ssrt{my $f=shift;my @x=@_;my $h=1;for(;$h<$#x/9;$h=$h*3+1){}for(;$h>0;$h=int($h/3)){for(my $i=$h;$i<=$#x;$i++){my $j=$i;while($j>=$h){($a,$b)=@x[$j-$h,$j];last if($f->());@x[$j-$h,$j]=@x[$j,$j-$h];$j-=$h;}}}return     @x;}say join ",",ssrt(sub {$b > $a},0..10,2..5,undef,1..10000)'

・やっぱり組み込みのソートは早い

perl -E 'say join ",",sort {$b <=> $a} (0..10,2..5,undef)'

バイナリーサーチ

perl -E 'sub BinarySearch{my $l=$_[3]||0;my $r=$_[4];my $r=@{$_[1]}-1 if($r eq "");my $f=$_[2]||sub{$a<=>$b};my($x,$m);while(){return $x,$m if($l>$r);$m=int(($l+$r)/2);($a,$b)=($_[0],$_[1]->[$m]);$x=$f->();return $x,$m if(!$x);($x<0)?($r=$m-1):($l=$m+1);}}say join ",",BinarySearch(5,[1..10]);'
perl -E 'sub BinarySearch{my $l=$_[3]||0;my $r=$_[4];my $r=@{$_[1]}-1 if($r eq "");my $f=$_[2]||sub{$a<=>$b};my($x,$m);while(){return $x,$m if($l>$r);$m=int(($l+$r)/2);($a,$b)=($_[0],$_[1]->[$m]);$x=$f->();return $x,$m if(!$x);($x<0)?($r=$m-1):($l=$m+1);}}for $i (18..42){say join ",",BinarySearch($i,[reverse(map {$_*5}(4..8))],sub {$b<=>$a});}'

フィボナッチ数列

perl -E 'sub f{$_[0] < 2?$_[0]:f($_[0]-1)+f($_[0]-2)} say join ",", map {f($_)} (0..10)'

・計算量が多いので計算した値を再利用する

perl -E 'my @x;sub f{$x[$_[0]]=$x[$_[0]]?$x[$_[0]]:$_[0] < 2?$_[0]:f($_[0]-1)+f($_[0]-2)} say join ",", map {f($_)} (0..30)'

・こっちの方が正しいか

perl -E 'sub f{$_[0] < 1?$_[2]:f($_[0]-1,$_[1]+$_[2],$_[1])} say join ",", map {f($_,1,0)} (0..30)'

指数が整数のべき乗

perl -E 'sub pow{my ($x,$n)=@_;return $n<0?1/pow($x,$n*-1):$n==0?1:$x if($n<2);my $y=pow($x,int($n/2));$y*=$y;$n%2?$y*$x:$y;} say pow(2,9)'

素因数分解

デモ

$ perl -E 'my @a;sub f{my ($x,$y)=@_[0,1];if ($y > sqrt($x)){return push(@a,$x);}if($x%$y){f($x,$y+1);}else{push(@a,$y);f($x/$y,$y)}} f(pop,2);say join "x",@a' 102
2x3x17
$ 
$ perl -E 'sub f{$x=pop;@a=();for($y=2;$y**$y<=$x;){$x%$y?$y++:{push(@a,$y),$x/=$y}}push(@a,$x);@a}say join "x",f(pop)' 102
2x3x17
$
$ perl -E 'sub f{my $x=shift;my @ans =();my $N=('o' x $x);for(;$N=~/^(oo+?)\1+$/;$N=~s/$1/o/g){push(@ans,length($1));}push(@ans,length($N)); join("x",@ans);} say f(102);'
2x3x17
$ 

75文字とはすごい!!

$ perl -e'print$b,($a/=$b)-1?"*":$/while$b=(grep{not$a%$_}1..($a||=pop))[1]' 60
2*2*3*5

モンテカルロ法で円周率を求めるワンライナー すぎちゃんめもより

$ perl -E 'for (1..pop) {rand()**2+rand()**2 <=1 &&$x++; /^1[0]+$/ && say $_,",",$x*4/$_}' 1000000
10,3.2
100,3.16
1000,3.164
10000,3.154
100000,3.13716
1000000,3.142384
10000000,3.1422264
$ perl -E 'for (1..pop) {rand()**2+rand()**2 <=1 &&$x++; /^1[0]+$/ && say $_,",",$x*4/$_}' 1000000
10,2.8
100,3.24
1000,3.22
10000,3.1776
100000,3.15128
1000000,3.141972
10000000,3.1414164
$

C言語で数値計算(2)モンテカルロ法による円周率算出(近似計算)より

  • 一辺の長さが1の正方形の中にランダムに点を打つ。
  • この正方形の左下の点(0,0)を中心とする半径1の扇形の面積がπ/4である事を考えると、n個のランダムな点のうちm個が扇形の中に入っているとするとm:n≒π/4:1になるはずである。
  • つまりπ=4xm/nと計算できる。
for $i (1 .. pop){rand()     ** 2 + rand()    ** 2  <= 1 && $x++; $i=~/^1[0]+$/ && say "$i,@{[ $x * 4 / $i]}"}' 10000000
                  |----| X座標      |----| Y座標                                                                 -------- 実行回数
                  |-------------------------------------| 三平方の定理で扇形の中を判断        |---------| π = 4 x m / n (πを求める) 

ずんどこきよし

$ perl -lE 'while($x !~ /ずんずんずんずんドコ$/) {say $y= rand()*10%2?"ずん":"ドコ";$x.=$y} say "きよし"'
ずん
ずん
ずん
ドコ
ずん
ずん
ずん
ずん
ずん
ドコ
きよし
$

その他

ワンライナーで書けないので別ページへ