Sierpinski triangleワンライナー その３

Perl OneLiner

Sierpinski triangleワンライナー その２ - すぎゃーんメモの続き。

Combination(n, m)が奇数になるための必要十分条件について

組合せ (数学) - Wikipediaより

n=2^{p\(1\)}+2^{p\(2\)}+\dots
m=2^{q\(1\)}+2^{q\(2\)}+\dots
というように、nとmを二進展開したとき、
\{p\(1\), p\(2\), \dots\} \supset \{q\(1\), q\(2\), \dots\} であることが{}_n\mathrm{C}_mが奇数であることの必要十分条件になっている。

ここにはこれしか書いてなくて、詳細を調べたところようやく見つけ出したのがここ。
nCmが奇数であることの必要十分条件は、２進記数表記で… - 数学 解決済 | 教えて！goo
これをもとに自分で解釈すると。

\begin{align}n&=2^{p\(1\)}+2^{p\(2\)}+\dots+2^{p\(i\)}\\m&=2^{q\(1\)}+2^{q\(2\)}+\dots+2^{q\(j\)}\end{align}
(p\(1\)>p\(2\)>\dots>p\(i\)\ge0,\quad q\(1\)>q\(2\)>\dots>q\(j\)\ge0)
とおくと、n!を素因数分解したときに
n!=2^P\times\dots
で表される2の指数Pは、
\begin{align}P&=\(2^{p\(1\)}-1\)+\(2^{p\(2\)}-1\)+\dots+\(2^{p\(i\)}-1\)\\&=2^{p\(1\)}+2^{p\(2\)}+\dots+2^{p\(i\)}-1\times i\\&=n-i\end{align}
と計算される(ちょっとここの１行目がうまく説明できない)。
同様にm!の素因数分解に含まれる2の指数はm-jで表される。
ここで
n-m=2^{r\(1\)}+2^{r\(2\)}+\dots+2^{r\(k\)}
とおくと、(n-m)!の素因数分解に含まれる2の指数はn-m-kとなる。


ここで、
{}_n\mathrm{C}_m=\frac{n!}{\(n-m\)!\times m!}
の素因数分解に含まれる2の指数を考える。
上記より、
分子の素因数分解に含まれる2の指数はn-iであり、
分母の素因数分解に含まれる2の指数は(m-j)+(n-m-k)となるので、
{}_n\mathrm{C}_mの素因数分解に含まれる2の指数は\(n-i\)-\{\(m-j\)+\(n-m-k\)\}=j+k-iと計算される。
この値が0であれば{}_n\mathrm{C}_mの素因数に2が含まれないことになり、すなわち{}_n\mathrm{C}_mが奇数である、ということになる。
逆にj+k-i>0となると{}_n\mathrm{C}_mの素因数に2が含まれることになり、{}_n\mathrm{C}_mは偶数になる。


ここからビット演算の考え方を使わずに条件の証明ができればいいんだけど。。。

奇数になる条件を利用して作るシェルピンスキーのギャスケット

上記の必要十分条件を利用すれば、簡単にシェルピンスキーのギャスケット(Sierpinski gasket)を描くことができる。

n=2^{p\(1\)}+2^{p\(2\)}+\dots
m=2^{q\(1\)}+2^{q\(2\)}+\dots
というように、nとmを二進展開したとき、
\{p\(1\), p\(2\), \dots\} \supset \{q\(1\), q\(2\), \dots\} であることが{}_n\mathrm{C}_mが奇数であることの必要十分条件になっている。

ということは、nとmを二進数で表したときにmで使われているビットがすべてnに含まれていれば良い。
プログラム的には論理和を利用するのがおそらく最も簡単。
\{p\(1\), p\(2\), \dots\} \supset \{q\(1\), q\(2\), \dots\}とならない場合、nとmの論理和はnよりも大きな値になってしまう。
\{p\(1\), p\(2\), \dots\} \supset \{q\(1\), q\(2\), \dots\}の場合のみ、nとmの論理和はnと一致する。

sub is_combination_odd {
    my ($n, $m) = @_;
    if (($n | $m) == $n) {
        return 1;
    } else {
        return 0;
    }
}

このように、実際にnやmの階乗を計算することなく{}_n\mathrm{C}_mの奇数判定ができる。
これを利用して、シェルピンスキーのギャスケットを描くプログラムを作成する。
シェルピンスキーのギャスケット - Wikipedia
パスカルの三角形 - Wikipedia
シェルピンスキーのギャスケットは、パスカルの三角形に現れる奇数のみを塗りつぶすと出現する。
そのパスカルの三角形の性質として、{}_n\mathrm{C}_mの値は、(n+1)段目の端から(m+1)番目の数に等しい。
従って、(n+1)段目の端から(m+1)番目の数が奇数かどうかは{}_n\mathrm{C}_mの値が奇数になるかどうかを調べるだけで判定できる。
これを利用してプログラムを書くと、以下のようになる。

#!/usr/bin/perl
# sierpinski.pl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for (my $n = 0; $n < $size; $n++) {
    print " " x ($size - $n - 1);
    for (my $m = 0; $m <= $n; $m++) {
        if (&is_combination_odd($n, $m)) {
            print '/\\';
        } else {
            print '  ';
        }
    }
    print "\n";
}

sub is_combination_odd {
    my ($n, $m) = @_;
    if (($n | $m) == $n) {
        return 1;
    } else {
        return 0;
    }
}

$ perl sierpinski.pl 5
                               /\
                              /\/\
                             /\  /\
                            /\/\/\/\
                           /\      /\
                          /\/\    /\/\
                         /\  /\  /\  /\
                        /\/\/\/\/\/\/\/\
                       /\              /\
                      /\/\            /\/\
                     /\  /\          /\  /\
                    /\/\/\/\        /\/\/\/\
                   /\      /\      /\      /\
                  /\/\    /\/\    /\/\    /\/\
                 /\  /\  /\  /\  /\  /\  /\  /\
                /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
               /\                              /\
              /\/\                            /\/\
             /\  /\                          /\  /\
            /\/\/\/\                        /\/\/\/\
           /\      /\                      /\      /\
          /\/\    /\/\                    /\/\    /\/\
         /\  /\  /\  /\                  /\  /\  /\  /\
        /\/\/\/\/\/\/\/\                /\/\/\/\/\/\/\/\
       /\              /\              /\              /\
      /\/\            /\/\            /\/\            /\/\
     /\  /\          /\  /\          /\  /\          /\  /\
    /\/\/\/\        /\/\/\/\        /\/\/\/\        /\/\/\/\
   /\      /\      /\      /\      /\      /\      /\      /\
  /\/\    /\/\    /\/\    /\/\    /\/\    /\/\    /\/\    /\/\
 /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\  /\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\

シェルピンスキーのギャスケットをワンライナーで作る

このプログラムを利用して、Perlワンライナーでシェルピンスキーのギャスケットを描く。
まず、サブルーチン使う部分を内部に埋め込んで簡潔に表現しよう。

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for (my $n = 0; $n < $size; $n++) {
    print " " x ($size - $n - 1);
    for (my $m = 0; $m <= $n; $m++) {
        if (($n |$m) == $n) {
            print '/\\';
        } else {
            print '  ';
        }
    }
    print "\n";
}

↓ if...else...は三項演算子に。

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for (my $n = 0; $n < $size; $n++) {
    print " " x ($size - $n - 1);
    for (my $m = 0; $m <= $n; $m++) {
        print (($n | $m) == $n ? '/\\' : '  ');
    }
    print "\n";
}

for文が２つ使われていると後置構文のワンライナー化ができないので、素因数分解ワンライナーの作り方 その２ - すぎゃーんメモで書いたように、map関数を使った配列の操作で内側のfor文を消してみよう。

    for (my $m = 0; $m <= $n; $m++) {
        print (($n | $m) == $n ? '/\\' : '  ');
    }

この部分を

    print map {
        (($n | $_) == $n ? '/\\' : '  ');
    } 0..$n;

と書き換えることが出来る。
そうなればfor文は1つだけになり、中身はすべてprint文になる。こんなものは繋げてしまえばいい。

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for (my $n = 0; $n < $size; $n++) {
    print " " x ($size - $n - 1);
    print map {
        ($n | $_) == $n ? '/\\' : '  '
    } 0..$n;
    print "\n";
}

↓ print文をまとめる

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for (my $n = 0; $n < $size; $n++) {
    print " " x ($size - $n - 1), (map { ($n | $_) == $n ? '/\\' : '  ' } 0..$n), "\n";
}

↓ for文の形式を書き換える

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

for my $n (0..$size - 1) {
    print " " x ($size - $n - 1), (map { ($n | $_) == $n ? '/\\' : '  ' } 0..$n), "\n";
}

↓ 後置for文に

#!/usr/bin/perl
use strict;
use warnings;

my $size = 2 ** ($ARGV[0] ||= 1);

print " " x ($size - (our $n = $_) - 1), (map { ($n | $_) == $n ? '/\\' : '  ' } 0..$n), "\n" for (0..$size - 1);

あとは変数$sizeも内部に埋め込んでしまえば１行になる！

#!/usr/bin/perl
use strict;
use warnings;

print " " x (our $s - (our $n = $_) - 1), (map { ($n | $_) == $n ? '/\\' : '  ' } 0..$n), "\n" for (0..($s = 2**$ARGV[0]) - 1);

ということで、Perlワンライナーで表現すると

$ perl -e 'print " " x (our $s - (our $n = $_) - 1), (map { ($n | $_) == $n ? "/\\" : "  " } 0..$n), "\n" for (0..($s = 2**$ARGV[0]) - 1)' 5

というカンジになる。
ここからガンガン削ってみよう。
まずはourを取ってしまう。

$ perl -e 'print " " x ($s - ($n = $_) - 1), (map { ($n | $_) == $n ? "/\\" : "  " } 0..$n), "\n" for (0..($s = 2**$ARGV[0]) - 1)' 5

↓ $ARGV[0]はpopで取り出す

$ perl -e 'print " " x ($s - ($n = $_) - 1), (map { ($n | $_) == $n ? "/\\" : "  " } 0..$n), "\n" for (0..($s = 2**pop) - 1)' 5

↓ 出力の改行はperlのコマンドラインスイッチ"-l"に任せる

$ perl -le 'print " " x ($s - ($n = $_) - 1), (map { ($n | $_) == $n ? "/\\" : "  " } 0..$n) for (0..($s = 2**pop) - 1)' 5

↓ 無くても問題ない括弧は取り除く

$ perl -le 'print " " x ($s - ($n = $_) - 1), map { ($n | $_) == $n ? "/\\" : "  " } 0..$n for 0..($s = 2**pop) - 1' 5

↓ 無くても問題ないスペースは取り除く

$ perl -le'print" "x($s-($n=$_)-1),map{($n|$_)==$n?"/\\":"  "}0..$n for 0..($s=2**pop)-1' 5

↓ スペースを$"で置換してみる

$ perl -le'print$"x($s-($n=$_)-1),map{($n|$_)==$n?"/\\":$"x2}0..$n for 0..($s=2**pop)-1' 5

↓ インデックスを操作して"-1"を一箇所に

$ perl -le'print$"x($s-($n=$_-1)),map{($n|$_)==$n?"/\\":$"x2}0..$n for 1..($s=2**pop)' 5

↓ "$n"の変数名を変えることで空白なしで"for"と繋げられるようになる

$ perl -le'print$"x($s-($==$_-1)),map{($=|$_)==$=?"/\\":$"x2}0..$=for 1..($s=2**pop)' 5

これくらいが限界か…
あとは、奇数判定の部分を論理和じゃなくて論理積で行うように変更する、という方法。
\{p\(1\), p\(2\), \dots\} \supset \{q\(1\), q\(2\), \dots\}となるか否かは、
n\ge mという条件においてnをビット反転したものとmの論理積が0になるか否かで判定できる。
これを使うと、さらに短く

$ perl -le'print$"x($s-($==$_-1)),map{~$=&$_?$"x2:"/\\"}0..$=for 1..($s=2**pop)' 5

↓ mapの第1引数に括弧が要らなくなる

$ perl -le'print$"x($s-($==$_-1)),map~$=&$_?$"x2:"/\\",0..$=for 1..($s=2**pop)' 5

となる。
なんとなくセミコロンで区切らず1文で表現したくて頑張ってみたようとしたけど、残念ながらこれが限界のような気がする。
元祖「Sierpinski triangleワンライナー」は代入部分とprint部分が分かれていて、while文を使うことで

$ perl -le '$x=2**pop;print$"x--$x,map$x&$_?$"x2:"/\\",0..$y++while$x' 5

と、もっともっと短く表現している。すごい。
いちおう考え方はだいたい同じだと思うんだけど。