再帰でプログラミングするとシンプル（綺麗に、格好良く）に書ける。再帰脳を鍛えよう！ !最初の一歩　等差数列の和（1から１０までの合計を求める。） perl -E 'sub f{$_[0]>1?$_[0]+f($_[0]-1):$_[0]} say f(10)' ワンライナーをばらすと… sub f{ $_[0] > 1 ? $_[0]+f($_[0]-1) # f(n) = n + f(n-1) : $_[0]; # f(1) = 1 } say f(10) 考え方 f(0) = 0 f(1) = 1 f(2) = 2 + f(1) f(3) = 3 + f(2) . . f(n) = n + f(n-1) しかし、再帰は計算量が増える傾向にある。1回で計算出きるなら1回の方が良いに決まっている。（多分） perl -E 'sub f{($_[0]+$_[1])*($_[1]-$_[0]+1)/2} say f(1,10)' ワンライナーをばらすと… sub f{ ($_[0]+$_[1])*($_[1]-$_[0]+1)/2; #（最初の数＋最後の数）×（全体の個数）÷２ } say f(1,10) 考え方 （最初の数＋最後の数）×（全体の個数）÷２ (1 + 10) × 10 ÷ 2 10□□□□□□□□□□ 9□□□□□□□□□■ 1 8□□□□□□□□■■ 2 7□□□□□□□■■■ 3 6□□□□□□■■■■ 4 5□□□□□■■■■■ 5 4□□□□■■■■■■ 6 3□□□■■■■■■■ 7 2□□■■■■■■■■ 8 1□■■■■■■■■■ 9 ■■■■■■■■■■10 1 2 3 4 5 6 7 8 910 !最大公約数を求める 整数xとyの最大公約数求める時は2つの数を除算し余りが０になるまで繰り返すと最大公約数が求められる。これを ユークリッドの互除法（ユークリッドのごじょほう、英: Euclidean Algorithm）と言うらしい。 perl -E 'sub gcd{$_[1]?gcd($_[1],$_[0]%$_[1]):$_[0]} say gcd(1071,1029)' ワンライナーをばらすと… sub gcd{ $_[1] ? gcd($_[1],$_[0]%$_[1]) # 引数２、引数２と引数１の余りで再計算する : $_[0]; # 引数２が０（余り無し）の場合は引数１が解である } say gcd(1071,1029) *最小公倍数 $ perl -E 'sub gcd{$_[1]?gcd($_[1],$_[0]%$_[1]):$_[0]} $x=shift;$y=shift;say $x*$y/gcd($x,$y)' 100 75 300 $ !ハノイの塔を積む 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 ワンライナーをばらすと… 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]";}) # N個の円盤をA塔からC塔へ移動する !!ソート処理 !クイックソート 適当な値（ピボットという）を選択し （この場合はデータの総数の中央値が望ましい）ピボット値より小さい値の組と大きい値の組に分けてそれぞれに同じ処理を繰り返しソートを行う。 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)' ワンライナーをばらすと… 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)' ワンライナーをばらすと… sub marge{ my $f = shift; my @m; # マージする配列よ用意する while(@{$_[0]}+0 and @{$_[1]}+0){ # 片方の配列がなくなるまでマージを繰り返す $a=$_[0]->[0]; # 配列１の1つ目の要素をセーブ（大小判断用） $b=$_[1]->[0]; # 配列２の1つ目の要素をセーブ（大小判断用） 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])]) # 配列を分割しマージする : @_ # 配列の要素が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)' ワンライナーをばらすと… 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)' ワンライナーをばらすと… 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)' sub ssrt{ my $f=shift; my @x = @_; my $h = 1; for(;$h<$#x/9;$h=$h*3+1){} # 間隔hを求める。 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; } print join ",",ssrt(sub {$b > $a},0..10,2..5,undef,1..10000) !perlの組み込みソート 当然ながら組み込みのソートとは勝負にならない 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]);' sub BinarySearch{ # BinarySearch($x,\@xs,sub{比較内容},右端,左端 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); # Not Found $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); # もっと後 } } print 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});}' !フィボナッチ数列 最初の二項は0,1と定義され、以後どの項もその前の2つの項の和となっている。 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, … perl -E 'sub f{$_[0] < 2?$_[0]:f($_[0]-1)+f($_[0]-2)} say join ",", map {f($_)} (0..10)' ワンライナーをばらすと… sub f{ $_[0] < 2 ? $_[0] # 0,1の場合はそのまま返す : f($_[0]-1)+f($_[0]-2) # f(n) = f(n-1) + f(n-2) を返す } say join ",", map {f($_)} (0..10)' 考え方（定義） f(0) = 0 f(1) = 1 f(2) = f(1) + f(0) f(3) = f(2) + f(1) ・ ・ f(n) = f(n-1) + f(n-2) *計算量が多いので1度計算した値を再利用する 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)' my @x; # 計算した値をキャッシュする配列 sub f{ $x[$_[0]] = $x[$_[0]] ? $x[$_[0]] # 計算済みの場合はその値を返す : $_[0] < 2 ? $_[0] # 0,1はそのまま返す : f($_[0]-1)+f($_[0]-2) # f(n-1) + f(n-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で演算子'**'で良いのだが… 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)' ワンライナーをばらすと… sub pow{ my ($x,$n)=@_; # 整数xと指数n return $n < 0 ? 1/pow($x,$n*-1) : # 指数がマイナスの場合 $n == 0 ? 1 # 指数が0の場合 : $x if($n<2); # 指数が1の場合 my $y=pow($x,int($n/2)); $y*=$y; # (x**h)**2 $n%2?$y*$x:$y; # 指数が奇数の場合はxを掛ける } say pow(2,9); 考え方 xの100乗の計算 x ** 100 = (x ** 50) ** 2 x ** 50 = (x ** 25) ** 2 x ** 25 =((x ** 12) ** 2 )* x x ** 12 = (x ** 6) ** 2 x ** 6 = (x ** 3) ** 2 x ** 3 =((x ** 1) ** 2 )* x x ** 1 = x !コメントをどうぞ *yapcasia でラリーのデモ（ちょっと違うけど）perl6 -e 'my @Fib := 0, 1, * + * ... *;say @Fib[0..30]' 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 - John (2015年08月25日 00時04分59秒) {{comment}}