1. 問題概要
長さ の整数列 が与えられる。
各要素は 1 以上 以下である。この列に対して、次の操作を非常に多く、具体的には 回行う。
- のうち、列 における出現回数が最小の値を選ぶ。
- そのような値が複数あるなら、最も小さい値を選ぶ。
- 選ばれた値を とし、 の末尾に追加する。
その後、 個のクエリが与えられる。
E – A += v
各クエリでは が与えられるので、操作を 回行ったあとの を求めよ。
入力
N M
A_1 A_2 ... A_N
Q
X_1
X_2
...
X_Q
出力は、 行出力し、i 行目には、 番目のクエリに対する答えとして を出力せよ。
制約条件
- 入力はすべて整数
2. まずは効率性を度外視で(2)
問題条件をそのままコードにして、プロトタイプを作ります。
;; 0, 1 .. M (M+1)
(defun frequency-vector (lst M)
(let ((v (make-array (1+ M) :initial-element 0)))
(loop for a_n in lst
do (incf (aref v a_n))
finally (return v))))
(defun fewest-in (lst M)
(let* ((v (frequency-vector lst M))
(min (loop for n from 1 to M
minimize (aref v n))))
(loop for n from 1 to M
until (= (aref v n) min)
finally (return n))))
;; TODO: seems to be very innefficient.
(defun push-the-fewest (lst M)
(nconc lst (list (fewest-in lst M))))
(defun prepare-list-by (lst M query_max)
(loop while (<= (length lst) query_max)
do (push-the-fewest lst M)
finally (return lst)))
(defun answers (A_n M X_n)
(loop for x in X_n
collect (nth (1- x)
(prepare-list-by A_n M (1- x)))))
(defun main ()
(let* ((N (read))
(M (read))
(A_n (loop for i from 1 to N
collect (read)))
(Q (read))
(X_n (loop for i from 1 to Q
collect (read))))
(loop for a in (answers A_n M X_n)
do (print a))))
#-swank(main)
Code language: Lisp (lisp)
数を末尾に追加するのは、とりあえずクエリで必要な部分を必要なタイミングで用意するようにしましたが、「もっとも少ない数(fewest)」を見つけるだけで多重ループを回しているので、実行時間がかなり遅そうです。
それでもサンプルの入出力を元に、以下のようなテストを実行して、クリアしました。
#+swank(progn
(ql:quickload :parachute)
(parachute:define-test answers-test
(parachute:is equal '(1 1 2 3 2 3 1 2)
(answers (list 1 1 2) 3 (list 1 2 3 4 5 6 7 8)))
(parachute:is equal '(30 2 18 21 7 9 29 19 27 3)
(answers (list 20 26 3 14 4 4 9) 30
(list 31 9 21 23 97 99 30 79 57 3)))
)
(parachute:test 'answers-test))
Code language: Lisp (lisp)

提出してみると正解2。
サンプルの例はクリアしましたが、それ以外はやっぱり時間切れです。

2.1. パターンを分析する(4)
ただ、この問題、真面目に数列をすべて追加する必要がなさそうなことに気づきます。
たとえば、L = (3 2 2 4 3 3 1 2 5) M = 5 に対して30個目までリストを追加して観察してみます。
* (defparameter L '(3 2 2 4 3 3 1 2 5))
L
* L
(3 2 2 4 3 3 1 2 5)
* (frequency-vector L 5)
#(0 1 3 3 1 1)
* (prepare-list-by L 5 30)
(3 2 2 4 3 3 1 2 5 1 4 5 1 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1)
* (frequency-vector L 5)
#(0 7 6 6 6 6)
すると、はじめは各数字の個数がバラバラなので入る数字もまちまちです。
しかし、少ない数字を補充していくにつれて個数がそろっていき、1〜5が繰り返し現れるようになります。
(3 2 2 4 3 3 1 2 5) ; #(0 1 3 3 1 1)
(3 2 2 4 3 3 1 2 5 ; Phase 1. 初期配置 9
1 4 5 ; Phase 2. 少ない数字を補充する 3 (f <= 2
1 4 5 ; 3 (f <= 3
1 2 3 4 5 ; Phase 3. Mずつの繰り返し 5
1 2 3 4 5
1 2 3 4 5
1) Code language: Lisp (lisp)
Phase 1は、1〜Nまでの区間です。
Phase 2は、初期状態でのもっとも多い個数 * M 個になるまでです(この例は、15個まで)。
Phase 3は、どんなにクエリが大きな数字でも、(mod Q M+1)で求まります。
ということは、まずは Phase 2までは真面目に数列を作ってみて、Phase 3だけは剰余で計算することにしました。
(defun answer-to-lazy1 (N M A_n x)
(let* ((max-freq (reduce
#'max
(frequency-vector (subseq A_n 0 N) M))))
(cond ((>= x (* M max-freq)) (1+ (mod (1- x) M)))
(t (answer-to M A_n x)))))
Code language: Lisp (lisp)
A_nには破壊的に追加しているので、元の数列でのもっとも多い数の個数を得るのに、初期の個数 N で部分リストを取っています。
毎回、固定値のmax-freqを計算し直しているは無駄ですが、とりあえずは引数の少なく、局所変数だけで設計しています。
結果は、正解 4。
2問増えました。
3. n以下をまとめて(4)
phase2を観察していたら、「n個以下」という数列をまとめて追加していくことがわかりました。
ちょうど、でこぼこした容器に水を入れていくようなイメージです。
それで考えたのが、まとめて回答リストを作成する方法です。
(defun prepare-list-together (M A_n query_max)
(let* ((freqs (frequency-vector A_n M))
(bottom (reduce #'min freqs))
(top (reduce #'max freqs)))
(nconc A_n (loop for level from bottom to top
while (<= (length A_n) query_max)
append (loop for i from 1 to M
when (<= (aref freqs i) level)
collect i)))))Code language: Lisp (lisp)
頻度の最低水準を一つずつ引き上げていって、それ以下の出現数の数字を A_n にまとめて追加していくやり方です。
結果は、正解4。時間切れ 30。
まだまだ効率化が足りないようです。

;; 0, 1 .. M (M+1)
(defun frequency-vector (lst M)
(let ((v (make-array (1+ M) :initial-element 0)))
(loop for a_n in lst
do (incf (aref v a_n))
finally (return v))))
(defun answers (N M A_n X_n)
(loop for x in X_n
collect (answer-to-lazy2 N M A_n x)))
(defun prepare-list-together (M A_n query_max)
(let* ((freqs (frequency-vector A_n M))
(bottom (reduce #'min freqs))
(top (reduce #'max freqs)))
(nconc A_n (loop for level from bottom to top
while (<= (length A_n) query_max)
append (loop for i from 1 to M
when (<= (aref freqs i) level)
collect i)))))
(defun answer-to-together (M A_n x)
(nth (1- x) (prepare-list-together M A_n (1- x))))
(defun answer-to-lazy2 (N M A_n x)
(let* ((max-freq (reduce
#'max
(frequency-vector (subseq A_n 0 N) M))))
(cond ((>= x (* M max-freq)) (1+ (mod (1- x) M)))
(t (answer-to-together M A_n x)))))
(defun main ()
(let* ((N (read))
(M (read))
(A_n (loop for i from 1 to N
collect (read)))
(Q (read))
(X_n (loop for i from 1 to Q
collect (read))))
(loop for a in (answers N M A_n X_n)
do (print a))))
#-swank
(main)
Code language: Lisp (lisp)
3.1. メモリ割り当ての効率化(6)
ベクタのメモリ割り当てを効率化してみました。
(defun frequencies-from-vector (VA_n M)
(declare (type fixnum M))
(let* ((v2 (make-array 500001
:element-type 'fixnum
:fill-pointer 0
:initial-element 0)))
(setf (fill-pointer v2) (1+ M))
(fill v2 0)
(loop for a across VA_n
do (incf (aref v2 a))
finally (return v2))))Code language: Lisp (lisp)
まずは、数字の出現頻度を記録する配列は、出来上がったらすぐに使って書き換えません。
そこで、関数内で一度メモリを確保して使い回すことにしました。
また、数列 A_n の末尾への追加も連結リストだと遅いので、最初に可変長ベクタに変換して、vector-push-extend で追加するようにしました。
(defun prepare-list-together (M VA_n query_max)
(let* ((freqs (frequencies-from-vector VA_n M))
(bottom (bottom-freq freqs M))
(top (reduce #'max freqs)))
(loop for level from bottom to top
while (<= (length VA_n) query_max)
do (loop for i from 1 to M
when (<= (aref freqs i) level)
do (vector-push-extend i VA_n))
finally (return VA_n))))Code language: Lisp (lisp)
できたコードがこちら。
(defun frequencies-from-vector (VA_n M)
(declare (type fixnum M))
(let* ((v2 (make-array 500001
:element-type 'fixnum
:fill-pointer 0
:initial-element 0)))
(setf (fill-pointer v2) (1+ M))
(fill v2 0)
(loop for a across VA_n
do (incf (aref v2 a))
finally (return v2))))
(defun bottom-freq (freqs M)
(loop for i from 1 to M
minimize (aref freqs i)))
(defun prepare-list-together (M VA_n query_max)
(let* ((freqs (frequencies-from-vector VA_n M))
(bottom (bottom-freq freqs M))
(top (reduce #'max freqs)))
(loop for level from bottom to top
while (<= (length VA_n) query_max)
do (loop for i from 1 to M
when (<= (aref freqs i) level)
do (vector-push-extend i VA_n))
finally (return VA_n))))
(defun answer-to-together (M VA_n x)
(aref (prepare-list-together M VA_n (1- x)) (1- x)))
(defun answer-to-lazy2 (M VA_n x max-freq)
(cond
((>= x (* M max-freq)) (1+ (mod (1- x) M)))
(t (answer-to-together M VA_n x))))
(defun answers (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(max-freq (reduce #'max (frequencies-from-vector VA_n M))) )
(loop for x in X_n
collect (answer-to-lazy2 M VA_n x max-freq))))
(defun main ()
(let* ((N (read))
(M (read))
(A_n (loop for i from 1 to N
collect (read)))
(Q (read))
(X_n (loop for i from 1 to Q
collect (read))))
(loop for a in (answers N M A_n X_n)
do (print a))))
#-swank
(main)
Code language: Lisp (lisp)
すると、正解6で、時間切れ27。
ちょっと増えましたが、実行時エラー1 が気になります。

4. ループしながら追加する(24)
次に思いついた方法は、はじめにA_nの出現数を調査したら、それを元に順繰りに数字を追加する方法です。
(defun answers-by-cycle (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(freqs (frequencies-from-vector VA_n M))
(bottom (bottom-freq freqs M))
(top (reduce #'max freqs))
(phase3-start (* M top)))
(loop while (< (length VA_n) phase3-start)
do (loop for level from bottom to top
do (loop for n from 1 to M
when (<= (aref freqs n) level)
do (vector-push-extend n VA_n))))
(loop for x in X_n
collect (cond
((>= x phase3-start) (answer-by-pattern x M))
(t (aref VA_n (1- x)))))))Code language: Lisp (lisp)
大局的に見ると、A_nには 1〜Mまでの数字を循環しながら追加しています。
イメージ的には、かき氷器をぐるぐる回しながら、かき氷を入れている感じです。
ただし、その数字の初期の出現数が、その時点での閾値より多ければ、追加されません。
そして、一巡するごとに閾値が上がっていきます。
このような調子なので、最終的には閾値が大きくなって、1〜Mが循環して出現するようになります。
(defun frequencies-from-vector (VA_n M)
(declare (type fixnum M))
(let* ((v2 (make-array 500001
:element-type 'fixnum
:fill-pointer 0
:initial-element 0)))
(setf (fill-pointer v2) (1+ M))
(fill v2 0)
(loop for a across VA_n
do (incf (aref v2 a))
finally (return v2))))
(defun answer-by-pattern (x M)
(1+ (mod (1- x) M)))
(defun bottom-freq (freqs M)
(loop for i from 1 to M
minimize (aref freqs i)))
(defun answers-by-cycle (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(freqs (frequencies-from-vector VA_n M))
(bottom (bottom-freq freqs M))
(top (reduce #'max freqs))
(phase3-start (* M top)))
(loop while (< (length VA_n) phase3-start)
do (loop for level from bottom to top
do (loop for n from 1 to M
when (<= (aref freqs n) level)
do (vector-push-extend n VA_n))))
(loop for x in X_n
collect (cond
((>= x phase3-start) (answer-by-pattern x M))
(t (aref VA_n (1- x)))))))
(defun main ()
(let* ((N (read))
(M (read))
(A_n (loop for i from 1 to N
collect (read)))
(Q (read))
(X_n (loop for i from 1 to Q
collect (read))))
(loop for a in (answers-by-cycle N M A_n X_n)
do (print a))))
#-swank
(main)
Code language: Lisp (lisp)
この方法で解いたところ、正解24、実行時エラー 10になりました。


エラー時の結果をみると1000msを超えたあたりで、メモリの使用量が約930MiBに到達しています。
問題のメモリ制限が 1024 MiB なので、足りなくなってしまったようです。
今の方法で VA_n に追加しているので、最悪のケースで N * M 個(25 * 10^10) 確保する必要があります。
fixnumは64bit(8バイト)なので、最悪値で 2 TBになります……。
Xi も最大値は 10^18 なので、これも上限には使えません。
4.1. 答えだけを表に書く(24)
数列を用意してから最後のクエリの番号で参照するのではなく、循環中にクエリに対応する答えをキープしておいて、最後に正しい順で提出するのがよいのかもしれません。
回答には不要な数列をキープし過ぎています。
まずは、クエリをループ内で順番にチェックできるように昇順に並べます。
;; to check query in ascending loop.
(defun queries-ascending-above-below (X_n low high)
(let* ((unique (remove-duplicates (sort (copy-list X_n) #'<))))
#+swank(assert (numberp low))
#+swank(assert (numberp high))
(remove-if (lambda (x) (or (<= x low) (<= high x))) unique) ))
Code language: Lisp (lisp)
あとは、indexをNからphase3まで一個ずつ進めながら A_n のあとの部分の答えをハッシュテーブル ans-table に記録していきます。
(defun answers-for-reserved (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(freqs (frequencies-from-vector VA_n M))
(bottom (bottom-freq freqs M))
(top (reduce #'max freqs))
(phase3-start (* M top))
(queries-asc
(queries-ascending-above-below X_n N phase3-start))
(ans-table (make-hash-table))
(index (length VA_n)))
(loop while (< index phase3-start)
do (loop for level from bottom to top
do (loop for n from 1 to M
when (<= (aref freqs n) level)
do (progn
(incf index)
(if (and queries-asc
(= index (car queries-asc)))
(progn
(setf (gethash index ans-table) n)
(setf queries-asc (cdr queries-asc)))
nil)
))))
(loop for x in X_n
collect (cond
((>= x phase3-start) (answer-by-pattern x M))
((<= x N) (aref VA_n (1- x)))
(t (gethash x ans-table))))))Code language: Lisp (lisp)
この結果、正解 24。
時間切れ 10。


メモリ制限はクリアしましたが、同じ問題で実行時間超過になっています。
つまり、ここまでのロジックでは phase 2 が大きな最悪のパターンにうまく対応できないようです。
5. ループを全部回す必要がある?(8)
そこで、考えたのが閾値を一気に上げる方法です。
3つ目のループで 1 から M まで繰り返す必要があるのは、クエリがある場合だけです。
そうでなければ、levelを一足飛びに次に進めても問題ないはずです。
ただ、levelを1上げるときに、indexがいくつ上がるのか、それを考える必要があります。
(loop while (< index phase3-start)
do (loop for level from bottom to top
do (loop for n from 1 to M
when (<= (aref freqs n) level) ...
do (progn
(incf index)
(if (and queries-asc
(= index (car queries-asc)))Code language: Lisp (lisp)
それぞれのlevelにいくつ数字があり、何番〜何番までなのかは、頻度ベクタを見れば計算できます。
はじめに計算しておいて、参照してみようと思います。
そう考えると、ループそのものもいらなくなってきます。
まず、レベル構造として開始番号を記録します。
クエリからどの level に属し、その中で何番目が必要かが分かれば、頻度ベクタから そのlevelの数列を取り出し、その何番目かを返せばよいことになります。
query -> level
level -> start-index, sub-sequence
answer <- sub-sequence[query - start-index]Code language: CSS (css)
そして、この計算が必要なのはqueryがN 〜 phase 3 開始点 までの間です。
;; level-starts is vector
;; count minus 1 because freqs[0] is addtional 0
(defun freqs->level-starts (freqs)
(let* ((bottom (bottom-freq freqs))
(top (top-freq freqs))
(vec (make-array (1+ top)
:element-type 'fixnum
:initial-element 0))
(index (reduce #'+ freqs)))
(setf (aref vec bottom) index)
(loop for level from bottom below top
do (setf index (+ index
(1- (count-if (lambda (fr) (<= fr level)) freqs))))
(setf (aref vec (1+ level)) index)
finally (return vec))))
;; level-starts is vector
;; The last one is previous level .. <
(defun query->level (query level-starts)
(loop for level below (length level-starts)
while (< (aref level-starts level) query)
maximize level))
;; The returning value is decremented because of going over one step.
(defun query->answer (query level-starts freqs M)
(let* ((level (query->level query level-starts))
(start (aref level-starts level))
(sub-index (- query start)))
(loop for n from 1 to M
with counter = 0
while (< counter sub-index)
when (<= (aref freqs n) level)
do (incf counter)
finally (return (1- n)))))
Code language: Lisp (lisp)
結果は、正解 8、時間超過 26。
後退しました。
5.1. 部分列を保持する(24)
だいぶ行き詰まって来ました。
今度は、回答を作る度に 1 〜 M のループを回って、level以下のものを順番に探す部分を効率化しました。
クエリを昇順に進むようにすれば、同じ部分列を使い回せるからです。
; (answers-by-level-asc-query N M A_n X_n)
(defun answers-by-level-asc-query (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(freqs (frequencies-from-vector VA_n M))
(top (reduce #'max freqs))
(phase3-start (* M top))
(level-starts (freqs->level-starts freqs))
(queries-asc
(queries-ascending-above-below X_n N phase3-start))
(ans-table (make-hash-table)))
(loop for q in queries-asc
with prev-level = -1
with level-subvec = #()
do (when (/= prev-level (query->level q level-starts))
(setf prev-level (query->level q level-starts))
(setf level-subvec (make-level-subvec prev-level freqs)))
(setf (gethash q ans-table)
(aref level-subvec
(- q (aref level-starts prev-level) 1))))
(loop for x in X_n
collect (cond
((>= x phase3-start) (answer-by-pattern x M))
((<= x N) (aref VA_n (1- x)))
(t (gethash x ans-table))))))Code language: Lisp (lisp)
結果は、正解24。
時間切れ10。

;; caution, this freqs[0] is addtional 0.
(defun frequencies-from-vector (VA_n M)
(declare (type fixnum M))
(let* ((v2 (make-array 500001
:element-type 'fixnum
:fill-pointer 0
:initial-element 0)))
(setf (fill-pointer v2) (1+ M))
(fill v2 0)
(loop for a across VA_n
do (incf (aref v2 a))
finally (return v2))))
(defun answer-by-pattern (x M)
(1+ (mod (1- x) M)))
;; because freqs vector starts from 1 (not 0) to M
(defun bottom-freq (freqs)
(loop for i from 1 below (length freqs)
minimize (aref freqs i)))
(defun top-freq (freqs)
(reduce #'max freqs))
;; level-starts is vector
;; count minus 1 because freqs[0] is addtional 0
(defun freqs->level-starts (freqs)
(let* ((bottom (bottom-freq freqs))
(top (top-freq freqs))
(vec (make-array (1+ top)
:element-type 'fixnum
:initial-element 0))
(index (reduce #'+ freqs)))
(setf (aref vec bottom) index)
(loop for level from bottom below top
do (setf index (+ index
(1- (count-if (lambda (fr) (<= fr level)) freqs))))
(setf (aref vec (1+ level)) index)
finally (return vec))))
;; level-starts is vector
;; The last one is previous level .. <
(defun query->level (query level-starts)
(loop for level below (length level-starts)
while (< (aref level-starts level) query)
maximize level))
;; The returning value is decremented because of going over one step.
(defun query->answer (query level-starts freqs M)
(let* ((level (query->level query level-starts))
(start (aref level-starts level))
(sub-index (- query start)))
(loop for n from 1 to M
with counter = 0
while (< counter sub-index)
when (<= (aref freqs n) level)
do (incf counter)
finally (return (1- n)))))
(defun make-level-subvec (level freqs)
(let* ((lst (loop for n from 1 below (length freqs)
when (<= (aref freqs n) level)
collect n)))
(make-array (length lst) :element-type 'fixnum :initial-contents lst)))
;; to check query in ascending loop.
(defun queries-ascending-above-below (X_n low high)
(let* ((unique (remove-duplicates (sort (copy-list X_n) #'<))))
#+swank(assert (numberp low))
#+swank(assert (numberp high))
(remove-if (lambda (x) (or (<= x low) (<= high x))) unique) ))
; (answers-by-level-asc-query N M A_n X_n)
(defun answers-by-level-asc-query (N M A_n X_n)
(let* ((VA_n (make-array N
:element-type 'fixnum
:adjustable t
:fill-pointer N
:initial-contents A_n))
(freqs (frequencies-from-vector VA_n M))
(top (reduce #'max freqs))
(phase3-start (* M top))
(level-starts (freqs->level-starts freqs))
(queries-asc
(queries-ascending-above-below X_n N phase3-start))
(ans-table (make-hash-table)))
(loop for q in queries-asc
with prev-level = -1
with level-subvec = #()
do (when (/= prev-level (query->level q level-starts))
(setf prev-level (query->level q level-starts))
(setf level-subvec (make-level-subvec prev-level freqs)))
(setf (gethash q ans-table)
(aref level-subvec
(- q (aref level-starts prev-level) 1))))
(loop for x in X_n
collect (cond
((>= x phase3-start) (answer-by-pattern x M))
((<= x N) (aref VA_n (1- x)))
(t (gethash x ans-table))))))
(defun main ()
(let* ((N (read))
(M (read))
(A_n (loop for i from 1 to N
collect (read)))
(Q (read))
(X_n (loop for i from 1 to Q
collect (read))))
(loop for a in (answers-by-level-asc-query N M A_n X_n)
do (print a))))
#-swank
(main)
Code language: Lisp (lisp)
5.2. 二分探索
うーん。
あとは、思いつく改善策としては、query->level で二分探索を使う方法です。
level-startsは、昇順に並んでいるので、high, low の中間を取りながら探すと速いです。
;; level-starts is vector
;; The last one is previous level .. <
;; O(M)
(defun query->level (query level-starts)
(loop with low = 0
with high = (1- (length level-starts))
with result = 0
while (<= low high) do
(let ((mid (ash (+ low high) -1)))
(cond
((< (aref level-starts mid) query)
(progn (setf result mid)
(setf low (1+ mid))))
(t (setf high (1- mid)))))
finally (return result)))Code language: Lisp (lisp)
今回は、query < level-start[mid] の条件で、一致する場合は含めないので result は mid が下区間にあるときだけ保持して、終了したときに取り出しています。

ただ、結果は同じく正解24、時間切れ 10。
同じ問題で詰まっています。
6. 解説を読んでもう一度作り直す(3)
どうにも解けないので、解説を読んでみました。
すると、「出現回数順に安定ソートした数列(value-ordered)を用意しておいて、その部分配列をブロックとして追加していく」という考え方に気づくことができました。
(defun answer-to-query (x M lengths A-ary value-ordered)
(multiple-value-bind (index k) (the-index-added-by x lengths)
(assert index)
(assert (<= 0 index))
(cond ((= k 0) (aref A-ary index))
((>= index M)
(nth-smallest-fixnum-range value-ordered (mod index M) M))
(t (progn
(assert (< index k))
(nth-smallest-fixnum-range value-ordered index k))))))Code language: Lisp (lisp)
この追加操作は、次の数で出現回数が変わったときに、その差の回数分のブロックを足します。
;; total number of elements covered
;; after processing the k least frequent values
(defun lengths-after-addition (N M sorted-freqs)
(let* ((vec (make-array (1+ M)
:element-type 'fixnum
:initial-element 0)))
(loop with len = N
for k from 0 to M
do (progn
(cond ((= k 0)
(setf len N))
((= k M)
(setf len most-positive-fixnum))
(t
(incf len (frequency-defference-by
k sorted-freqs)))))
(setf (aref vec k) len)
finally (return vec))))Code language: Lisp (lisp)
そのため、クエリの答えを知るには、頻度k番目の数が追加されたタイミングで、何個目のインデックスなのかを確認します。
;; x (Query 1-index) -> (index, k) 0-index of k-th addtion.
(defun the-index-added-by (x lengths)
(declare (type fixnum x))
(multiple-value-bind (val index)
(floor-in-fixnum-vector lengths (1- x))
(cond (val (values (mod (- x val 1) (1+ index))
(1+ index)))
(t (values (1- x) 0)))))Code language: Lisp (lisp)
このインデックスをkで割った余り n を元に、ブロックの n番目が答えになります。
元の数列を、頻度順に並べたり、その部分から小さい順に並べたり、何度も並べ直していて、しかも 1起算のインデックスと0起算のインデックスがあるので頭がこんがらがります。
結果は、正解 3、誤答 1、時間切れ 30。
かえって、悪くなってしまいました。

まず気づくのは、nth-smallest-fixnum-range の実装に問題があることです。
(defun nth-smallest-fixnum-range/sort (vec n r)
(let ((work (make-array r :element-type 'fixnum)))
(dotimes (i r)
(setf (aref work i) (aref vec i)))
(sort work #'<)
(aref work n)))Code language: Lisp (lisp)
毎回、先頭の r 個をコピーした配列を作って、並べ替えをしています。
コードはこちら。
(defun make-answers (N M A X)
(declare
(type fixnum N M)
(type list A X))
(let* ((sorted-query (sort (copy-list X) #'<))
(freqs (frequencies M A))
(sorted-freqs (sorted-frequencies freqs))
(values-ordered (values-in-frequency-order M freqs))
(answer-table (make-hash-table))
(lengths (lengths-after-addition N M sorted-freqs))
(A-ary (to-fixnum-array A)))
(declare (type (simple-array fixnum (*))
freqs sorted-freqs values-ordered lengths A-ary))
(loop for q in sorted-query
do (setf (gethash q answer-table)
(answer-to-query q M
lengths A-ary values-ordered)))
(loop for x in X
collect (gethash x answer-table))))
;; from 0 index
(declaim (ftype (function
(fixnum list)
(simple-array fixnum (*)))
frequencies))
(defun frequencies (M A)
(let* ((result (make-array M
:element-type 'fixnum
:initial-element 0)))
(loop for x fixnum in A
do (incf (aref result (1- x)))
finally (return result))))
(declaim (ftype (function
((simple-array fixnum (*)))
(simple-array fixnum (*)))
sorted-frequencies))
(defun sorted-frequencies (freqs)
(sort (copy-seq freqs) #'<))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
list)
value-frequency-pairs))
(defun value-frequency-pairs (M freqs)
(loop for i from 1 to M
collect (cons i (aref freqs (1- i)))))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
(simple-array fixnum (*)))
values-in-frequency-order-unit))
(defun values-in-frequency-order (M freqs)
(let* ((VFs (value-frequency-pairs M freqs))
(sorted-pairs (stable-sort VFs #'< :key #'cdr))
(val-list (loop for pair in sorted-pairs
collect (car pair))))
(declare (type list VFs sorted-pairs val-list))
(make-array (length val-list) :element-type 'fixnum
:initial-contents val-list)))
(declaim (ftype (function
((simple-array fixnum (*)) fixnum)
fixnum)
value->frequency))
(defun value->frequency (freqs val)
(assert (> val 0))
(aref freqs (1- val)))
;; total number of elements covered
;; after processing the k least frequent values
(declaim (ftype (function
(fixnum fixnum (simple-array fixnum (*)))
(simple-array fixnum (*)))
lengths-after-addition))
(defun lengths-after-addition (N M sorted-freqs)
(let* ((vec (make-array (1+ M)
:element-type 'fixnum
:initial-element 0)))
(loop with len = N
for k from 0 to M
do (progn
(cond ((= k 0)
(setf len N))
((= k M)
(setf len most-positive-fixnum))
(t
(incf len (frequency-defference-by
k sorted-freqs)))))
(setf (aref vec k) len)
finally (return vec))))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
fixnum)
frequency-defference-by))
(defun frequency-defference-by (x sorted-freqs)
(assert (> x 0))
(assert (< x (length sorted-freqs)))
(* x (- (aref sorted-freqs x)
(aref sorted-freqs (1- x)))))
;; x (Query 1-index) -> (index, k) 0-index of k-th addtion.
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
(values fixnum fixnum))
the-index-added-by))
(defun the-index-added-by (x lengths)
(multiple-value-bind (val index)
(floor-in-fixnum-vector lengths (1- x))
(cond (val (values (- x val 1) (1+ index)))
(t (values (1- x) 0)))))
(declaim (ftype (function
(fixnum
fixnum
(simple-array fixnum (*))
(simple-array fixnum (*))
(simple-array fixnum (*)))
fixnum)
answer-to-query))
(defun answer-to-query (x M lengths A-ary value-ordered)
(multiple-value-bind (index k) (the-index-added-by x lengths)
(assert index)
(assert (<= 0 index))
(cond ((= k 0) (aref A-ary index))
((>= index M)
(nth-smallest-fixnum-range value-ordered
(mod index M) M))
(t (progn
(nth-smallest-fixnum-range value-ordered
(mod index k) k))))))
;; =========
;; general purpose
(declaim (ftype (function
(sequence)
(simple-array fixnum (*)))
to-fixnum-array))
(defun to-fixnum-array (seq)
"sequence を (simple-array fixnum (*)) に変換する。"
(declare (type sequence seq))
(make-array (length seq)
:element-type 'fixnum
:initial-contents seq))
;; general purpose
(declaim (ftype (function
((simple-array fixnum (*)) fixnum)
(values (or null fixnum)
(or null fixnum)))
floor-in-fixnum-vector))
(defun floor-in-fixnum-vector (sorted-vec x)
"昇順 sorted の simple-array fixnum から、x 以下の最大値を返す。
見つかった場合は (values value index)、ない場合は (values nil nil)。"
(declare (type (simple-array fixnum (*)) sorted-vec)
(type fixnum x))
(let ((lo 0)
(hi (length sorted-vec)))
(declare (type fixnum lo hi))
(loop while (< lo hi) do
(let ((mid (the fixnum (+ lo (ash (- hi lo) -1)))))
(declare (type fixnum mid))
(if (<= (aref sorted-vec mid) x)
(setq lo (the fixnum (1+ mid)))
(setq hi mid))))
(if (zerop lo)
(values nil nil)
(values (aref sorted-vec (the fixnum (1- lo)))
(the fixnum (1- lo))))))
(declaim (ftype (function
((simple-array fixnum (*)) fixnum fixnum)
fixnum)
nth-smallest-fixnum-range))
(defun nth-smallest-fixnum-range (vec n r)
(nth-smallest-fixnum-range/sort vec n r))
(declaim (ftype (function
((simple-array fixnum (*)) fixnum fixnum)
fixnum)
nth-smallest-fixnum-range/sort))
(defun nth-smallest-fixnum-range/sort (vec n r)
(declare (type (simple-array fixnum (*)) vec)
(type fixnum n r))
(assert (<= 0 r (length vec)))
(assert (<= 0 n))
(assert (< n r))
(let ((work (make-array r :element-type 'fixnum)))
(declare (type (simple-array fixnum (*)) work))
(dotimes (i r)
(declare (type fixnum i))
(setf (aref work i) (aref vec i)))
(sort work #'<)
(aref work n)))
(defun solve ()
(let* ((N (read))
(M (read))
(A (loop repeat N
collect (read)))
(Q (read))
(X (loop repeat Q
collect (read)))
(Ans (make-answers N M A X)))
(loop for a in Ans
do (print a))))
#-swank
(solve)
Code language: Lisp (lisp)
6.1. 全体設計を見直す
そこで、nth-smallest-fixnumに至るまでの回答を作成する流れを整理します。
make-answers(N M A X)
-> answer-to-query(x M lengths A-ary value-ordered) 「区間判定」と「順位問い合わせ」
-> nth-smallest-fixnum(vec n r) 重たい繰り返し処理
3つの関数がありますが、責務の切り方が無計画になっています。
そこで、make-answersを全体制御にして、answer-to-queryを軽くして、クエリのグループ化に専念させます。
そして、一個一個順位を問い合わせるのではなく、
make-answers(N M A X)(全体制御) ;; 前処理
;; 各 query を request 化
-> query->request(x lengths)(浅く分類)
;; direct は即答
-> answer-table[q] = ans
;; rank request はまとめて solve
-> solve-rank-requests(requests value-ordered M) (重い処理をまとめて)
;; 元の順序へ戻す
-> collect answer-table xsCode language: PHP (php)
つまり、「1 クエリずつ深く潜る」形をやめて、「全クエリをいったん浅く分類し、重い部分はまとめて処理する」形にします。
それで、まずは queryから、頻度順ブロックの長さ k、値順の順位 rankを求め、kごとにグループ化して保持するようにします。
6.2. rank-request構造体
データ構造は、以下のようにすることにしました。
(defstruct rank-request
"頻度順に対する順位問い合わせ"
(qid 0 :type fixnum)
(k 0 :type fixnum)
(rank 0 :type fixnum))
(defstruct direct-answer
(qid 0 :type fixnum)
(index 0 :type fixnum))Code language: Lisp (lisp)
これを元に、クエリから k と rank を計算したリクエストを求めます。
(defun query->request (x qid lengths)
(multiple-value-bind (rank k) (the-index-added-by x lengths)
(assert rank)
(assert (<= 0 rank))
(cond ((= k 0)
(make-direct-answer
:qid qid
:index rank))
(t (make-rank-request
:qid qid
:k k
:rank rank)))))Code language: Lisp (lisp)
リクエストは、リストの配列 bucketsに追加していきます。
(loop for qid of-type fixnum from 1
for x of-type fixnum in X
do (let ((req (query->request x qid lengths)))
(cond
((direct-answer-p req)
(setf (aref answer-vec (direct-answer-qid req))
(aref A-ary (direct-answer-index req))))
(t
(push req (aref buckets (rank-request-k req)))))))Code language: Lisp (lisp)
6.3. fenwick treeで順序を求める
次は、kごとに回答を作成していきます。
ここで、fenwick treeのfenwick-kthを使うことにしました。
;;; Fenwick Tree (1-indexed, element-type fixnum)
(defun lsb (i)
(logand i (- i)))
(defun make-fenwick (n)
(make-array (1+ n) :element-type 'fixnum
:initial-element 0))
(defun fenwick-update! (tree i delta)
(declare (type (simple-array fixnum (*)) tree)
(type fixnum i delta))
(loop while (<= i (1- (length tree)))
do (incf (aref tree i) delta)
(setf i (+ i (lsb i)))))
(defun fenwick-kth (tree k)
"k 番目(1-indexed)に小さい値を O(log M) で返す。"
(declare (type (simple-array fixnum (*)) tree)
(type fixnum k))
(let ((n (1- (length tree))))
(declare (type fixnum n))
(loop with x fixnum = 0
with remain fixnum = k
for bit fixnum = (ash 1 (1- (integer-length n)))
then (ash bit -1)
while (> bit 0)
do (let ((next (the fixnum (+ x bit))))
(when (and (<= next n)
(< (aref tree next) remain))
(decf remain (aref tree next))
(setf x next)))
finally (return (1+ x)))))
Code language: Lisp (lisp)
fenwick treeでは、データを追加しながら累積和を更新していくのが効率的にできます。
(let ((tree (make-fenwick M)))
(loop for k of-type fixnum from 1 to M
do (fenwick-update! tree (aref values-ordered (1- k)) 1)
(loop for req in (aref buckets k)
do (setf (aref answer-vec
(rank-request-qid req))
(fenwick-kth
tree (1+ (rank-request-rank req)))))))Code language: JavaScript (javascript)
6.4. ようやくクリア(34)
これを元に、答えを作る make-answersは、3つのループで構成されます。
(defun make-answers (N M A X)
(declare (type fixnum N M) (type list A X))
(let* ((A-ary (to-fixnum-array A))
(answer-vec (make-array (1+ (length X))
:element-type 'fixnum
:initial-element 0))
(freqs (frequencies M A))
(sorted-freqs (sorted-frequencies freqs))
(values-ordered (values-in-frequency-order M freqs))
(lengths (lengths-after-addition N M sorted-freqs))
(buckets (make-array (1+ M) :initial-element '())))
(declare (type (simple-array fixnum (*))
freqs sorted-freqs values-ordered lengths A-ary))
(loop for qid of-type fixnum from 1
for x of-type fixnum in X
do (let ((req (query->request x qid lengths)))
(cond
((direct-answer-p req)
(setf (aref answer-vec (direct-answer-qid req))
(aref A-ary (direct-answer-index req))))
(t
(push req (aref buckets (rank-request-k req)))))))
(let ((tree (make-fenwick M)))
(loop for k of-type fixnum from 1 to M
do (fenwick-update! tree (aref values-ordered (1- k)) 1)
(loop for req in (aref buckets k)
do (setf (aref answer-vec
(rank-request-qid req))
(fenwick-kth
tree (1+ (rank-request-rank req)))))))
(loop for qid of-type fixnum from 1 to (length X)
collect (aref answer-vec qid))))Code language: Lisp (lisp)
これによって、ようやく正解 34でクリアできました。

;;#+swank
;;(declaim (optimize (speed 3) (safety 0) (debug 0)))
;;; Fenwick Tree (1-indexed, element-type fixnum)
(defun lsb (i)
(logand i (- i)))
(defun make-fenwick (n)
(make-array (1+ n) :element-type 'fixnum
:initial-element 0))
(defun fenwick-update! (tree i delta)
(declare (type (simple-array fixnum (*)) tree)
(type fixnum i delta))
(loop while (<= i (1- (length tree)))
do (incf (aref tree i) delta)
(setf i (+ i (lsb i)))))
(defun fenwick-kth (tree k)
"k 番目(1-indexed)に小さい値を O(log M) で返す。"
(declare (type (simple-array fixnum (*)) tree)
(type fixnum k))
(let ((n (1- (length tree))))
(declare (type fixnum n))
(loop with x fixnum = 0
with remain fixnum = k
for bit fixnum = (ash 1 (1- (integer-length n)))
then (ash bit -1)
while (> bit 0)
do (let ((next (the fixnum (+ x bit))))
(when (and (<= next n)
(< (aref tree next) remain))
(decf remain (aref tree next))
(setf x next)))
finally (return (1+ x)))))
(defstruct rank-request
"頻度順に対する順位問い合わせ"
(qid 0 :type fixnum)
(k 0 :type fixnum)
(rank 0 :type fixnum))
(defstruct direct-answer
(qid 0 :type fixnum)
(index 0 :type fixnum))
;;; メイン
(defun make-answers (N M A X)
(declare (type fixnum N M) (type list A X))
(let* ((A-ary (to-fixnum-array A))
(answer-vec (make-array (1+ (length X))
:element-type 'fixnum
:initial-element 0))
(freqs (frequencies M A))
(sorted-freqs (sorted-frequencies freqs))
(values-ordered (values-in-frequency-order M freqs))
(lengths (lengths-after-addition N M sorted-freqs))
(buckets (make-array (1+ M) :initial-element '())))
(declare (type (simple-array fixnum (*))
freqs sorted-freqs values-ordered lengths A-ary))
(loop for qid of-type fixnum from 1
for x of-type fixnum in X
do (let ((req (query->request x qid lengths)))
(cond
((direct-answer-p req)
(setf (aref answer-vec (direct-answer-qid req))
(aref A-ary (direct-answer-index req))))
(t
(push req (aref buckets (rank-request-k req)))))))
(let ((tree (make-fenwick M)))
(loop for k of-type fixnum from 1 to M
do (fenwick-update! tree (aref values-ordered (1- k)) 1)
(loop for req in (aref buckets k)
do (setf (aref answer-vec
(rank-request-qid req))
(fenwick-kth
tree (1+ (rank-request-rank req)))))))
(loop for qid of-type fixnum from 1 to (length X)
collect (aref answer-vec qid))))
(defun query->request (x qid lengths)
(multiple-value-bind (rank k) (the-index-added-by x lengths)
(assert rank)
(assert (<= 0 rank))
(cond ((= k 0)
(make-direct-answer
:qid qid
:index rank))
(t (make-rank-request
:qid qid
:k k
:rank rank)))))
;; from 0 index
(declaim (ftype (function
(fixnum list)
(simple-array fixnum (*)))
frequencies))
(defun frequencies (M A)
(let* ((result (make-array M
:element-type 'fixnum
:initial-element 0)))
(loop for x fixnum in A
do (incf (aref result (1- x)))
finally (return result))))
(declaim (ftype (function
((simple-array fixnum (*)))
(simple-array fixnum (*)))
sorted-frequencies))
(defun sorted-frequencies (freqs)
(sort (copy-seq freqs) #'<))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
list)
value-frequency-pairs))
(defun value-frequency-pairs (M freqs)
(loop for i from 1 to M
collect (cons i (aref freqs (1- i)))))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
(simple-array fixnum (*)))
values-in-frequency-order))
(defun values-in-frequency-order (M freqs)
(let* ((VFs (value-frequency-pairs M freqs))
(sorted-pairs (stable-sort VFs #'< :key #'cdr))
(val-list (loop for pair in sorted-pairs
collect (car pair))))
(declare (type list VFs sorted-pairs val-list))
(make-array (length val-list) :element-type 'fixnum
:initial-contents val-list)))
(declaim (ftype (function
((simple-array fixnum (*)) fixnum)
fixnum)
value->frequency))
(defun value->frequency (freqs val)
(assert (> val 0))
(aref freqs (1- val)))
;; total number of elements covered
;; after processing the k least frequent values
(declaim (ftype (function
(fixnum fixnum (simple-array fixnum (*)))
(simple-array fixnum (*)))
lengths-after-addition))
(defun lengths-after-addition (N M sorted-freqs)
(let* ((vec (make-array (1+ M)
:element-type 'fixnum
:initial-element 0)))
(loop with len = N
for k from 0 to M
do (progn
(cond ((= k 0)
(setf len N))
((= k M)
(setf len most-positive-fixnum))
(t
(incf len (frequency-difference-by
k sorted-freqs)))))
(setf (aref vec k) len)
finally (return vec))))
(declaim (ftype (function
(fixnum (simple-array fixnum (*)))
fixnum)
frequency-difference-by))
(defun frequency-difference-by (x sorted-freqs)
(assert (> x 0))
(assert (< x (length sorted-freqs)))
(* x (- (aref sorted-freqs x)
(aref sorted-freqs (1- x)))))
;; x (Query 1-index) -> (index, k) 0-index of k-th addtion.
(declaim (ftype (function (fixnum (simple-array fixnum (*)))
(values fixnum fixnum))
the-index-added-by))
(defun the-index-added-by (x lengths)
(declare (type fixnum x))
(multiple-value-bind (val index)
(floor-in-fixnum-vector lengths (1- x))
(cond (val (values (mod (- x val 1) (1+ index))
(1+ index)))
(t (values (1- x) 0)))))
;; =========
;; general purpose
(declaim (ftype (function
(sequence)
(simple-array fixnum (*)))
to-fixnum-array))
(defun to-fixnum-array (seq)
"sequence を (simple-array fixnum (*)) に変換する。"
(declare (type sequence seq))
(make-array (length seq)
:element-type 'fixnum
:initial-contents seq))
;; general purpose
(declaim (ftype (function
((simple-array fixnum (*)) fixnum)
(values (or null fixnum)
(or null fixnum)))
floor-in-fixnum-vector))
(defun floor-in-fixnum-vector (sorted-vec x)
"昇順 sorted の simple-array fixnum から、x 以下の最大値を返す。
見つかった場合は (values value index)、ない場合は (values nil nil)。"
(declare (type (simple-array fixnum (*)) sorted-vec)
(type fixnum x))
(let ((lo 0)
(hi (length sorted-vec)))
(declare (type fixnum lo hi))
(loop while (< lo hi) do
(let ((mid (the fixnum (+ lo (ash (- hi lo) -1)))))
(declare (type fixnum mid))
(if (<= (aref sorted-vec mid) x)
(setq lo (the fixnum (1+ mid)))
(setq hi mid))))
(if (zerop lo)
(values nil nil)
(values (aref sorted-vec (the fixnum (1- lo)))
(the fixnum (1- lo))))))
(defun solve ()
(let* ((N (read))
(M (read))
(A (loop repeat N
collect (read)))
(Q (read))
(X (loop repeat Q
collect (read)))
(Ans (make-answers N M A X)))
(loop for a in Ans
do (print a))))
#-swank
(solve)
Code language: Lisp (lisp)

3/21に考え始めて、やっと4/13に解き終わりました。
次は、もう少しかんたんな問題から練習しようと思います。