はじめに

commonlispのloopマクロの達人になるべくAtcoder10選をloopマクロで解いてみました。かなり変態的な書き方になっているので普通に解くときは参照しないほうがいいと思います。

ルール

必ずloopマクロを用いる
一番外側の関数はloopマクロまたはprinc関数
commonlispの制御、宣言関数を使わない(if、defun、letなど)

Product ABC 086 A

1.lisp

(loop :if (evenp (* (read) (read))) :do(princ "Even") :else :do(princ "Odd"))

https://atcoder.jp/contests/abc086/submissions/9796489
Atcoderの判定システムは必要な出力が行われれば終了される(?)ため無限ループでも問題ないようです。
if節で判定され、Tであった場合には次のdo節、NILであった場合にはelse節の処理が行われます。

2 Placing Marbles ABC 081 A

2.lisp

(loop :for k :across (read-line) :count (char= #\1 k) :into a :finally (princ a))

https://atcoder.jp/contests/abc081/submissions/10323731
across節はベクタの要素をfor節のシンボルに束縛しながらループします。count節でcount節がTになる回数をカウントし、値を返します。count、minimize、maximizeなどの節はinto節を用いることでinto節の後ろのシンボルに束縛することができます。これをfinally節を用いて最後に出力します。

3 Shift Only ABC 081 B

3.lisp

(princ (loop :for k :in (loop :repeat (read) :collect (read))
             :minimize (loop :for j :from 1
                             :unless (= 0 (mod k (expt 2 j)))
                               :return (1- j))))

https://atcoder.jp/contests/abc081/submissions/10571207
minimize節はループ内で最小のものを返します。minimize節のloopマクロでは2で割れる回数を計数します。unless節はif節の逆です。

4 Coins ABC 087 B

4.lisp

(princ (loop :for x :from 0 :upto (read) :with b := (read) :with c := (read)
             :with k := (read)
             :sum(loop :for y :from 0 :upto b
                       :sum(loop :for z :from 0 :upto c
                                 :count(= k (+ (* x 500) (* y 100) (* z 50)))))))

まずwith節でa、bを束縛します。with節は最初のループで束縛され、以降は更新されません。
あとは、3重ループで合計します。一番内側をcount節、残りをsum節で覆う書き方は普通に書くときもよく使う構文です。

##5 Some Sums ABC 083 B

5.lisp

(princ (loop :for k :from 1 :upto (read) :with a := (read) :with b := (read)
             :for x := (loop :for l :from (1+ (floor (log k 10))) :downto 1
                             :for j := k :then (mod j (expt 10 l))
                             :sum (floor j (expt 10 (1- l))))
             :if (<= a x b) :sum k))

https://atcoder.jp/contests/abc083/submissions/10580815
loopの闇が濃くなってきました...
for節が複数ある場合は毎ループで全てのfor節を更新しながらループが処理されます。桁数の合計をxに、1~nをkに束縛し、条件に当てはまるものを全て足します。for節の次節が=節だった場合、毎回=節の内容に束縛されます。
xに束縛されるloopは、桁数をlに、10^lのあまりをjに束縛します。then節がある場合、=節は1回目のループで、then節はそれ以降のループで束縛され、then節は前ループの変数の束縛より更新されます。これをjを10^l-1で割った商を足して桁数の合計にします。

6 Card Game for Two ABC 088 B

6.lisp

(princ (loop :for k :in (sort (loop :repeat (read) :collect (read)) #'>)
             :for x := 1 :then (* -1 x)
             :sum (* k x)))

https://atcoder.jp/contests/abc088/submissions/10582077
ソートしてそれぞれに1,-1を順番に掛けながら合計します。

7 Kagami Mochi ABC 085 B

7.lisp

(princ (loop :for k :in (loop :repeat (read) :collect (read))
             :with x := '()
             :if (loop :for j :in x :never (= k j)) :count (push k x)))

https://atcoder.jp/contests/abc085/submissions/10583355
with節でスタックを用意してif節でスタックに含まれない場合をカウントしてスタックに入れます。push関数はpushした結果が帰るので必ずtになります。

8 Otoshidama ABC 085 C

8.lisp

(loop :named n-loop :with n := (read)
      :do (loop :for j :upto n :with y := (read)
                :do (loop :for k :upto (- n j)
                          :if (= y (+ (* 10000 j) (* 5000 k) (* (- n j k) 1000)))
                            :do (format t "~A ~A ~A" j k (- n j k))
                                :and
                            :do (return-from n-loop))
                :finally (princ "-1 -1 -1")))

https://atcoder.jp/contests/abc085/submissions/10587030
return-fromはloop内部で使うことによってnamed節によって名付けられたloopから脱出することができます。これによって脱出した場合finally節は実行されなくなります。
if節は後ろに1つの節しか取らないため並列する場合はand節で繋げます。
n-loopはnの束縛と脱出のためにあります。他は普通の2重ループです。

9 Daydream ABC 049 C

8.lisp

(loop :with n := (read-line)
      :for s :upto (length n)
      :for k :on (concatenate 'list n "0000000")
      :for dp :on (cons 1 (loop :repeat (+ (length n) 6) :collect 0))
      :with j := (loop :for x :in '("dream" "dreamer" "erase" "eraser")
                       :collect (concatenate 'list x))
      :if (char= #\0 (car k))
        :if (= 1 (car dp)) :do (princ "YES")
          :else :do (princ "NO")
      :if (= 1 (car dp))
        :if (equal (subseq k 0 5) (car j)) :do (setf (elt dp 5) 1) :end :and
        :if (equal (subseq k 0 7) (cadr j)) :do (setf (elt dp 7) 1) :end :and
        :if (equal (subseq k 0 5) (caddr j)) :do (setf (elt dp 5) 1) :end :and
        :if (equal (subseq k 0 6) (cadddr j)) :do (setf (elt dp 6) 1))

https://atcoder.jp/contests/abc049/submissions/10767240
動的計画法で解くのが簡単なので動的計画法で解きます。
まず、ループ回数が制限されるfor節が複数ある場合、ループ回数は一番小さいfor節のループ回数になります。なので、sが終了した場合にループが打ち切られます。
on節はlistをとり、maplist関数のようにcdrで更新します。
kはlistにした入力文字列に後ろ側に0をパディングしたものを束縛します。パディングしないとsubseq関数で切れません。
if節はend節を挟むことによって抜けることができます。省略が可能なので多重if節が必要な場合に用います。~~もっとも普通は多重if節なんか使いませんが。~~
最終ループでは必ず0が先頭にくるのでこれを検知して最終ループであることを判断してYESかNOを出力します。ifが使えるならfinally節で出力するといいでしょう。

10 Traveling ABC 086 C

10.lisp

(loop :for (an xn yn) :in (loop :repeat (read) :collect (list (read) (read) (read)))
      :for a := an :then (- an a)
      :for x := xn :then (abs (- xn x))
      :for y := yn :then (abs (- yn y))
      :if (not (and (<= (+ x y) a) (= (mod (+ x y) 2) (mod a 2))))
        :return (princ "No")
      :finally (princ "Yes"))

https://atcoder.jp/contests/abc086/submissions/10767661
まず入力を束縛します。an、xn、ynはfor節にlistで書くことによってそれぞれに代入されます。あとは条件に満たない場合return節、それ以外はfinally節を評価します。
(commonlispではtに値が束縛できないことに注意してください。普段のコンテストでも稀にハマります。)

感想

loopマクロがミニ言語と言われる所以に触れられた気がします。またこのチャレンジによってif節やfor節を重ねた場合などに関する知見が得られました。確かに関数型っぽくない記法になりがちではありますがこれだけのマクロが生み出せるのはcommonlispの柔軟な構文からでしょう。
効率の悪いはずのアルゴリズムでもなぜか実行時間が短縮されているケースがあるので実行時間がギリギリの場合はloopマクロを多用すると多少高速化できるかもしれません。