7種類の記号だけでPerlプログラムを書く

こんにちは、@sugyanです。前回に引き続きPerlネタで投稿します。

■前回のおさらい

前回は、"Hello world!"を出力するPerl記号プログラムとして以下のものを作成しました。

'' =~ ('(?{'.(
('['^'.').('['^'(').('`'|'%').' '.('['^'(').('['^'/').('['^')').('`'|')').('`'|'#').('['^'/').';'.
('['^'.').('['^'(').('`'|'%').' '.('['^',').('`'|'!').('['^')').('`'|'.').('`'|')').('`'|'.').('`'|"'").('['^'(').';'.
('['^'+').('['^')').('`'|')').('`'|'.').('['^'/').
(' +"'.('`'^'(').('`'|'%').('`'|',').('`'|',').('`'|'/').' '.('['^',').('`'|'/').('['^')').('`'|',').('`'|'$').'!"'))
.'})');

確かに記号だけで書かれていて嬉しいのですが、22種類もの記号が使われています。今回は、これをもっと少ない種類の記号だけで表現することを考えてみます。

■記号だけのPerlプログラムを作る条件

前回述べた通り、記号だけでPerlプログラムを作るためには

''=~/(?{ print "hoge" })/

という拡張正規表現を利用します。これは、

''=~'(?{ print "hoge" })'

と書くこともできるので、最終的には

''=~'文字列'

という形式で任意の文字列を記号だけで表現できれば良い、ということになります。
この時点で"'"もしくは'"'(シングルクォートもしくはダブルクォート)、"="(イコール)、"~"(チルダ)、の3種類が必須になります。Binding Operatorとして"=~"ではなく"!~"を用いることもできますが、ここでは"=~"を使います。
また、文字列の連結に"."(ドット)、それらを括るために"("、")"(カッコx2)が必要になります。ここまでで6種類。そして文字列同士の論理演算を行うために"&", "|", "^"のいずれかを用います。
全部で7種類、これら「必須」のものだけを用いて記号プログラムを作成できるでしょうか？

■変換表を作ってみる

最も多いパターンを作りやすい排他的論理和演算子"^"を使って、クォート以外の6種類の文字同士を組み合わせて作れる文字を調べてみます。

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

my $dict = do {
    my $dict = +{};
    my @chars = (qw/= ~ ( ) . ^/);

    for my $c1 (@chars) {
        $dict->{$c1}++;
        for my $c2 (@chars) {
            $dict->{$c1 ^ $c2}++;
            for my $c3 (@chars) {
                $dict->{$c1 ^ $c2 ^ $c3}++;
                for my $c4 (@chars) {
                    $dict->{$c1 ^ $c2 ^ $c3 ^ $c4}++;
                    for my $c5 (@chars) {
                        $dict->{$c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5}++;
                        for my $c6 (@chars) {
                            $dict->{$c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5 ^ $c6}++;
                        }
                    }
                }
            }
        }
    }

    $dict;
};

print join(' ', map ord, sort keys %$dict), "\n";
print scalar keys %$dict, "\n";

0 1 6 7 8 9 14 15 18 19 20 21 26 27 28 29 32 33 38 39 40 41 46 47 50 51 52 53 58 59 60 61 66 67 68 69 74 75 76 77 80 81 86 87 88 89 94 95 98 99 100 101 106 107 108 109 112 113 118 119 120 121 126 127
64

6重ループまで回してみましたが、残念ながら"\x00"~"\x7F"の128種類のうち64種類までしかできませんでした。7重に増やしても効果がありません。
このままでは"?"の文字を表現することすら出来ません。悔しいですね…！

■文字列"1"を作る

「せめてもう一文字、使えるものがあれば！」ということで、使える文字を一文字増やすことにします。
我々には"="記号を使う権利があります。"=="という比較演算子として使えば、真偽値 0 もしくは 1 を得ることができますね。この 0 もしくは 1 を文字列として使うことができればハッピーになれるのではないでしょうか。

print ''==''

これで"1"という出力が得られます。ただ、それを文字列として使うつもりで

print '~'^(''=='')

とやっても、残念ながら"1"が出力されるだけです。どうやら「数値の1」として排他的論理和が計算されてしまっているようです。ので、

print '~'^(''.(''==''))

と書くことにします。こうすることで、空文字列に"1"を連結した、「文字列の"1"」と文字列"~"の排他的論理和として"O"が出力されます。

■改めて変換表を作ってみる

以上をふまえて、文字列"1"も使える前提で改めて変換表を作ってみます。

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

my $dict = do {
    my $dict = +{};
    my @chars = (qw/= ~ ( ) . ^ 1/); # '1'も使える！

    for my $c1 (@chars) {
        $dict->{$c1}++;
        for my $c2 (@chars) {
            $dict->{$c1 ^ $c2}++;
            for my $c3 (@chars) {
                $dict->{$c1 ^ $c2 ^ $c3}++;
                for my $c4 (@chars) {
                    $dict->{$c1 ^ $c2 ^ $c3 ^ $c4}++;
                    for my $c5 (@chars) {
                        $dict->{$c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5}++;
                        for my $c6 (@chars) {
                            $dict->{$c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5 ^ $c6}++;
                            for my $c7 (@chars) {
                                $dict->{$c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5 ^ $c6 ^ $c7}++;
                            }
                        }
                    }
                }
            }
        }
    }

    $dict;
};

print join(' ', map ord, sort keys %$dict), "\n";
print scalar keys %$dict, "\n";

0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
128

ktkr!! 見事に"\x00"~"\x7F"までのすべての文字を表現することができました。これで勝つる！

■すべての文字列を7種類の記号で表現する

ここまで出来れば、あと少しです。上記のものを少し改良して、以下のようなものを作ります。

my $dict = +{
    0   => ['^','^'],
    1   => [')','('],
    2   => ['^','.','~','=','1'],
    3   => ['^','.',')','(','~','=','1'],
    4   => ['^','(','~','=','1'],
    5   => ['^',')','~','=','1'],
    6   => ['.','('],
    7   => ['.',')'],
    8   => ['^','(','~'],
    9   => ['^',')','~'],
    10  => ['.','(','=','1'],
    11  => ['.',')','=','1'],
    12  => ['=','1'],
    13  => [')','(','=','1'],
    14  => ['^','.','~'],
    15  => ['^','.',')','(','~'],
    16  => ['^',')','(','~','1'],
    17  => ['^','~','1'],
    18  => ['.',')','(','='],
    19  => ['.','='],
    20  => [')','='],
    21  => ['(','='],
    22  => ['^','.',')','~','1'],
    23  => ['^','.','(','~','1'],
    24  => [')','1'],
    25  => ['(','1'],
    26  => ['^','.',')','~','='],
    27  => ['^','.','(','~','='],
    28  => ['^',')','(','~','='],
    29  => ['^','~','='],
    30  => ['.',')','(','1'],
    31  => ['.','1'],
    32  => ['^','~'],
    33  => ['^',')','(','~'],
    34  => ['.','=','1'],
    35  => ['.',')','(','=','1'],
    36  => ['(','=','1'],
    37  => [')','=','1'],
    38  => ['^','.','(','~'],
    39  => ['^','.',')','~'],
    40  => ['('],
    41  => [')'],
    42  => ['^','.','(','~','=','1'],
    43  => ['^','.',')','~','=','1'],
    44  => ['^','~','=','1'],
    45  => ['^',')','(','~','=','1'],
    46  => ['.'],
    47  => ['.',')','('],
    48  => [')','(','1'],
    49  => ['1'],
    50  => ['^','.',')','(','~','='],
    51  => ['^','.','~','='],
    52  => ['^',')','~','='],
    53  => ['^','(','~','='],
    54  => ['.',')','1'],
    55  => ['.','(','1'],
    56  => ['^',')','~','1'],
    57  => ['^','(','~','1'],
    58  => ['.',')','='],
    59  => ['.','(','='],
    60  => [')','(','='],
    61  => ['='],
    62  => ['^','.',')','(','~','1'],
    63  => ['^','.','~','1'],
    64  => ['^','.',')','(','1'],
    65  => ['^','.','1'],
    66  => [')','(','~','='],
    67  => ['~','='],
    68  => ['.',')','~','='],
    69  => ['.','(','~','='],
    70  => ['^',')','1'],
    71  => ['^','(','1'],
    72  => ['.',')','~','1'],
    73  => ['.','(','~','1'],
    74  => ['^',')','='],
    75  => ['^','(','='],
    76  => ['^','.',')','(','='],
    77  => ['^','.','='],
    78  => [')','(','~','1'],
    79  => ['~','1'],
    80  => ['.','~'],
    81  => ['.',')','(','~'],
    82  => ['^','=','1'],
    83  => ['^',')','(','=','1'],
    84  => ['^','.','(','=','1'],
    85  => ['^','.',')','=','1'],
    86  => ['(','~'],
    87  => [')','~'],
    88  => ['^','.','('],
    89  => ['^','.',')'],
    90  => ['(','~','=','1'],
    91  => [')','~','=','1'],
    92  => ['.','~','=','1'],
    93  => ['.',')','(','~','=','1'],
    94  => ['^'],
    95  => ['^',')','('],
    96  => ['.',')','(','~','1'],
    97  => ['.','~','1'],
    98  => ['^',')','(','='],
    99  => ['^','='],
    100 => ['^','.',')','='],
    101 => ['^','.','(','='],
    102 => [')','~','1'],
    103 => ['(','~','1'],
    104 => ['^','.',')','1'],
    105 => ['^','.','(','1'],
    106 => [')','~','='],
    107 => ['(','~','='],
    108 => ['.',')','(','~','='],
    109 => ['.','~','='],
    110 => ['^',')','(','1'],
    111 => ['^','1'],
    112 => ['^','.'],
    113 => ['^','.',')','('],
    114 => ['~','=','1'],
    115 => [')','(','~','=','1'],
    116 => ['.','(','~','=','1'],
    117 => ['.',')','~','=','1'],
    118 => ['^','('],
    119 => ['^',')'],
    120 => ['.','(','~'],
    121 => ['.',')','~'],
    122 => ['^','(','=','1'],
    123 => ['^',')','=','1'],
    124 => ['^','.','=','1'],
    125 => ['^','.',')','(','=','1'],
    126 => ['~'],
    127 => [')','(','~']
};

これを使って、すべての文字列を記号化するサブルーチンを定義します。1byteずつ分解して上の変換表に従って変換します。"\x80"~"\xFF"の文字については、"~"をつけてビット反転してやれば良いだけです。簡単ですね。

sub symbolize {
    my $str = shift;

    my @results;
    for my $char (unpack 'W*', $str) {
        my $reverse = 0;
        if ($char >= 128) {
            $reverse = 1;
            $char = 255 - $char;
        }
        my $chars = $dict->{$char};
        my $result = ($reverse ? '~' : '') . q{('} . join(q{'^'}, shuffle @$chars) . q{')};
        $result =~ s/'1'/(''=='').''/g;
        push @results, $result;
    }

    return join '.', @results;
}

■できあがり

ためしに、"はろーわーるど！"とutf-8で表示する記号プログラムを作ってみます。

print q/''=~(/ . symbolize(qq/(?{print"はろーわーるど！\n"})/), q/)/;

''=~(('(').((''=='').''^'^'^'~'^'.').((''=='').''^'='^'^'^')').('^'^'.').('='^'~'^(''=='').'').('('^'^'^'.'^(''=='').'').('('^'^'^')'^(''=='').'').('~'^'('^'='^(''=='').''^'.').((''=='').''^'='^'.').~('~'^'^'^'('^')'^'=').~('~').~('.'^'~').~('^'^'('^'~'^'='^')').~('.'^'='^'('^'^'^')'^(''=='').'').~((''=='').''^'~'^'=').~('='^'('^')'^'^'^'~').~('.'^'^'^'='^(''=='').'').~('='^'~').~('^'^'~'^')'^'='^'(').~((''=='').''^'='^')'^'('^'^'^'.').~('^'^'.').~('^'^'='^')'^'~'^'(').~('^'^'.'^(''=='').''^'=').~('~'^'=').~('='^'^'^'~'^')'^'(').~(')'^'^'^'.'^'('^(''=='').''^'=').~('~'^'.'^(''=='').''^'='^'(').~('~'^'='^')'^'^'^'(').~('~').~('('^'~').~(')'^'^'^'('^'~'^(''=='').'').~('='^'~').~('~').('('^'.'^(''=='').''^'=').('.'^(''=='').''^'=').((''=='').''^')'^'.'^'='^'('^'^').(')'))

ちゃんと実行できる7記号のみによるPerlプログラムができましたね！