1. 問題A – 455
1.1. コード
論理積を求める問題でした。
(defun check (a b c)
(and (/= a b) (= b c)))
(defun main ()
(princ (if (check (read) (read) (read))
"Yes"
"No")))
#-swank
(main)
; (check 4 5 5) => TCode language: Lisp (lisp)

2. 問題B – Spiral Galaxy
2.1. コード
2問目ですが 1時間ほど悩んでしまいました。
はじめは、2次元配列で図形全体を保持して、範囲をデータとして持って、そのパターンをチェックしてはハッシュテーブルにメモ化して解く方法を考えていました。
しかし、make-arrayのdisplaced-toで2次元配列の一部を取得しようにも、内部的には連続データで並んでいるようで、うまくいきませんでした。
仕方がないので、素朴に解いてみたら、制約による最大値が小さかったので、無事に解けました。
文字列から文字を2次元配列に変換し、添字アクセスでチェックします。
(defun make-vec2d (H W lines)
(let* ((vec2d (make-array (list (1+ H) (1+ W))
:element-type 'character)))
(loop for s in lines
for i from 1
do (loop for ch across s
for j from 1
do (setf (aref vec2d i j) ch))
finally (return vec2d))))
(defun point-symmetry-p (vec2d h1 h2 w1 w2)
(loop for i from h1 to h2
always (loop for j from w1 to w2
always (eql (aref vec2d i j)
(aref vec2d
(- h2 (- i h1))
(- w2 (- j w1)))))))
(defun solve (H W vec2d)
(loop for h1 from 1 to H
sum (loop for h2 from h1 to H
sum (loop for w1 from 1 to W
sum (loop for w2 from w1 to W
count (point-symmetry-p
vec2d h1 h2 w1 w2))))))
(defun main ()
(let* ((H (read))
(W (read))
(lines (loop repeat H collect (read-line)))
(vec2d (make-vec2d H W lines)))
(princ (solve H W vec2d))))
#-swank(main)Code language: Lisp (lisp)
ループには重複があり、半分で済みそうなのですが、シンプルに解けたので良しとします。

3. 問題C – Vanish
3.1. コード(正解4)
まずは、配列で出現する数ごとに合計を取って、多い順に消すことにしました。
(defun x-sums (lst)
(let* ((max (reduce #'max lst))
(vec (make-array (1+ max)
:element-type 'fixnum
:initial-element 0)))
(loop for n in lst
do (incf (aref vec n) n)
finally (return vec))))
(defun solve (K lst)
(let* ((sums (sort (x-sums lst) #'>)))
(loop for i from 0 below K
do (setf (aref sums i) 0)
finally (return (reduce #'+ sums)))))
(defun main ()
(let* ((N (read))
(K (read))
(lst (loop repeat N collect (read))))
(princ (solve K lst))))
#-swank
(main)
Code language: Lisp (lisp)
結果は、正解4、実行時エラー 27。

3.2. 配列からハッシュテーブルへ(正解25)
配列だと数値の最大値が大きいときにメモリ不足になってしまうので、ハッシュテーブルで計測し、最後に値のリストに変換しました。
また、sumsが配列ではなくリストになったので、添字アクセスではなく、subseqで部分リストを求めて合計しました。
(defun x-sums/hash (lst)
(let* ((table (make-hash-table)))
(loop for n in lst
do (incf (gethash n table 0) n))
(loop for v being each hash-value of table
collect v) ))
(defun solve (K lst)
(let* ((sums (sort (x-sums/hash lst) #'>)))
(loop for s in (subseq sums k)
sum s)))
(defun main ()
(let* ((N (read))
(K (read))
(lst (loop repeat N collect (read))))
(princ (solve K lst))))
#-swank
(main)Code language: Lisp (lisp)
Common Lispのハッシュテーブルのloopキーワードは、being each hash-value of はさすがに冗長に見えます。
時代的なものなので仕方ないですが、せめて from-hash-value-of ぐらいのひと単語なら覚えやすかったのですが。
collectだけならよいのですが、処理を入れるなら (maphash ラムダ式 テーブル) の方が見通しがよさそうです。

ただし、正解 25で、実行時エラー 6。
まだ、少しエラーです。
3.3. subseqの範囲外アクセスを修正(正解31)
よく確認すると、 subseqの使い方に難があります。
lengthより大きな数値を与えると、nil ではなくエラーになります。
そこで、K >= length のときは 0 を返すようにしました。
(defun solve (K lst)
(let* ((sums (sort (x-sums/hash lst) #'>)))
(cond ((>= K (length sums)) 0)
(t (reduce #'+ sums :start K)))))Code language: Lisp (lisp)
部分リストの合計は、reduceに:startを与えて計算しました。

時間切れで得点には至りませんでしたが、正解になりました。
完成コードは、
(defun x-sums/hash (lst)
(let* ((table (make-hash-table)))
(loop for n in lst
do (incf (gethash n table 0) n))
(loop for v being each hash-value of table
collect v) ))
(defun solve (K lst)
(let* ((sums (sort (x-sums/hash lst) #'>)))
(cond ((>= K (length sums)) 0)
(t (reduce #'+ sums :start K)))))
(defun main ()
(let* ((N (read))
(K (read))
(lst (loop repeat N collect (read))))
(princ (solve K lst))))
#-swank
(main)
Code language: Lisp (lisp)