結果
| 問題 | No.1012 荷物収集 |
| ユーザー |
 sansaqua
|
| 提出日時 | 2020-03-20 22:02:49 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 748 ms / 2,000 ms |
| コード長 | 24,866 bytes |
| コンパイル時間 | 959 ms |
| コンパイル使用メモリ | 71,792 KB |
| 実行使用メモリ | 41,408 KB |
| 最終ジャッジ日時 | 2023-08-21 16:38:44 |
| 合計ジャッジ時間 | 15,296 ms |
|
ジャッジサーバーID （参考情報） |
judge15 / judge12 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 11 ms
25,392 KB |
| testcase_01 | AC | 10 ms
25,288 KB |
| testcase_02 | AC | 10 ms
25,296 KB |
| testcase_03 | AC | 11 ms
25,280 KB |
| testcase_04 | AC | 310 ms
41,384 KB |
| testcase_05 | AC | 310 ms
41,328 KB |
| testcase_06 | AC | 311 ms
41,340 KB |
| testcase_07 | AC | 310 ms
41,388 KB |
| testcase_08 | AC | 312 ms
41,312 KB |
| testcase_09 | AC | 311 ms
41,340 KB |
| testcase_10 | AC | 309 ms
41,312 KB |
| testcase_11 | AC | 308 ms
41,340 KB |
| testcase_12 | AC | 309 ms
41,408 KB |
| testcase_13 | AC | 311 ms
41,388 KB |
| testcase_14 | AC | 11 ms
25,308 KB |
| testcase_15 | AC | 12 ms
25,380 KB |
| testcase_16 | AC | 11 ms
25,300 KB |
| testcase_17 | AC | 12 ms
25,440 KB |
| testcase_18 | AC | 11 ms
25,308 KB |
| testcase_19 | AC | 10 ms
25,384 KB |
| testcase_20 | AC | 11 ms
25,344 KB |
| testcase_21 | AC | 11 ms
25,308 KB |
| testcase_22 | AC | 11 ms
25,328 KB |
| testcase_23 | AC | 11 ms
25,332 KB |
| testcase_24 | AC | 460 ms
34,400 KB |
| testcase_25 | AC | 668 ms
38,544 KB |
| testcase_26 | AC | 262 ms
34,984 KB |
| testcase_27 | AC | 48 ms
27,644 KB |
| testcase_28 | AC | 612 ms
39,216 KB |
| testcase_29 | AC | 234 ms
37,704 KB |
| testcase_30 | AC | 640 ms
40,172 KB |
| testcase_31 | AC | 193 ms
27,932 KB |
| testcase_32 | AC | 179 ms
29,220 KB |
| testcase_33 | AC | 300 ms
30,128 KB |
| testcase_34 | AC | 308 ms
29,912 KB |
| testcase_35 | AC | 519 ms
37,448 KB |
| testcase_36 | AC | 261 ms
28,604 KB |
| testcase_37 | AC | 223 ms
36,692 KB |
| testcase_38 | AC | 499 ms
35,344 KB |
| testcase_39 | AC | 177 ms
30,680 KB |
| testcase_40 | AC | 233 ms
30,644 KB |
| testcase_41 | AC | 748 ms
40,412 KB |
| testcase_42 | AC | 306 ms
31,764 KB |
| testcase_43 | AC | 416 ms
35,716 KB |
| testcase_44 | AC | 10 ms
25,264 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 21 AUG 2023 04:38:29 PM): ; processing (SB-INT:DEFCONSTANT-EQX OPT ...) ; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...) ; processing (DISABLE-DEBUGGER) ; processing (DEFMACRO WITH-BUFFERED-STDOUT ...) ; processing (DECLAIM (FTYPE # ...)) ; processing (DEFUN READ-FIXNUM ...) ; processing (DECLAIM (INLINE OP)) ; processing (DEFUN OP ...) ; processing (DEFCONSTANT +OP-IDENTITY+ ...) ; processing (DEFSTRUCT (TREAP # ...) ...) ; processing (DECLAIM (INLINE TREAP-KEY)) ; processing (DEFUN TREAP-KEY ...) ; processing (DECLAIM (INLINE TREAP-ACCUMULATOR)) ; processing (DEFUN TREAP-ACCUMULATOR ...) ; processing (DECLAIM (INLINE UPDATE-ACCUMULATOR)) ; processing (DEFUN UPDATE-ACCUMULATOR ...) ; processing (DECLAIM (INLINE FORCE-UP)) ; processing (DEFUN FORCE-UP ...) ; processing (DECLAIM (FTYPE # ...)) ; processing (DEFUN TREAP-SPLIT ...) ; processing (DECLAIM (INLINE TREAP-INSERT)) ; processing (DEFUN TREAP-INSERT ...) ; processing (DECLAIM (INLINE TREAP-ENSURE-KEY)) ; processing (DEFUN TREAP-ENSURE-KEY ...) ; processing (DEFUN TREAP-MERGE ...) ; file: /home/judge/data/code/Main.lisp ; in: DEFUN TREAP-MERGE ; (FORCE-UP RIGHT) ; --> BLOCK UPDATE-ACCUMULATOR BLOCK SETF LET SB-KERNEL:THE* IF IF LET OP BLOCK ; ==> ; (+ X Y) ; ; note: forced to do GENERIC-+ (cost 10) ; unable to do inline fixnum arithmetic (cost 2) because: ; The first argument is a (INTEGER -9223372036854775808 9223372036854775806), not a FIXNUM. ; The result is a (VALUES ; (INTEGER -13835058055282163712 13835058055282163709) ; &OPTIONAL), not a (VALUES FIXNUM &REST T). ; unable to do inline (signed-byte 64) arithmetic (cost 4) because: ; The result is a (VALUES ; (INTEGER -13835058055282163712 13835058055282163709) ; &OPTIONAL), not a (VALUES (SIGNED-BYTE 64) &REST T). ; etc. ; (FORCE-UP LEFT) ; --> BLOCK UPDAT
ソースコード
(eval-when (:compile-toplevel :load-toplevel :execute)
(sb-int:defconstant-eqx OPT
#+swank '(optimize (speed 3) (safety 2))
#-swank '(optimize (speed 3) (safety 0) (debug 0))
#'equal)
#+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
#-swank (set-dispatch-macro-character
;; enclose the form with VALUES to avoid being captured by LOOP macro
#\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy
;; BEGIN_INSERTED_CONTENTS
(defmacro with-buffered-stdout (&body body)
"Buffers all outputs to *STANDARD-OUTPUT* in BODY and flushes them to
*STANDARD-OUTPUT* after BODY has been done (without error). Note that only
BASE-CHAR is allowed."
(let ((out (gensym)))
`(let ((,out (make-string-output-stream :element-type 'base-char)))
(let ((*standard-output* ,out))
,@body)
(write-string (get-output-stream-string ,out)))))
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
"NOTE: cannot read -2^62"
(macrolet ((%read-byte ()
`(the (unsigned-byte 8)
#+swank (char-code (read-char in nil #\Nul))
#-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil))))
(let* ((minus nil)
(result (loop (let ((byte (%read-byte)))
(cond ((<= 48 byte 57)
(return (- byte 48)))
((zerop byte) ; #\Nul
(error "Read EOF or #\Nul."))
((= byte #.(char-code #\-))
(setq minus t)))))))
(declare ((integer 0 #.most-positive-fixnum) result))
(loop
(let* ((byte (%read-byte)))
(if (<= 48 byte 57)
(setq result (+ (- byte 48)
(* 10 (the (integer 0 #.(floor most-positive-fixnum 10))
result))))
(return (if minus (- result) result))))))))
;;;
;;; Treap with explicit key
;;; Virtually it works like std::map, std::multiset, or java.util.TreeMap.
;;;
;; Tips to use this structure as a multiset: Just define OP as (defun op (x y)
;; (+ x y)) and insert each element by
;;
;; (treap-ensure-key <treap> <key> 1 :if-exists #'1+)
;;
;; instead of TREAP-INSERT.
;; TODO & NOTE: insufficient tests
;; TODO: introduce abstraction by macro
(declaim (inline op))
(defun op (x y)
"Is the operator comprising a monoid"
(+ x y))
(defconstant +op-identity+ 0
"identity element w.r.t. OP")
(defstruct (treap (:constructor %make-treap (key priority value &key left right (accumulator value)))
(:copier nil)
(:conc-name %treap-))
(key 0 :type fixnum)
(value +op-identity+ :type fixnum)
(accumulator +op-identity+ :type fixnum)
(priority 0 :type (integer 0 #.most-positive-fixnum))
(left nil :type (or null treap))
(right nil :type (or null treap)))
(declaim (inline treap-key))
(defun treap-key (treap)
"Returns the key of the (nullable) TREAP."
(and treap (%treap-key treap)))
(declaim (inline treap-accumulator))
(defun treap-accumulator (treap)
(declare ((or null treap) treap))
(if (null treap)
+op-identity+
(%treap-accumulator treap)))
(declaim (inline update-accumulator))
(defun update-accumulator (treap)
(declare (treap treap))
(setf (%treap-accumulator treap)
(if (%treap-left treap)
(if (%treap-right treap)
(let ((mid-res (op (%treap-accumulator (%treap-left treap))
(%treap-value treap))))
(op mid-res (%treap-accumulator (%treap-right treap))))
(op (%treap-accumulator (%treap-left treap))
(%treap-value treap)))
(if (%treap-right treap)
(op (%treap-value treap)
(%treap-accumulator (%treap-right treap)))
(%treap-value treap)))))
(declaim (inline force-up))
(defun force-up (treap)
"Propagates up the information from children."
(declare (treap treap))
(update-accumulator treap))
(declaim (ftype (function * (values (or null treap) (or null treap) &optional)) treap-split))
(defun treap-split (treap key &key (order #'<))
"Destructively splits the TREAP with reference to KEY and returns two treaps,
the smaller sub-treap (< KEY) and the larger one (>= KEY)."
(declare (function order)
((or null treap) treap))
(if (null treap)
(values nil nil)
(progn
(if (funcall order (%treap-key treap) key)
(multiple-value-bind (left right)
(treap-split (%treap-right treap) key :order order)
(setf (%treap-right treap) left)
(force-up treap)
(values treap right))
(multiple-value-bind (left right)
(treap-split (%treap-left treap) key :order order)
(setf (%treap-left treap) right)
(force-up treap)
(values left treap))))))
(declaim (inline treap-insert))
(defun treap-insert (treap key value &key (order #'<))
"Destructively inserts KEY into TREAP and returns the resultant treap. You
cannot rely on the side effect. Use the returned value.
The behavior is undefined when duplicate keys are inserted."
(declare ((or null treap) treap)
(function order))
(labels ((recur (node treap)
(declare (treap node))
(unless treap (return-from recur node))
(if (> (%treap-priority node) (%treap-priority treap))
(progn
(setf (values (%treap-left node) (%treap-right node))
(treap-split treap (%treap-key node) :order order))
(force-up node)
node)
(progn
(if (funcall order (%treap-key node) (%treap-key treap))
(setf (%treap-left treap)
(recur node (%treap-left treap)))
(setf (%treap-right treap)
(recur node (%treap-right treap))))
(force-up treap)
treap))))
(recur (%make-treap key (random most-positive-fixnum) value) treap)))
(declaim (inline treap-ensure-key))
(defun treap-ensure-key (treap key value &key (order #'<) if-exists)
"IF-EXISTS := nil | function
Ensures that TREAP contains KEY and assigns VALUE to it if IF-EXISTS is
false. If IF-EXISTS is function and TREAP already contains KEY, TREAP-ENSURE-KEY
updates the value by the function instead of overwriting it with VALUE."
(declare (function order)
((or null treap) treap))
(labels ((find-and-update (treap)
;; Updates the value slot and returns T if KEY exists
(unless treap (return-from find-and-update nil))
(cond ((funcall order key (%treap-key treap))
(when (find-and-update (%treap-left treap))
(force-up treap)
t))
((funcall order (%treap-key treap) key)
(when (find-and-update (%treap-right treap))
(force-up treap)
t))
(t (setf (%treap-value treap)
(if if-exists
(funcall if-exists (%treap-value treap))
value))
(force-up treap)
t))))
(if (find-and-update treap)
treap
(treap-insert treap key value :order order))))
(defun treap-merge (left right)
"Destructively concatenates two treaps. Assumes that all keys of LEFT are
smaller (or larger, depending on the order) than those of RIGHT.
Note that this `merge' is different from CL:MERGE and rather close to
CL:CONCATENATE."
(declare (optimize (speed 3))
((or null treap) left right))
(cond ((null left) (when right (force-up right)) right)
((null right) (when left (force-up left)) left)
(t
(if (> (%treap-priority left) (%treap-priority right))
(progn
(setf (%treap-right left)
(treap-merge (%treap-right left) right))
(force-up left)
left)
(progn
(setf (%treap-left right)
(treap-merge left (%treap-left right)))
(force-up right)
right)))))
(defun treap-delete (treap key &key (order #'<))
"Destructively deletes the KEY in TREAP and returns the resultant
treap. Returns the unmodified TREAP If KEY doesn't exist. You cannot rely on the
side effect. Use the returned value.
(Note that this function deletes at most one node even if duplicated keys
exist.)"
(declare ((or null treap) treap)
(function order))
(when treap
(cond ((funcall order key (%treap-key treap))
(setf (%treap-left treap)
(treap-delete (%treap-left treap) key :order order))
(force-up treap)
treap)
((funcall order (%treap-key treap) key)
(setf (%treap-right treap)
(treap-delete (%treap-right treap) key :order order))
(force-up treap)
treap)
(t
(treap-merge (%treap-left treap) (%treap-right treap))))))
(declaim (inline treap-map))
(defun treap-map (function treap)
"Successively applies FUNCTION to TREAP[0], ..., TREAP[SIZE-1]. FUNCTION must
take two arguments: KEY and VALUE."
(labels ((recur (treap)
(when treap
(recur (%treap-left treap))
(funcall function (%treap-key treap) (%treap-value treap))
(recur (%treap-right treap))
(force-up treap))))
(recur treap)))
(defmethod print-object ((object treap) stream)
(print-unreadable-object (object stream :type t)
(let ((init t))
(treap-map (lambda (key value)
(if init
(setf init nil)
(write-char #\ stream))
(format stream "<~A . ~A>" key value))
object))))
(defmacro do-treap ((key-var value-var treap &optional result) &body body)
"Successively binds the key and value of INODE[0], ..., INODE[SIZE-1] to
KEY-VAR and VALUE-VAR and executes BODY."
`(block nil
(treap-map (lambda (,key-var ,value-var) ,@body) ,treap)
,result))
;; This function takes O(nlog(n)) time. It is just for debugging.
(defun treap (order &rest key-and-values)
"Takes cons cells in the form of (<key> . <value>)."
(loop with res = nil
for (key . value) in key-and-values
do (setf res (treap-insert res key value :order order))
finally (return res)))
;; Reference: https://cp-algorithms.com/data_structures/treap.html
;; TODO: take a sorted list as the argument
(declaim (inline make-treap))
(defun make-treap (sorted-vector)
"Makes a treap using each key of the given SORTED-VECTOR in O(n) time. Note
that this function doesn't check if the SORTED-VECTOR is actually sorted
w.r.t. your intended order. The values are filled with the identity element."
(declare (vector sorted-vector))
(labels ((heapify (top)
(when top
(let ((prioritized-node top))
(when (and (%treap-left top)
(> (%treap-priority (%treap-left top))
(%treap-priority prioritized-node)))
(setq prioritized-node (%treap-left top)))
(when (and (%treap-right top)
(> (%treap-priority (%treap-right top))
(%treap-priority prioritized-node)))
(setq prioritized-node (%treap-right top)))
(unless (eql prioritized-node top)
(rotatef (%treap-priority prioritized-node)
(%treap-priority top))
(heapify prioritized-node)))))
(build (l r)
(declare ((integer 0 #.most-positive-fixnum) l r))
(if (= l r)
nil
(let* ((mid (ash (+ l r) -1))
(node (%make-treap (aref sorted-vector mid)
(random most-positive-fixnum)
+op-identity+)))
(setf (%treap-left node) (build l mid))
(setf (%treap-right node) (build (+ mid 1) r))
(heapify node)
node))))
(build 0 (length sorted-vector))))
(defun treap-query (treap &key left right (order #'<))
"Queries the sum of the half-open interval specified by the keys: [LEFT,
RIGHT). If LEFT [RIGHT] is not given, it is assumed to be -inf [+inf]."
(labels ((recur (treap l r)
(unless treap
(return-from recur +op-identity+))
(prog1
(if (and (null l) (null r))
(%treap-accumulator treap)
(let ((key (%treap-key treap)))
(if (or (null l) (not (funcall order key l))) ; L <= KEY
(if (or (null r) (funcall order key r)) ; KEY < R
(op (op (recur (%treap-left treap) l nil)
(%treap-value treap))
(recur (%treap-right treap) nil r))
(recur (%treap-left treap) l r))
(recur (%treap-right treap) l r))))
(force-up treap))))
(recur treap left right)))
#|
;; Below is a simpler but somewhat slower variant
(declaim (inline treap-query))
(defun treap-query (treap &key left right (order #'<))
"Queries the sum of the half-open interval specified by the keys: [LEFT,
RIGHT). If LEFT [RIGHT] is not given, it is assumed to be -inf [+inf]."
(if (null left)
(if (null right)
(treap-accumulator treap)
(multiple-value-bind (treap-0-r treap-r-n)
(treap-split treap right :order order)
(prog1 (treap-accumulator treap-0-r)
(treap-merge treap-0-r treap-r-n))))
(if (null right)
(multiple-value-bind (treap-0-l treap-l-n)
(treap-split treap left :order order)
(prog1 (treap-accumulator treap-l-n)
(treap-merge treap-0-l treap-l-n)))
(progn
(assert (not (funcall order right left)))
(multiple-value-bind (treap-0-l treap-l-n)
(treap-split treap left :order order)
(multiple-value-bind (treap-l-r treap-r-n)
(treap-split treap-l-n right :order order)
(prog1 (treap-accumulator treap-l-r)
(treap-merge treap-0-l (treap-merge treap-l-r treap-r-n)))))))))
;|#
#|
;; Below is a simpler but somewhat slower variant.
(declaim (inline treap-update))
(defun treap-update (treap x left right &key (order #'<))
"Updates TREAP[KEY] := (OP TREAP[KEY] X) for all KEY in [l, r)"
(assert (not (funcall order right left)))
(multiple-value-bind (treap-0-l treap-l-n)
(treap-split treap left :order order)
(multiple-value-bind (treap-l-r treap-r-n)
(treap-split treap-l-n right :order order)
(when treap-l-r
(setf (%treap-lazy treap-l-r)
(updater-op (%treap-lazy treap-l-r) x)))
(treap-merge treap-0-l (treap-merge treap-l-r treap-r-n)))))
;|#
(declaim (inline treap-ref))
(defun treap-ref (treap key &key (order #'<))
(declare ((or null treap) treap))
(labels ((recur (treap)
(when treap
(prog1 (cond ((funcall order key (%treap-key treap))
(recur (%treap-left treap)))
((funcall order (%treap-key treap) key)
(recur (%treap-right treap)))
(t (%treap-value treap)))
(force-up treap)))))
(recur treap)))
;;;
;;; Bisection search for key
;;;
;; NOTE: These functions intentionally don't return the assigned value. That is
;; for efficiency, because thereby they don't need to execute lazy propagation.
(defun treap-find (treap key &key (order #'<))
"Finds the key that satisfies (AND (NOT (FUNCALL ORDER KEY (%TREAP-KEY
<sub-treap>))) (NOT (FUNCALL ORDER (%TREAP-KEY <sub-treap>) KEY))) and returns
KEY if it exists, otherwise returns NIL."
(declare (optimize (speed 3))
(function order)
((or null treap) treap))
(cond ((null treap) nil)
((funcall order key (%treap-key treap))
(treap-find (%treap-left treap) key :order order))
((funcall order (%treap-key treap) key)
(treap-find (%treap-right treap) key :order order))
(t key)))
(declaim (inline treap-bisect-left))
(defun treap-bisect-left (treap key &key (order #'<))
"Returns the smallest key equal to or larger than KEY. Returns NIL if KEY is
larger than any keys in TREAP."
(declare ((or null treap) treap)
(function order))
(labels ((recur (treap)
(unless treap (return-from recur nil))
(if (funcall order (%treap-key treap) key)
(recur (%treap-right treap))
(or (recur (%treap-left treap))
treap))))
(treap-key (recur treap))))
(declaim (inline treap-bisect-left))
(defun treap-bisect-right (treap key &key (order #'<))
"Returns the smallest key larger than KEY. Returns NIL if KEY is equal to or
larger than any keys in TREAP."
(declare ((or null treap) treap)
(function order))
(labels ((recur (treap)
(unless treap (return-from recur nil))
(if (funcall order key (%treap-key treap))
(or (recur (%treap-left treap))
treap)
(recur (%treap-right treap)))))
(treap-key (recur treap))))
(declaim (inline treap-bisect-left-1))
(defun treap-bisect-left-1 (treap key &key (order #'<))
"Returns the largest key smaller than KEY. Returns NIL if KEY is equal to or
smaller than any keys in TREAP."
(declare ((or null treap) treap)
(function order))
(labels ((recur (treap)
(unless treap (return-from recur nil))
(if (funcall order (%treap-key treap) key)
(or (recur (%treap-right treap))
treap)
(recur (%treap-left treap)))))
(treap-key (recur treap))))
(declaim (inline treap-bisect-right-1))
(defun treap-bisect-right-1 (treap key &key (order #'<))
"Returns the largest key equal to or smaller than KEY. Returns NIL if KEY is
smaller than any keys in TREAP."
(declare ((or null treap) treap)
(function order))
(labels ((recur (treap)
(unless treap (return-from recur nil))
(if (funcall order key (%treap-key treap))
(recur (%treap-left treap))
(or (recur (%treap-right treap))
treap))))
(treap-key (recur treap))))
;; not tested
(defun treap-range-bisect (treap value &key (order #'<))
"Returns the smallest existing key that satisfies TREAP[<1st key>]+ TREAP[<2nd key>] + ... + TREAP[key] >= VALUE (if ORDER is #'<).
Note:
- This function handles a **closed** interval.
- This function returns NIL instead if TREAP[<1st key>]+ ... + TREAP[<last
key>] < VALUE.
- The prefix sums of TTREAP, (TREAP[<1st key>], TREAP[<1st key>]+TREAP[<2nd
key>], ...) must be monotone w.r.t. ORDER.
- ORDER must be a strict order"
(labels
((recur (treap prev-sum)
(unless treap
(return-from recur))
(let ((sum prev-sum))
(prog1
(cond ((not (funcall order
(setq sum (op sum (treap-accumulator (%treap-left treap))))
value))
(if (%treap-left treap)
(recur (%treap-left treap) prev-sum)
(%treap-key treap)))
((not (funcall order
(setq sum (op sum (%treap-value treap)))
value))
(%treap-key treap))
(t
(recur (%treap-right treap) sum)))
(force-up treap)))))
(recur treap +op-identity+)))
(defun treap-range-bisect-from-end (treap value &key (order #'<))
(labels
((recur (treap prev-sum)
(unless treap
(return-from recur))
(let ((sum prev-sum))
(prog1
(cond ((not (funcall order
(setq sum (op (treap-accumulator (%treap-right treap)) sum))
value))
(if (%treap-right treap)
(recur (%treap-right treap) prev-sum)
(%treap-key treap)))
((not (funcall order
(setq sum (op (%treap-value treap) sum))
value))
(%treap-key treap))
(t
(recur (%treap-left treap) sum)))
(force-up treap)))))
(recur treap +op-identity+)))
(defmacro dbg (&rest forms)
#+swank
(if (= (length forms) 1)
`(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
`(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
#-swank (declare (ignore forms)))
(defmacro define-int-types (&rest bits)
`(progn
,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits)
,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits)))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64)
(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
(let ((*read-default-float-format* 'double-float))
(prog1 (princ obj stream) (terpri stream))))
(defconstant +mod+ 1000000007)
;;;
;;; Body
;;;
(defun main ()
(let* ((n (read))
(q (read))
treap-xw
treap-w)
(dotimes (i n)
(let ((x (read-fixnum))
(w (read-fixnum)))
(setq treap-xw (treap-insert treap-xw x (* x w))
treap-w (treap-insert treap-w x w))))
(with-buffered-stdout
(dotimes (i q)
(let ((x (read-fixnum)))
(println (+ (- (treap-query treap-xw :left x)
(* x (treap-query treap-w :left x)))
(- (* x (treap-query treap-w :right x))
(treap-query treap-xw :right x)))))))))
#-swank (main)
;;;
;;; Test and benchmark
;;;
#+swank
(defun io-equal (in-string out-string &key (function #'main) (test #'equal))
"Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true if
the string output to *STANDARD-OUTPUT* is equal to OUT-STRING."
(labels ((ensure-last-lf (s)
(if (eql (uiop:last-char s) #\Linefeed)
s
(uiop:strcat s uiop:+lf+))))
(funcall test
(ensure-last-lf out-string)
(with-output-to-string (out)
(let ((*standard-output* out))
(with-input-from-string (*standard-input* (ensure-last-lf in-string))
(funcall function)))))))
#+swank
(defun get-clipbrd ()
(with-output-to-string (out)
(run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)))
#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))
#+swank
(defun run (&optional thing (out *standard-output*))
"THING := null | string | symbol | pathname
null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
(let ((*standard-output* out))
(etypecase thing
(null
(with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
(main)))
(string
(with-input-from-string (*standard-input* (delete #\Return thing))
(main)))
(symbol (5am:run! thing))
(pathname
(with-open-file (*standard-input* thing)
(main))))))
#+swank
(defun gen-dat ()
(uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
(format out "")))
#+swank
(defun bench (&optional (out (make-broadcast-stream)))
(time (run *dat-pathname* out)))