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

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

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

yapcjapan.org

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

techblog.kayac.com

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

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

ここで宣伝

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

hubspot.kayac.com

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

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

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

回転するYAPCロゴ

結果発表

今回の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::decodeutf8'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/./gsort/\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,LISTmap 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もこちらで紹介いたします。

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

YAPC::Hakodateでもやります!コードゴルフ企画Perlbatross 前回行われたチートも解説するよ #yapcjapan

こんにちは!!! お元気ですか?????? カヤック技術部の谷脇です。

来たる10/5にYAPC::Hakodate 2024が開催されます! わーい!!

yapcjapan.org

我々カヤックもYAPC::Hakodate 2024にスポンサーしております。弊社からも何人か登壇します。実は私もします!

techblog.kayac.com

そして、前回のYAPCでは椅子スポンサーとしてPerlbatrossという企画しておりました。Perlbatrossとは、お題に対してPerlでいかに短くコードを書くか競うコンテストです。つまりコードゴルフです。

前回は気合を入れておりまして、このために問題を閲覧したり投稿された回答をperlを実行して検証したり、回答の短さをもとにランキングを出すWebアプリケーションを作りました。もちろんPerlで。

前回のランキングの様子

回答投稿ページの様子。Parは基準バイト数だが大幅に下回るスコアが出た

Perlの動かし方がわからない方でも、とりあえず試行錯誤できる作りになっております。

当日は多くの方に参加いただきました。大変ありがとうございます。上位の方のコードの解説編はこちら。

techblog.kayac.com

そして今回YAPC::Hakodate 2024でもPerlbatrossをやります!!!パチパチパチ👏〜。

開催期間は 2024/10/04 15:00 〜 2024/10/07 12:00 です。

問題数ですが、前回は4問ありました。今回は全部で2問にしています。4問は多すぎましたね...。それぞれタイトルは「Portalbress Gramana」と「QuAArterPix」です。どんな問題か想像してお待ちください。

時間になりましたらこちらのサイトがYAPC::Hakodateバージョンに切り替わります。 👉 https://perlbatross.kayac.com/

チート解説編

ここでは前回のPerlbatrossで行われたチートっぽい回答についてご紹介します。ちなみにYAPC::Hakodate 2024バージョンでは仕組みを見直して潰しております。

Test2::V0::is関数を上書き

以下が前回のPerlbatrossのコード検証の仕組みです。

  1. あらかじめ問題ごとに設定してある入力文字列をファイルから読み込んで標準入力に流し込む
  2. 独立した名前空間(package)を作る
  3. ユーザー投稿されたコードを名前空間内で実行する
  4. 実行した後に標準出力に吐かれたコードを対応する出力文字列ファイルと比較する

以上のコードをPerlの標準的なテストファイル内で行なっていました。

この実行方法を利用したチートがこちらです。

*::is=*::ok

11バイトで回答できてしまいました。これは何をやっているかというと特定の名前空間内にインポートされた関数を上書きしています。*は型グロブを表し、型グロブ同士の代入はエイリアスです。またパッケージ名区切りの::の左辺に何もない場合はmainパッケージが省略されたとみなします。なのでこの場合は長く書くと *main::is=*main::okとなりますね。いわゆるシンボルテーブルをいじっているわけですが、Perlはこういうよその名前空間に手を出していける柔軟(?)なところが好きであり、また困らされるところではあります。

じゃあこれらのisokってなんだろうとなりますが、これはTest2::V0内のテストアサート用の関数です。isは1つ目と2つ目の引数が同一であればOKを返し、okは1つ目がtruthyな値であればokを返します。

では4のコードを見てみましょう。

my $expect = $io_dir->child("output.txt")->slurp_utf8;
$stdout = decode_utf8($stdout);
is((diff \$stdout, \$expect), "");

この場合、isで標準出力と実際の正解の出力とで差異がない、つまりdiff関数が空になることを期待していますが、これがokと入れ替わったらどうでしょうか。Perlは空文字ではないかつ"0"でもない文字列をtrueであると判断するため、diffがあった場合はokとなりますね。上記のコードは何も出力しないため、差異が発生し、どんな入力・出力であってもテストが通ってしまいます。

これのどこに穴があったかというと、上記の3の部分で同じプロセス内で投稿されたコードを実行したところにあります。コンテスト期間中ですが、このチート対策として投稿されたコードをdoでプロセス内実行するのではなく、perlコマンドで実行するように変えてこのチートを塞ぎました。YAPC::Hakodate 2024バージョンではさらに対策を入れています。

こちらの手法ですが、id:akiym さんのブログで解説されています。

blog.akiym.com

ブログでは他の手法もいろいろ考えたそうですが、結果的にシンプルかつすぐに「やられた!」と思ったコードでした。ここまでスパッとくるとスッキリしますね。

入力を見て固定出力を出す

Hole4「Pytecode」で1位だったKarakasaDcFdさんのコードを見てみましょう。

use v5.38;my@q=<>;print"Hello World
"if$q[0]=~/H/;my@a=(2,23,6,3,3);$"=$/;print"@a
"if$q[2]=~/\+/;print"true
false
"if$q[1]=~/if/;print"false_false
"if$q[2]=~/if/;@a=1..10;print"@a
"if$q[3]=~/10/;$"=' ';@a=0..9;if($q[3]=~/b/){for(0..9){print"@a
";shift@a}}

PytecodeはForthもどきのコードを実行するインタプリタを作成する問題でした。しかし曲がりにもプログラムなのでちゃんと動作する問題のパターンが限られてしまいました。

最初のprint"Hello World\n"if$q[0]=~/H/;はHを含む行があった場合はHello World\nを出力するというコードですが、問題の入力では以下に該当します。

Hello World
.
cr

今回のプログラミング言語はただの文字列リテラルはスタックに積み、.でprint、crで改行なのですが、他にHが先頭に来るような問題がなかったため、/H/で問題がクリアできてしまいました。

次のmy@a=(2,23,6,3,3);$"=$/;print"@a\n"if$q[2]=~/\+/;ですが、2問目に対応しています。このコードでは四則演算をしてprintしていくものでしたが、+`が3行目に来る問題は他になかったため、これを特徴として使われてしまいました。

そんな感じで残りも他の問題入力とは違う特徴を用いて固定値、もしくは固定値を出力できるようなコードを実行する感じです。お見事でした。

/tmpに正解ファイルを保存

PerlbatrossはAWS Lambda上で動いています。Lambdaは/tmpに読み書きできる領域が用意され、またそれは1回の実行を跨ぐ(リクエストを返した後に削除されない)仕様になっています。それを使ったチートです。

コード実行環境に問題の入力および出力のペアが存在するため、それをcatするだけで通ってしまうってことですね。

これをやった方は別の手法のチートもしておりまして、どちらもPerlや問題とは関係がないものです。またどちらも私がWebアプリケーション上に入れてしまった脆弱性に起因するものです。現在は対策済みです。

私が皆さんにお伝えしたいこととしては、この企画は皆さんにPerlを楽しく書いてもらうために用意したものであって、CTFの問題として公開しているものではありません。実行環境を破壊して他の方に影響が出たり、リーダーボードに影響が出てしまうのは私の落ち度があるとはいえ本意ではありません。なので、もしこれはWebアプリケーションとして問題があるのではないかと思われた方は、そのまま突っ走らず、会場でこっそり私に言ったり、このブログのXアカウントもしくは私のアカウントにDMしていただけると助かります。

その他のお知らせ

今回のPerlbatrossはさらに改善を加えております。

間違ったコードを投稿した後に1個前に戻りたいという声があったのでボタンを追加しました

Perl初心者でも安心!チートシートをコメントに入れてます(消すだけでスコアが上がるボーナスもあります)

また併催としてJS体操もやっております! Perlbatrossとの問題のコラボもあるかも? JS体操で知った方もPerlbatross挑戦してみてね〜。

hubspot.kayac.com

皆様の参加をお待ちしております!