かきろく

先日出題された http://golf.shinh.org/p.rb?Peano+arithmetic が良問だったので、ブログのリハビリがてらに参戦記を書いてみる。

問題はリンク先参照。

足し算は余分な文字を消すだけなので、掛け算をどうするか考える。x * yのとき、xの一文字ずつに繰り返しマッチしてyの全体を継ぎ足していけば掛け算になる。ただし、継ぎ足した分ではない元々のyは余分なので、消さなくてはならない。また、sedの正規表現には先読みが無いので、グローバルマッチではなくループで書く必要がある。t コマンドを使えば、指定したラベルに s コマンドでのマッチがあったかどうかで条件ジャンプできる。最後に、余分な文字をまとめて消す。

:
s/S\(0 \* \)\(S*\)/\1\2 \2/
t
s/[0*] S*\|\W//g

(48B)

昔のGNU sedでは、このように空のラベル名が許されていたが、バグとして最新版では修正されてしまった。あなごる環境を手元に用意する場合は、GNU sed 4.2を入れよう。

sedのサブマッチは高価なので、一つのサブマッチでいく方向で試行錯誤した結果、

:
s/S\(0 \* S*\)/\1+ \1/
t
s/* S*//
s/. //g

(43B)

や

:
s/S0 \*\( S*\)/0 *\1+\1/
t
s/* S*\|. //g

(42B)

等に辿り着き、力尽きた。

対して、tailsさんの解は

/*/y/S/s/
:
s/s\(0 . s*\)\|. s*/\1\U\1/
t

(41B)

掛け算の場合に事前に小文字に置き換えておき、小文字に対して掛け算を実行し、結果の側だけを \U で大文字化する。さらに、マッチしなかったサブマッチは空文字列扱いなのとの合わせ技で、掛け算と余分な文字の消去を一つのコマンドに纏めている。美しい。

Scheme

あなごるのScheme処理系はGaucheである。Gaucheゴルフでは、しばしば regexp-replace-all 系が強い。そこで、sed解の応用で先読みマッチを使って、

(while(print(regexp-replace-all*(read-line)#/S(?=.*\* (S*))/"\\1"#/\* S*|. /""))(flush))

(88B)

とした。(ゴルフ場のGaucheは0.9.3でエラー終了時にstdoutをflushしないので、(flush) する必要がある。read-line の結果を束縛する必要がない場合は port-map より短い。)

readしてevalするアプローチも試したが、そこまで縮まなかった。

(while(let*('string-size,#0=(-'#"~(read)"1)`(read)(r #0#))(format #t"~v,'Sd0
"((eval .`0).,r)""))(flush))

(105B)

Nibbles

どうすれば短くなりそうかずっと考えていてなかなか思い付けなかったが、sedでの戦いを経て最終日に気付いた。入力に応じて積か和をやると考えるからだるいのであって、和の積を取ればいいのだと。

まず、 "*" で分割して項の列にする。各項の 'S' を数えて(isAlphaを数えればOK)、和とする。productをとって、replicateして、0を継ぎ足せば終わり。Scheme風の擬似コードも併記しておく。(擬似コードはmapの引数順がNibblesの逆になっているので注意)

(replicate
 (product
  (map (lambda (term)
         (length
          (filter char-class:alpha? term)))
       (split first-line "*")))
 "S")
0

^`*.%@"*",|$\$a"S"0

(10B)

Nibblesにはnibble(=half byte)単位で書く本来の姿のbinary formと人間が読み書きするためのliterate formがあり、上記コードはliterate formのもの、長さはbinary formのものである。

トップレベルに複数式を書くと、型に応じて演算子が挿入される(Implicit Ops)。最初の式の型が文字列の場合、挿入されるのはappend。appendはcoersionしてくれるようなので、後ろの引数は数値の0でいい。数値の0は2 nibble、文字列では3 nibble、文字でも3 nibble。

また、first-lineだけを使っている場合等は自動で行単位のmapにしてくれる(Auto Map)。そして、評価結果を出力する方式なので、出力のためのコードも必要ない。いい言語だ。

(追記と微修正 2023-12-19) tailsさんによって激縮みしていた。

%@"*" |$\$a.$_$

(7B)

Scheme風擬似コードにすると、

(split first-line "*")
(lambda (term)
  (filter char-class:alpha? term))
(lambda (r ss)
  (map (lambda (r1)
         ss)
       r))
first-int

トップレベルに式が続いているので、Implicit Opsでそれぞれmap、foldl1、appendが挿入される。挿入後のコードはこんな感じ。

(append (foldl1 (lambda (r ss)
                  (map (lambda (r1)
                         ss)
                       r))
                (map (lambda (term)
                       (filter char-class:alpha? term))
                     (split first-line "*")))
        first-int)

前述のsed解や後述の俺のHaskell解と似たようなアプローチで、数値を経由するのは甘え、Sの列をmapでSの列にすれば掛け算で、それもimplicitなfoldl1でできると。確かに。foldl1の結果の型が [Char] なのに第二引数の型が [[Char]] で型が合ってないように見えるけど、coercionされるっぽい(+(concat)を挿入しても動いた)。あとfirst-intで0が出てくるのも気付かなかった。すごい。

(追記ここまで)

Haskell

Nibblesと同じ方針で考えたが、split相当がなくてなかなか縮まなかった。当初のコード:

main=interact$(>>=f.foldr g[[]]).lines
g '*'r=[]:r
g c(t:r)=(c:t):r
f l=([1..product$map(\s->sum[1|'S'<-s])l]>>"S")++"0\n"

(122B)

行単位の処理だが、改行の追加が安くできるので m@main=getLine>>=putStrLn...>>m 形式より interact と >>= を使った形式の方が短い。教科書にもそう書いてある。length$filter ... より sum[1| ... ] とか、 replicate n x より [1..n]>>[x] とか。

splitを span で代用。'*'がなかった場合は "S" を補って1との積として

m@main=getLine>>=putStr.f.span(/='*')>>m
f(p,"")=f(p,"S")
f(p,q)=([1..g p*g q]>>"S")++"0\n"
g p=sum[1|'S'<-p]

(109B)

数値に直して計算するより、sedでの掛け算みたいなのをリスト内包表記でやった方が短いんじゃないか？

main=interact$(>>=f.span(/='*')).lines
f(p,"")=f(p,"S")
f(p,q)=['S'|'S'<-p,'S'<-q]++"0\n"

(89B)

パターンマッチで場合分けしてるのが高いので、無理矢理まとめると

main=interact$(>>=f.span(/='*')).lines
f(p,q)=['S'|'S'<-p,'S'<-max" S"q]++"0\n"

(79B)

でここまで。時間がなかった割に自分なりにはかなり縮められたが、Haskell golfの強い人が来たらもっと縮みそうな気もする。

Befunge

Sの数は数えるとして、足し算と掛け算はどうするか。Befungeでは丁度 + が足し算、* が掛け算の命令なので、p 命令のソースコード書き換えを利用する。Ruby等のeval解法と似ている。

<+1_v#%2~
^   >~$~52p~41p0
   v>
v#:<-1,"S"_
<vp14">",%+1:~.
v<

(63B)

1行目で1文字ずつ読みながらSを数えている。Sと0の判別は2の剰余でよい。左側の項を読み終えると、2行目に移動する。空白を読み飛ばしつつ、演算子記号を読み込んで、後で実行する場所に書き込んでおく(~52p)。右側の項を読むのに1行目の処理を使い回したいので、その出口から2行目の処理に入るための > を読み込んだ空白で上書きする(~41p)。これで右側の項を読み込んだ後は3行目に移り、書き込んでいた演算子が実行される。4行目でその数だけSを出力、5行目で書き換えた所を元に戻す等の後処理。終了判定にはBefungeは0で剰余を取ると終了するのを利用し、EOF(-1)が入ってくるであろうタイミング(この問題は最後の改行が無いため、改行を読む部分)で 1+% すると終了できる(%+1 の部分、右から左へ実行)。

ゴルフ場のBefunge処理系は . の数値出力の後にスペースを出力しないようにカスタマイズされているので、それも利用する。Befunge-98の方にはこのようなカスタマイズはされていないので注意。

最初はこのように演算子の書き込みと分岐のための書き込みを別々にしていたが、同じ場所に書き込んでしまえば一度にできることに気付く。あとはギュッと詰め込むと

<|%2~
^>~~11p~-
v>">"11p
<-1,"S"_v#:
v,%+1:~.<
v>1+

(51B)

Befungeのこの解法、ゴルフでは珍しく p をコード書き換えに使っているBefungeらしいコードなので気に入っていて、あまり他の解法を試してない。多言語で縮めたいのもあってサクっと切り上げた。(時系列的には先の方にやった)

Befunge-98

大筋はBefungeと同じ。Befunge-98はライブラリ(Fingerprint)がいろいろ使えるため、問題によっては解法が大きく異なってくるが、今回はそういうのは無さそうと判断。

<1wS'~+
v >~~21p~-
 v>'>21p
:<-1,S'_v#
v,~@#,0'<

(48B)

Befunge-98はBefunge-93から多数の変更・追加が入っているが、ゴルフ的に面白いのは w 命令。1命令で大小比較と三分岐を行う。これがあるので、分岐が絡むだけでBefunge-98ゴルフはBefungeからの自明な移植では済まないことが多い。

また、ゼロ除算の結果が0と定義されて終了技が使えなくなったのは注意。ただ、文字入力の ~ のEOFでの挙動も変更されて、-1 を返すのではなくreflectするようになったので、EOFでの分岐はやりやすくなった。