[Perlbatross](https://perlbatross.kayac.com/contest/2024hakodate) [[2024hiroshima]] に続いて2回目の開催。今回は2問だった
## Hole 1: Portalbress Gramana
提出解:
```perl
#!perl -lp
utf8'decode$_;$_=%{{map{("@{[sort/./g]}",1)}split}}>1^1
```
アナグラムの判定は単語内の各文字の出現回数を比較、だと確実だがあまり短く書ける気がしない。
定番(？)なのは「各単語を文字配列としsortした結果が全部同じになるか否か」という判定方法。
とはいえPerlで`Set`みたいなものあったっけ…？と最初は何も思いつかず、各単語をsortした結果と 1つ目のsort結果を連続で繋げたものが同一かどうか、などで判定していた
```perl
(utf8::decode$_)^(@a=map"@{[sort/./g]}",split)^print 1-"@a"!~"@{[($a[0])x@a]}",$/for<>
```
それならいっそHashにkeyとして入れてそのサイズを見た方が良い。 `keys %h`のようにしなくてもscalar contextでサイズ得られるんだ！？ [5.25からとのこと](https://kfly8.hatenablog.com/#f-a283b246)
```perl
for(<>){utf8'decode$_;my%c;$c{"@{[sort/./g]}"}++for/\w+/g;print+1-(%c>1),$/}
```
それにしても文字列を各文字で区切って並び換えるのが `sort/./g` だけで実現できるのは便利ですごい。ただそれを `join` しなおすか `@{[...]}` とかで評価しないと文字列として得られないのが不便だった…
ここで自分のベストより長い回答は他の人のものでも自由に見られるらしい、ということに気付いた。kobakenさんの回答を覗いてみると
```perl
map{utf8::decode$_;print!(%{{map{(join"",sort/./g),1}split/ /}}-1)+0 ."\n"}<>
```
というのがあって、あそうか `%{{ }}` で直接Hashを作成して評価できるんだ…！ということに気付いて、アイデアを ~~パクらせてもらう~~ 参考にさせていただく。
```perl
(utf8'decode$_)^print+1-(%{{map{("@{[sort/./g]}"),1}split}}>1),$/for<>
```
判定からの出力は、 `%{...}` が`1`なら`1`を、`1`より大きかったら`0`を、出力する必要がある。単純に `%{...} == 1` の反転を出力すれば良さそうだが、真偽値評価では偽値は何も出力してくれない。ので数値として評価されるよう何らか演算してやる必要があった。結果として `%{...}>1` が逆の結果になるので、`1`との`xor`を取ることで短くできた。
```perl
(utf8'decode$_)^print%{{map{("@{[sort/./g]}",1)}split}}>1^1,$/for<>
```
このあたりで限界かな…と思っていたところでshebangを使って`for`や`print`を省く方法を思いつく。
最初`-l`の存在を忘れていて`$\=$/;`とか書くことで余計に長くなってしまったりしていたが、最終的に提出解の形で少し短くできた。
ここまで思いついていて`-a`を使って`@F`で処理するのを思いつけなかったのは悔しい…
## Hole 2: QuAAterPix
提出解:
```perl
#!perl -p
@b=<>=~/../g;s/(.)./$_=
amp;.shift@b;($1,'#','`')[y!#!!<=>2]/eg
```
最初は全然方針も思い付かなくて苦労した。とにかく4マスぶんの文字を全部集めて、3個以上あったらそれで1個以下だったら反対のもの、2個のときは一番左上のを採用、と
```perl
@l=map{[split//]}<>;for$i(0..@l/2-1){for$j(0..@{$l[$i]}/2-1){@c=($l[$i*2][$j*2],$l[$i*2][$j*2+1],$l[$i*2+1][$j*2],$l[$i*2+1][$j*2+1]);$c=grep{/#/}@c;print$c>2?'#':$c<2?'`':@c[0]}print$/}
```
さすがに2次元配列でアクセスするのは筋が悪すぎる。逐次で2行ずつ取得するには？とChatGPTに訊いたところ `while($a=<>,$b=<>){...}` とできる、とのこと。 `/../g` で2文字ずつ取得し、同一の文字かどうか、を判定してみることにした。
- 上の行の2文字が同一ならそれが必ず採用される
- そうでない場合、下の行の2文字が同一ならそれを採用
- それでもない場合は上の行の1文字目を採用
という方針。今思うと この判定方法をもっとじっくり考えるべきだった…
```perl
while($a=<>,$b=<>){@a=map/(.)\1/&&$1,$a=~/../g;@b=map/(.)\1/&&$1,$b=~/../g;print$a[$_]||$b[$_]||substr$a,$_*2,1for(0..@a)}
```
判定を正規表現でやってみることにした。上の行の2文字ずつと下の行の2文字ずつを繋げた4文字のものに対し、 `/^(.)\1|(.)\2$/` でマッチ(上の方針の1、2番目) すればそれを `$+` とかで拾える。マッチしなければ `/(.)/` で最初の1文字を拾う。最後に改行させるために `@a` に `$/x2` を付け足し、`//s` で改行コードにもマッチさせるという技も繰り出した
```perl
while($a=<>,$b=<>){@a=$a=~/../g;@b=$b=~/../g;($_.=shift@b)^print/^(.)\1|(.)\2$/s?$+:/(.)/ for@a,$/x2}
```
そもそも `@a` や `@b` に代入しているのが無駄だとようやく気付き、`while` 内で `$_` に代入させることで正規表現の左辺値を1回省略。`for my($a,$b)(<>){...}` のような書き方もできるらしいことを知ったが、その場合は `$_` に代入させることはできないようだ
```perl
while($a=<>,$_=<>){@b=/../g;print map{$_.=shift@b;/^(.)\1|(.)\2$/s?$+:/(.)/}$a=~/../g,$/x2}
```
この段階でようやくshebangを使う手法を思いついた。
```perl
#!perl -p
@b=<>=~/../g;$_=join"",map{$_.=shift@b;/^(.)\1|(.)\2$/s?$+:/(.)/}/../g,$/x2
```
が、そもそもこの正規表現での拾い方に問題があるよな…と思い またkobakenさんの回答を覗かせていただいた。
```perl
while($_=<>,$b=<>){s/(.)(.)/$_=$1.$2.substr$b,0,2,'';y!#!!>2?'#':y!`!!>2?'`':$1/eg;print}
```
なるほど、 `substr($s, 0, 2, '')` とすることで先頭2文字を取得してさらに第4引数に `''` を指定することで破壊的にその取得した2文字を消すことができるのだったか…！ `substr` が6文字もあってあまり使いたくはないけど、この方法で連続2文字を順番に取得するのは思い付かなかったなぁ。
そして何より `y!#!!` で出現回数をカウントできる、という便利な技が素晴らしい。これはとても使えそう、と思い ~~パクらせてもらう~~ アレンジして使わせてもらうことにした。
出現回数が `2回未満`・`2回ちょうど`・`3回以上` の3パターンで分岐になる…これを三項演算子とかじゃない方法でできないかな？とChatGPTに相談すると `<=>` という演算子が良いのではと。そういえばそんなのがあった！ `2` と比較することで `-1`,`0`,`-1` を返すので、配列のインデックスに使えるじゃないか！ということで最終的な提出解に。いちおう期間内ではこーのいけさんと同点首位で、僕の方が早く `-35` に辿り着いた、ようだ。
こーのいけさんはその後 さらに劇的に短くすることに成功していた。
[YAPC::Hakodate 2024 Perlbatross参戦記（ネタばれ含む）](https://zenn.dev/kounoike/articles/20241007-yapcjapan2024-perlbatross)
やはり判定方法の考慮が大事で、
- 基本的には最初の1文字(2x2の中での左上の文字)を採用できる
- `` `###`` もしくは ``#``` `` のときだけが例外
と考えればよりシンプルだった。なるほど〜。
1文字目を拾った上で、連続3文字の出現を探してマッチすれば上書き、という方法で短く書くことができたようだ。