Perlbatross in YAPC::Hakodate 2024の結果発表と解説 #yapcjapan

こんにちは！　技術部の谷脇です。

去る10/5にYAPC::Hakodate 2024が開催されました。いかがでしたか？　

以前に告知したように今回のYAPCもコードゴルフコンテストPerlbatrossを開催しました。

techblog.kayac.com

このエントリでは結果発表と、事前解答チームの川添(@acidlemon)より社内最短解の紹介と解説をお届けします。

Perlbatrossは現在コードの投稿や検証はできるものの、ランキングに載らないモードになっております。あと1週間程度はこのようにしておきますので、やりそびれた方や、ちょっと試してみたいなという方は是非コードゴルフに挑戦してみてください。

ここで宣伝

JavaScript版コードゴルフコンテスト JS体操はまだまだやっております！

hubspot.kayac.com

こちらも是非ご参加ください。

これはPerlbatrossの裏話ですが、JS体操の問題で生成したアスキーアートをPerlbatrossのHole2のテストに使っていました。

さらにランダム性を持たせるために回転もしていました。

結果発表

今回のPerlbatrossの優勝は「こーのいけ」さんでした！

Hole1が-36(64bytes), Hole2が-35(70bytes)でした。前回も参加していただいていたsugyanさんは惜しくも2位、そして続く3位にはkobakenさんが入りました。

全体の順位はPerlbatrossのサイトからご覧ください。

参加していただいた皆様には感謝を申し上げます。

では、ここからは@acidlemonさんにバトンタッチです。

社内最短解の紹介と解説

こんにちは @acidlemon です! 今回もPerlbatrossをお楽しみいただきありがとうございました。

前回はPerlbatrossのシステムを作るところにそこそこ時間がかかったのと、4問も作ってしまったので社内の事前解答があんまり進まないままParを決定したのでなかなかスコアが激しいことになっていましたが、今回は2問、事前解答の時間もまぁまぁ取れたということで大体2問とも60〜70byteくらいになりそうということがわかりPar100とPar105に設定しました。

それでは、社内の事前解答の最短解を簡単に解説していきます。この解答は私だけでなく @fujiwara と @macopy の3人で短くしていったものです(偶然ですが、fujiwara組です)。

Hole 1: Portalbless Gramana

事前解答の最短解

スコア: -39 (61バイト)

map{%s=map{+"@{[sort/\w|\W{3}/g]}",1}split;print%s==1|0,$/}<>

参加者のみなさんの最短解はshebangを書いてPerlのオプションを設定していい感じにやるものでしたが、なんと社内ではshebang書いたら効くことに気付いていなかったということでただのワンライナーとしての最短を追求しています。一応、「perlコマンドのオプションで -a というのを使うと @F ってっていう変数に1行ずつ突っ込まれた状態でスクリプトが実行される仕様があるかとおもうんですが、これをPerlのスクリプト内で有効にする方法ってないですよね?」などといった話は社内でもしていたのですが… 組長に「shebangで指定するぐらいしかない気がする…」と言われてじゃあ無理だな! と諦めてしまっていました。

というのも、前回のYAPC::Hiroshima 2024のPerlbatrossは入力されたスクリプトをdoブロックにいれて実行する方式だったのでshebangが効かなかったのです。今回はチート抑止みたいなところの意図でperlコマンドを実行する方式になったので、ちゃんとshebangを書けば効くようになっていたのでした。

短縮の過程

アナグラムの判定は、文字ごとにソートしてHashのキーにして、最後にハッシュのキーを数える方法でやりました。この辺からスタートです。

for(<>){
  utf8::decode($_);                    # 文字列をUTF-8として扱う
  my %h;                               # ハッシュ %h を初期化しておく
  for(split /\s/, $_){                 # $_をスペースでsplitして、各単語ごとにループを回す
    $h{join("", sort(split //, $_))}++ # 単語を1文字ずつバラしてソートし結合したものを %hのキーにして値を設定
  }
  print %h==1 ? 1 : 0, "\n"            # ハッシュキーの個数が1個なら、アナグラム成立
}

可読性のためにコメント、改行、インデントが入ってますが、それを全部詰めるとちょうどParになります(my %hなども my%hと書けます)。

for(<>){ ... } を map{ ... }<> に書き換える
省略できる $_ は全て省略する
余計なカッコ()を削る
printのところの三項演算子のところは真なら1、偽なら空になるのでOR演算子を使って偽のときだけ0にする

などをやっていくと、-19くらいまで短くなります。

map{utf8::decode$_;my%h;map{$h{join"",sort/./g}++}split/\s/;print%h==1||0,"\n"}<>

まだまだ削っていけるので、いろいろ削っていきます。

myは不要
mapで(key,1)のリストを返して直接 %h に代入できる
utf8::decodeはutf8'decodeにできる(deprecated記法)
splitは第一引数を省略すると /\s+/ 相当になるので省略可能
%h==1||0 は Vertical Bar を1個省いて %h==1|0 にできる
"\n" は $/ に置換可能

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

これで -31 です。ここで、同じバイト数の別解として内側のmapのところをjoinを使わずに書く方法もありました。

map{utf8'decode$_;%h=map{("@{[sort/./g]}",1)}split;print%h==1|0,$/}<>

今回の問題には utf8::decode をサボるとFailするようにするテストが入っています(test2の固定テスト、test3のランダムテスト両方)。UTF-8シーケンスとして評価するとアナグラムではないが、バイト列として評価するとアナグラム判定になるというものです。たとえば「あヵ」と「ヂふ」は見るからにアナグラムではないのですが、それぞれ6バイトのバイト列として1バイトずつアナグラム判定をしてしまうと構成バイトが同じ! となってしまいます。utf8::decode をサボるとこのテストが通らなくなるようになっています。

ということで、utf8::decode は簡単に外せないようになっています。ただ、問題文に単語の文字種は「英数・ひらがな・全角カタカナ」とかいてあるので、UTF-8的にはASCII範囲の1バイト or ひらがなカタカナの3バイトが来るということになります。これはうまいこと正規表現を書くと1バイトor3バイトのシーケンスで取り出していくことができます。

utf8::decodeを取る
sort/./g を sort/\w|\W{3}/gに変更

map{%h=map{("@{[sort/\w|\W{3}/g]}",1)}split;print%h==1|0,$/}<>

これで -38になりました。最後に、内側のmapのところに記号がやたら固まっているのでこれなんとかできないかとperldocをよく読みました。 map{ ... } の内側の最初にカッコ()があるのはPerlインタプリタがmap EXPR,LIST と map BLOCK LIST を間違えてしまうのを防ぐためにカッコをつけている(BLOCKとして認識させている)のですが、これはPerldocによると + とかの単項演算子をおくだけでOKとのことだったのでカッコを無くしてプラスに置換しました。

map{%h=map{+"@{[sort/\w|\W{3}/g]}",1}split;print%h==1|0,$/}<>

…というのがカヤック社内最短解の解説でした。

なお、あとでまとめてリンクをご紹介しますが、参加いただいた方のWriteUpを読んで上のコードは %h==1 を %h<2 に出来ることに気付いたので、そこまでやると -40 となります。

別のアルゴリズムパターン

アナグラム判定でハッシュを使わず配列でやっていく方法も試したのですがやはりハッシュのほうが短くなりますね。配列でやる場合は、ソートした文字列を詰めた配列と、配列の1個目の要素を配列の個数分リピートした配列をスマートマッチで完全一致判定をみるみたいな感じでしょうか。配列同士のスマートマッチで書くならこんな感じです(これでももっと短くはなりそうです)。

map{utf8'decode$_;@a=map{join"",sort/./g}split;@b=($a[0])x@a;print@a~~@b|0,$/}<>

これで -20 です。

Hole 2: QuAAterPix

事前解答の最短解

スコア: -33 (72バイト)

for my($a,$b)(<>){print map{$a=~s/(.)(.)?//s;$2x2eq$_?$2:$1}$b=~/..?/sg}

for my($a,$b)(<>) という記法は Perl 5.36から利用できるようになった for my でリスト受け取りができるようになったという文法を利用しています。これ自体はwhile($a=<>,$b=<>) より1バイト短く書けます。ただ、この記法の弱点は myなので $_ に書き込むことが出来ないことです。

事前解答中には while($a=<>,$b=<>) 記法に気付いてなかったのですが、これを使って書き直すと$_に書き込むことが出来るのと、ループの中身が単文だと後置にできること、カッコも省略できること…がありまして

print(map{$a=~s/(.)(.)?//s;$2x2eq$_?$2:$1}/..?/sg)while$a=<>,$_=<>

これで -39になるので、こちらのほうが短かったですね。

短縮の過程

4つの文字を1文字にするアルゴリズムは、ルールに着目すると

基本的に左上の文字を採用してよい(左上の文字が2回以上出現するなら左上の文字で確定)
ただし、左上文字が1回、残りの3文字が別の文字のときだけは残りの文字を採用する

という感じになります。ここからの説明では、左上、右上、左下、右下の順に1文字目〜4文字目と呼んでいます。

まずこのぐらいのコードからスタートします。コメントと改行空白を潰して+15のコードです。

for my($a,$b)(<>){
  while ($a =~ /(.)(.)/g) { # $a を2文字ずつ切り出してループを回す 
    # $1が1文字目, $2が2文字目
    # $cが3文字目と4文字目の2文字
    $c = substr($b, 0 , 2, ''); # substrで$bを2文字削っている
    
    if ($c eq $2.$2){
      # $2(1文字)と$c(2文字)がすべて同じ場合はその3文字を採用
      push @r, $2
    } else {
      # それ以外は最初に出現した文字を採用
      push @r, $1
    }
  }
  push @r, "\n" # 改行を追加
}
print @r

/gつきの正規表現を while で回すとマッチし続ける限りループが回るので、それを利用して1行目($a)を2文字ずつ切り出しながら2行目($b)もsubstrで切り出していきます。2行目を正規表現で切り出していくと$1と$2が変わってしまうので、あえて正規表現を使わず切り出しています。

最初に整理したとおり、基本は1文字目(左上)を採用すればOKですが、の2〜4文字目が3文字とも同じときだけはそれを採用しないといけないというのを「2文字目を2回繰り返したものと3文字目4文字目が等しいかどうか」で確認しています。

ひとまず改行空白コメントを潰したものを短くしていきます。

for my($a,$b)(<>){while($a=~/(.)(.)/g){$c=substr($b,0,2,'');if($c eq$2.$2){push@r,$2}else{push@r,$1}}push@r,"\n"}print@r

$cは1回しか使わないので変数に受ける必要が無い
if文は三項演算子にできて、push @r の引数に$2 or $1を選び取る三項演算子を直接書ける

for my($a,$b)(<>){while($a=~/(.)(.)/g){push@r,substr($b,0,2,'')eq$2.$2?$2:$1}push@r,"\n"}print@r

これで-9になり、Parを切ることができました。

whileの中が文1個になったので、後置whileにできる

for my($a,$b)(<>){push@r,substr($b,0,2,'')eq$2.$2?$2:$1while$a=~/(.)(.)/g;push@r,"\n"}print@r

-12になりました。

入力の最後に改行が入ってて、それを捨てるなんてもったいない! ということで正規表現を/s(シングルラインモード)にする
- 行末の最後の改行1個だけ拾えるように、2文字目は任意(?つき)にする
- 改行は $1 に入ってくるので三項演算子の条件を満たさず勝手に$1が入る
するとpushが1個になるので、もはやpushする必要が無い。その場でprintする

for my($a,$b)(<>){print substr($b,0,2,'')eq$2.$2?$2:$1while$a=~/(.)(.)?/sg}

-30になりました。

ここから風雲急なゴリッとした改造になりますが

substrを正規表現に置換したいので、$aでループを回すのではなく、$bで回すようにする
- $b=~/..?/sg で回すことができて、3文字目4文字目として$_ を利用できる
ループの中に入れた $a は s///s で置換ループにして2文字ずつ削る
whileの中が1文じゃなくなるので、mapに変える
$2.$2 は $2x2 にすると1文字削れる

for my($a,$b)(<>){print map{$a=~s/(.)(.)?//s;$2x2eq$_?$2:$1}$b=~/..?/sg}

…ということで最後に大改造になりましたがこれで -33になりました。

別パターン

4文字を1文字にするところは、別パターンとして

左上の優先度が高いので重み2で評価して出現が過半になっているものを採用する
- [0,0], [0,0], [0,1], [1,0], [1,1] の5文字を連結して文字数カウントして3文字以上あるものを採用

とかもあります。そのパターンだと-24くらいになりました。

for my($a,$b)(<>){CORE::say map{$a=~s/(.).//;"$1$&$_"=~y/#//>2?"#":"`"}$b=~/../g}

社内最短解の紹介と解説は以上です。いかがでしたでしょうか?

謝辞

最後に、参加いただいた方々への謝辞を込めまして、皆様のWriteUpもこちらで紹介いたします。

1位: こーのいけさん YAPC::Hakodate 2024 Perlbatross参戦記（ネタばれ含む）
2位: sugyanさん 2024hakodate - sugyan - Obsidian Publish
3位: kobakenさんカヤックさん主催のコードゴルフ企画のPerlbatrossを勝手に解説、感想。ネタバレ含みます！

広島に引き続いての2回目ではありますが、こういったゲリラ的な企画はみなさまの参加無しには成り立ちません。また、YAPCに参加できなかった方もPerlbatrossのようなオンラインで参加できる企画に来ていただいて、我々としてもこの企画をやる意義を感じました。みなさまご参加いただき本当にありがとうございました。