Blog::kobaken

prove t/foo/bar/baz.t

カヤックさん主催のコードゴルフ企画のPerlbatrossを勝手に解説、感想。ネタバレ含みます!

結果は3位。悔しい!楽しい!でした。

最終コード

Hall1

(utf8'decode$_)^print%{{map{(join"",sort/./g),1}split}}<2|0,$/for<>

Hall2

while($_=<>,$b=<>){s/(.)(.)/$_=$1.$2.substr$b,0,2,'';y!#!!>2?'#':y!`!!>2?'`':$1/eg;print}

解説

いきなり上のような短いコードは書けないので、読みやすく正しいコードを少しずつ短くしていく方法を紹介します。

Hall1のコード解説

Hall1で各単語がすべてアナグラムかどうか判定する必要があります。この判定ロジックは、「単語の各文字を整列したキーでハッシュを作りそのキーが複数かどうか」にしました。コードの短さにこだわらず実装するとこうなります。

for my $line (<>) {
  chop $line; # 改行削除。$key作成時にノイズになるため。
  utf8::decode $line; # Encodeモジュールを使う方が従来は堅いですが、コードゴルフ用にこちらを利用

  my @words = split / /,$line; # 半角区切りで単語を抽出
  my %map = map {
    my $key = (join"",sort split//,$_); # ここが肝。単語の各文字を整列したキーを作成
    $key => 1
  } @words;
  print keys %map == 1 ? 1 : 0, "\n"; # 各文字が複数あるかどうかで出力を出し分け
}

こちらのコードを一段階ずつ短くしていきます。コードが短くなっていく過程を疑似体験してもらうために順に説明していますが、以下の作業はどの順でやっても大丈夫です。

STEP1: $line (<>) を略す

まずは、for my $line (<>) のループは、for (<>) と略します。$line は、デフォルト変数 $_ に入ります。

for (<>) {
  chop; # 改行削除。$key作成時にノイズになるため。
  utf8::decode $_;

  my @words = split / /;
  my %map = map {
    my $key = (join"",sort split//,$_);
    $key => 1
  } @words;
  print keys %map == 1 ? 1 : 0, "\n";
}

chop, split が、$_ を暗黙に受け取っています。組み込みの関数だとそういった引数の省略ができることが多いです。

STEP2: ハッシュを作るための変数をまとめる

次に、ハッシュを作る処理を、短くしたい思います。 キーを作る際に、() を外すと、=> 1 もsort対象になるので注意してください。(join EXPR,LIST というI/Fになっているので、括弧がないと、join対象になっちゃう)

for (<>) {
  chop; # 改行削除。$key作成時にノイズになるため。
  utf8::decode $_;

  my %map = map {
    (join"",sort split//,$_) => 1
  } split / /;

  print keys %map == 1 ? 1 : 0, "\n";
}

@words と $key を消しました。

STEP3: chopを消す

次は、chopを消したいと思います。単語を一文字ずつにバラすために、split//,$_を利用していましたが、一文字ずつマッチさせる正規表現/./g を利用します。/./ は改行にはマッチしないのでchopを省けるようになって好都合です。普段、正規表現でマッチさせる時、my @match = $str =~ /./g のように書きますが、マッチさせる文字列 $str を省略すると、$_ が利用されます。

for (<>) {
  utf8::decode $_;

  my %map = map {
    (join"",sort /./g) => 1
  } split / /;

  print keys %map == 1 ? 1 : 0, "\n";
}

STEP4: ファットカンマをやめる

ファットカンマ=> を 普通のカンマに, に変更します。一文字稼げました😊

for (<>) {
  utf8::decode $_;

  my %map = map {
    (join"",sort /./g), 1
  } split / /;

  print keys %map == 1 ? 1 : 0, "\n";
}

STEP5: keysを省く

ハッシュをスカラコンテキストで評価するとPerl5.25からキーの数を返します。なので、keysを省けます。*1

for (<>) {
  utf8::decode $_;

  my %map = map {
    (join"",sort /./g), 1
  } split / /;

  print %map == 1 ? 1 : 0, "\n";
}

STEP6: %map を消す

次に、%map 変数を無くします。ここでやっていることは記号が多くてわかりづらいですが、ポイントをまとめると %{{ LIST }} こういったコードになっています。内側の{}でリストをハッシュリファレンスで評価し、外側の%{}でハッシュリファレンスをデリファレンスしています。 $hash = { LIST } して、%{$hash} しています。

for (<>) {
  utf8::decode $_;

  print %{{
      map {
        (join"",sort /./g), 1
      } split / /
  }} == 1 ? 1 : 0, "\n";
}

STEP7: 三項演算を略す

三項演算子の処理を短くします。出力する値は1か0 でよく、真偽値を判定している箇所なので、ビット演算で1と0を作れます。

for (<>) {
  utf8::decode $_;

  print 0 | %{{
      map {
        (join"",sort /./g), 1
      } split / /
  }} == 1, "\n";
}

STEP8: 等号を不等号にする

== 1 を、< 2 にして一文字稼ぎます。必ず1つはキーが入ること(各行に1単語は含まれること)を仮定しちゃってます。

for (<>) {
  utf8::decode $_;

  print 0 | %{{
      map {
        (join"",sort /./g), 1
      } split / /
  }} < 2, "\n";
}

STEP9: 改行コードに、$/を利用する

改行コード "\n" を入力レコードセパレータ$/ に変更します。2文字稼げました。my $content = do { local $/; <> } なんてイディオムで見たことあると思いますが、あれは区切りをundefにしていますが、普段は改行が入っています。

for (<>) {
  utf8::decode $_;

  print 0 | %{{
      map {
        (join"",sort /./g), 1
      } split / /
  }} < 2, $/;
}

STEP10: split / / をsplit に変更

split PATTERNのPATTERNを略すと空白文字で分割するので、split / / は、splitと書けます。*2

for (<>) {
  utf8::decode $_;

  print 0 | %{{
      map {
        (join"",sort /./g), 1
      } split
  }} < 2, $/;
}

STEP11: for() { } 文を後置forにして括弧を省く

単純文 for LIST と書ければ、for 文の括弧が省けます。単純文にするために utf8::decode $_ とprint の処理を適当につなぎます。ここではxorでつなぎました。

(utf8::decode $_) ^
  print 0 | %{{
      map {
        (join"",sort /./g), 1
      } split
  }} < 2, $/ for <>

STEP12: 改行とスペースを無くす。

decode $_ のスペースは省けます。識別子の中に記号は入らないため、スペースが無くてもperlは区別してくれます。似た要領でsort /./gsort/./g など省きます。

(utf8::decode$_)^print 0|%{{map{(join"",sort/./g),1}split}}<2,$/for<>

STEP13: スペース省きのためのチューニング

print 0|%{...}<2 と書かれている箇所をprint %{...}<2|0 のように順序を入れ替えます。すると、print と %{...} の間のスペースを省けます。

(utf8::decode$_)^print%{{map{(join"",sort/./g),1}split}}<2|0,$/for<>

STEP14: パッケージのセパレータをアポストロフィに変更

パッケージのセパレータに、::ではなく、アポストロフィが使えるので、utf8::decode は、utf8'decode に変更できます。 ただし、この機能は perl5.42で削除予定です。 perldiag - various Perl diagnostics - metacpan.org

(utf8'decode$_)^print%{{map{(join"",sort/./g),1}split}}<2|0,$/for<>

これで提出したコードと同じになりました。

1位と2位との差

sugyanさん、こーのいけさんとの差は、shebangの見落としでした。コードゴルフで、shebangでオプション指定は定番*3とのことで、悔しい。

まず、lp オプションで、改行コードとprintとforが省けます。

#!perl -lp
utf8'decode$_;$_=%{{map{(join"",sort/./g),1}split}}<2|0

次に、a オプションで、split を@Fに変更できます。@Fを利用すると、decodeを通さないといけないので、joinの結合文字にdecode結果を利用しているのがまたクールです。別にどんな文字で繋いでも良いですからね。

#!perl -lpa
$_=%{{map{(join utf8'decode($_),sort/./g),1}@F}}<2|0

Hall2の解説

Hall2のコードは、時間の都合は少しだけ触れます。機会があれば、どこかで。

戦略的には、2x2のブロックを文字列で作って、正規表現でやっつけました。 Hall1よりも一直線に短くなりませんでした。以下は、作業の記録です。

まず、素朴に作るとこんな感じのコードになりました。tr// でなく y//を使うのは初めてでした。 また、2行ずつ処理をするに、perl5.40 の最新機能を使っているのが個人的にポイント高いです。

for my ($a,$b) (<>) { # 
    my @a = $a=~ /../g; # 2文字ずつ分解
    my @b = $b=~ /../g;

    for (0 .. $#a) {
        $_=$a[$_].$b[$_]; # ブロックを文字列で作成

        print y!#!!>2 ? '#' # 2個より多く # があれば、#
               : y!`!!>2 ? '`'  # 2個より多く ` があれば、`
               : /^./g              # いずれも2の場合は、先頭文字
    }
    print $/; # 改行
}

ループをmapで回した。

先のコードが @a を中心にループを回していて、@b はループに絡んでいないので、$a =~ /../g を変数で受け取らずそのままループすることにしました。

for my ($a,$b) (<>) {

    map {
        $_.=substr$b,0,2,''; # $b の先頭2文字を切り取る

        print y!#!!>2 ? '#'
               : y!`!!>2 ? '`'
               : /^./g
    } $a=~ /../g;

    print $/;
}

これの改行、スペースを除いて、 暫定1位を喜び、悠々紹介ブログを書き、ゆっくり寝ました。

kfly8.hatenablog.com

朝起きると、こんなメンションが飛んできていました。まさに油断大敵。

Hall2 は、10文字以上離れていたので、どこか考え方を変える必要があるんだと焦りました。それは、前述のshebangでした。

ループをs///eg で回した

print が2回あるのを減らすために、置換のegオプションを利用してループを回しました。eオプションを利用するとreplacementでperlのコードが書けて、gオプションを利用するとマッチした文字列にすべてに対してその処理を実行できるので反復処理ができます。

while ($_=<>,$b=<>) {

    s/(.)(.)/
        $_=$1.$2.substr$b,0,2,'';

          y!#!!>2 ? '#'
        : y!`!!>2 ? '`'
        : $1
    /eg;
    print
}

いくつか案を思いつくも、相手が削っている文字数を考えると、どうもうまくいくとは思えず、結局こんな内容のコードで終わりました。

1位と2位のコードを見比べて、まだできそうだと思ったこと

スペースシップ演算子<=> で三項演算子を削る

while ($_=<>,$b=<>) {
    s/(.)(.)/
        $_=$1.$2.substr$b,0,2,'';
        ($1,'#','`')[y!#!!<=>2]
    /eg;
    print
}

$& を利用する

while ($_=<>,$b=<>) {
    s/(.)./
        $_=$&.substr$b,0,2,'';
        ($1,'#','`')[y!#!!<=>2]
    /eg;
    print
}

shebang を利用する

#!perl -p
@b=<>=~/../g; # substr が使いづらくなったので、@b に2文字ずつ区切って格納
s/(.)./
    $_=$&.shift@b;
    ($1,'#','`')[y!#!!<=>2]
/eg

終わりに

コードゴルフを今までしっかり向き合ったことがなかったのですが、コードゴルフに出てくる超絶技巧のコードも、素朴なコードから少しずつ積み重ねていけば近づけることが実感できて良かったです!また、技術的にも、仕様や挙動を理解するきっかけになって良かったです!そして、負けて悔しい思いできたことも良かったです😇 こーのいけさん、sugyanさん、カヤックさんありがとうございました!