結果
| 問題 | No.875 Range Mindex Query |
| ユーザー |
 sansaqua
|
| 提出日時 | 2019-09-10 22:10:09 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 145 ms / 2,000 ms |
| コード長 | 21,946 bytes |
| コンパイル時間 | 314 ms |
| コンパイル使用メモリ | 94,100 KB |
| 実行使用メモリ | 32,128 KB |
| 最終ジャッジ日時 | 2024-07-02 16:26:02 |
| 合計ジャッジ時間 | 2,402 ms |
|
ジャッジサーバーID （参考情報） |
judge1 / judge3 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 9 ms
24,064 KB |
| testcase_01 | AC | 9 ms
24,192 KB |
| testcase_02 | AC | 10 ms
24,064 KB |
| testcase_03 | AC | 10 ms
24,192 KB |
| testcase_04 | AC | 9 ms
23,936 KB |
| testcase_05 | AC | 9 ms
24,192 KB |
| testcase_06 | AC | 9 ms
24,192 KB |
| testcase_07 | AC | 9 ms
24,192 KB |
| testcase_08 | AC | 9 ms
24,192 KB |
| testcase_09 | AC | 10 ms
24,064 KB |
| testcase_10 | AC | 10 ms
24,064 KB |
| testcase_11 | AC | 145 ms
30,208 KB |
| testcase_12 | AC | 112 ms
28,544 KB |
| testcase_13 | AC | 102 ms
30,848 KB |
| testcase_14 | AC | 101 ms
30,464 KB |
| testcase_15 | AC | 134 ms
31,104 KB |
| testcase_16 | AC | 122 ms
31,744 KB |
| testcase_17 | AC | 132 ms
32,128 KB |
| testcase_18 | AC | 129 ms
32,128 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 02 JUL 2024 04:25:58 PM): ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.256
ソースコード
;; -*- coding: utf-8 -*-
(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
#\# #\> (lambda (s c p) (declare (ignore c p)) (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
;; DEFINE-INTEGER-PACK and DEFINE-CONS-PACK are so to say poor man's variants of
;; DEFSTRUCT. Both "structures" can only have slots of fixed unsigned
;; bytes. DEFINE-INTEGER-PACK handles the concatenated slots as UNSIGNED-BYTE
;; and DEFINE-CONS-PACK handles them as (CONS (UNSIGNED-BYTE 62) (UNSIGNED-BYTE
;; 62)).
;; Example:
;; The following form defines the type NODE as (UNSIGNED-BYTE 9):
;; (define-integer-pack node (slot1 3) (slot2 5) (slot3 1))
;; This macro in addition defines relevant utilities: NODE-SLOT1, NODE-SLOT2,
;; NODE-SLOT3, setters and getters, PACK-NODE, the constructor, and
;; WITH-UNPACKING-NODE, the destructuring-bind-style macro.
;;
;; DEFINE-CONS-PACK is almost the same as DEFINE-INTEGER-PACK though it will be
;; suitable for the total bits in the range [63, 124].
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun %concat-name (&rest args)
(if (cdr args)
(format nil "~A-~A"
(car args)
(apply #'%concat-name (cdr args)))
(car args)))
(defun %concat+name+ (&rest args)
(format nil "+~A+" (apply #'%concat-name args))))
(defmacro define-integer-pack (name &rest slot-descriptions)
(assert slot-descriptions () "~A has no slots." name)
(let* ((packer-name (intern (%concat-name "PACK" name)))
(unpacker-macro-name (intern (%concat-name "WITH-UNPACKING" name)))
(total-size 0)
(slots (loop with position = 0
for (slot-name slot-size) in slot-descriptions
collect (progn (check-type slot-name symbol)
(check-type slot-size (integer 1))
(list slot-name slot-size position))
do (incf position slot-size)
finally (setq total-size position)))
(revslots (reverse slots))
(new-value (gensym "NEW-VALUE"))
(tmp (gensym)))
`(progn
(deftype ,name () '(unsigned-byte ,total-size))
;; define most positive integer for every slot as constant
,@(loop for (slot-name slot-size _) in slots
collect `(defconstant ,(intern (%concat+name+ "MAX" name slot-name))
(- (ash 1 ,slot-size) 1)))
;; setter and getter
,@(loop for (slot-name slot-size slot-position) in slots
for accessor-name = (intern (%concat-name name slot-name))
append `((declaim (inline ,accessor-name
(setf ,accessor-name)))
(defun ,accessor-name (,name)
(declare (type ,name ,name))
(ldb (byte ,slot-size ,slot-position) ,name))
(defun (setf ,accessor-name) (,new-value ,name)
(declare (type ,name ,name))
(setf (ldb (byte ,slot-size ,slot-position) ,name) ,new-value))))
;; constructor
(declaim (inline ,packer-name))
(defun ,packer-name ,(loop for slot in slots collect (car slot))
(declare ,@(loop for (slot-name slot-size _) in slots
collect `(type (unsigned-byte ,slot-size) ,slot-name )))
(let ((,tmp ,(caar revslots)))
(declare (type (unsigned-byte ,total-size) ,tmp))
,@(loop for (slot-name slot-size _) in (cdr revslots)
collect `(setq ,tmp (logxor ,slot-name
(the (unsigned-byte ,total-size)
(ash ,tmp ,slot-size)))))
,tmp))
;; destructuring-bind-style macro
(defmacro ,unpacker-macro-name (vars ,name &body body)
(check-type vars list)
(assert (= (length vars) ,(length slots)))
`(let ((,',tmp ,,name))
(declare (type (unsigned-byte ,,total-size) ,',tmp))
(let* ,(loop for var in vars
for rest on ',slots
for (slot-name slot-size _) = (car rest)
collect `(,var
(prog1 (the (unsigned-byte ,slot-size)
(ldb (byte ,slot-size 0) ,',tmp))
,@(when (cdr rest)
`((setq ,',tmp (ash ,',tmp ,(- slot-size))))))))
,@body))))))
(define-integer-pack node (value 31) (index 31))
;; Should we do this with UNWIND-PROTECT?
(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*))
(declare #.OPT)
(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 #\-))
(setf 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))))))))
;;;
;;; Implicit treap
;;; (treap with implicit key)
;;;
;; Note:
;; - An empty treap is NIL.
;; value . index
(declaim (inline op))
(defun op (a b)
(declare (node a b))
"Is a binary operator comprising a monoid."
(if (< (node-value a) (node-value b))
a
b))
(sb-int:defconstant-eqx +op-identity+ most-positive-fixnum
#'eql
"identity element w.r.t. OP")
(defstruct (itreap (:constructor %make-itreap (value priority &key left right (count 1) (accumulator value)))
(:copier nil)
(:conc-name %itreap-))
(value +op-identity+ :type node)
(accumulator +op-identity+ :type node)
(priority 0 :type (integer 0 #.most-positive-fixnum))
(count 1 :type (integer 0 #.most-positive-fixnum)) ; size of (sub)treap
(left nil :type (or null itreap))
(right nil :type (or null itreap)))
(declaim (inline itreap-count))
(defun itreap-count (itreap)
"Returns the number of the elements."
(declare ((or null itreap) itreap))
(if itreap
(%itreap-count itreap)
0))
(declaim (inline itreap-accumulator))
(defun itreap-accumulator (itreap)
"Returns the sum (w.r.t. OP) of the whole ITREAP:
ITREAP[0]+ITREAP[1]+...+ITREAP[SIZE-1]."
(declare ((or null itreap) itreap))
(if itreap
(%itreap-accumulator itreap)
+op-identity+))
(declaim (inline update-count))
(defun update-count (itreap)
(declare (itreap itreap))
(setf (%itreap-count itreap)
(+ 1
(itreap-count (%itreap-left itreap))
(itreap-count (%itreap-right itreap)))))
(declaim (inline update-accumulator))
(defun update-accumulator (itreap)
(declare (itreap itreap))
(setf (%itreap-accumulator itreap)
(if (%itreap-left itreap)
(if (%itreap-right itreap)
(let ((mid (op (%itreap-accumulator (%itreap-left itreap))
(%itreap-value itreap))))
(declare (dynamic-extent mid))
(op mid (%itreap-accumulator (%itreap-right itreap))))
(op (%itreap-accumulator (%itreap-left itreap))
(%itreap-value itreap)))
(if (%itreap-right itreap)
(op (%itreap-value itreap)
(%itreap-accumulator (%itreap-right itreap)))
(%itreap-value itreap)))))
(declaim (inline force-up))
(defun force-up (itreap)
"Propagates up the information from children."
(declare (itreap itreap))
(update-count itreap)
(update-accumulator itreap))
(defun %heapify (top)
"Properly swaps the priorities of the node and its two children."
(declare (optimize (speed 3) (safety 0)))
(when top
(let ((high-priority-node top))
(when (and (%itreap-left top)
(> (%itreap-priority (%itreap-left top))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-left top)))
(when (and (%itreap-right top)
(> (%itreap-priority (%itreap-right top))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-right top)))
(unless (eql high-priority-node top)
(rotatef (%itreap-priority high-priority-node)
(%itreap-priority top))
(%heapify high-priority-node)))))
(declaim (inline make-itreap))
(defun make-itreap (size &key initial-contents)
"Makes a treap of SIZE in O(SIZE) time. Its values are filled with the
identity element unless INITIAL-CONTENTS are supplied."
(declare ((or null vector) initial-contents))
(labels ((build (l r)
(declare ((integer 0 #.most-positive-fixnum) l r))
(if (= l r)
nil
(let* ((mid (ash (+ l r) -1))
(node (%make-itreap (if initial-contents
(aref initial-contents mid)
+op-identity+)
(random most-positive-fixnum))))
(setf (%itreap-left node) (build l mid))
(setf (%itreap-right node) (build (+ mid 1) r))
(%heapify node)
(force-up node)
node))))
(build 0 size)))
(define-condition invalid-itreap-index-error (type-error)
((itreap :initarg :itreap :reader invalid-itreap-index-error-itreap)
(index :initarg :index :reader invalid-itreap-index-error-index))
(:report
(lambda (condition stream)
(let ((index (invalid-itreap-index-error-index condition)))
(if (consp index)
(format stream "Invalid range [~W, ~W) for itreap ~W."
(car index)
(cdr index)
(invalid-itreap-index-error-itreap condition))
(format stream "Invalid index ~W for itreap ~W."
index
(invalid-itreap-index-error-itreap condition)))))))
(defun itreap-split (itreap index)
"Destructively splits the ITREAP into two nodes [0, INDEX) and [INDEX, N),
where N is the number of elements of the ITREAP."
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) index))
(unless (<= index (itreap-count itreap))
(error 'invalid-itreap-index-error :index index :itreap itreap))
(labels ((recur (itreap ikey)
(unless itreap
(return-from itreap-split (values nil nil)))
(let ((left-count (itreap-count (%itreap-left itreap))))
(if (<= ikey left-count)
(multiple-value-bind (left right)
(itreap-split (%itreap-left itreap) ikey)
(setf (%itreap-left itreap) right)
(force-up itreap)
(values left itreap))
(multiple-value-bind (left right)
(itreap-split (%itreap-right itreap) (- ikey left-count 1))
(setf (%itreap-right itreap) left)
(force-up itreap)
(values itreap right))))))
(recur itreap index)))
(defun itreap-merge (left right)
"Destructively concatenates two ITREAPs."
(declare (optimize (speed 3))
((or null itreap) left right))
(cond ((null left) (when right (force-up right)) right)
((null right) (when left (force-up left)) left)
(t (if (> (%itreap-priority left) (%itreap-priority right))
(progn
(setf (%itreap-right left)
(itreap-merge (%itreap-right left) right))
(force-up left)
left)
(progn
(setf (%itreap-left right)
(itreap-merge left (%itreap-left right)))
(force-up right)
right)))))
(defun itreap-insert (itreap index obj)
"Destructively inserts OBJ into ITREAP and returns the resultant treap.
You cannot rely on the side effect. Use the returned value."
(declare (optimize (speed 3))
((or null itreap) itreap)
((integer 0 #.most-positive-fixnum) index))
(unless (<= index (itreap-count itreap))
(error 'invalid-itreap-index-error :itreap itreap :index index))
(let ((node (%make-itreap obj (random most-positive-fixnum))))
(labels ((recur (itreap ikey)
(declare ((integer 0 #.most-positive-fixnum) ikey))
(unless itreap (return-from recur node))
(if (> (%itreap-priority node) (%itreap-priority itreap))
(progn
(setf (values (%itreap-left node) (%itreap-right node))
(itreap-split itreap ikey))
(force-up node)
node)
(let ((left-count (itreap-count (%itreap-left itreap))))
(if (<= ikey left-count)
(setf (%itreap-left itreap)
(recur (%itreap-left itreap) ikey))
(setf (%itreap-right itreap)
(recur (%itreap-right itreap) (- ikey left-count 1))))
(force-up itreap)
itreap))))
(recur itreap index))))
(defun itreap-delete (itreap index)
"Destructively deletes the object at INDEX in ITREAP.
You cannot rely on the side effect. Use the returned value."
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) index))
(unless (< index (itreap-count itreap))
(error 'invalid-itreap-index-error :itreap itreap :index index))
(labels ((recur (itreap ikey)
(declare ((integer 0 #.most-positive-fixnum) ikey))
(let ((left-count (itreap-count (%itreap-left itreap))))
(cond ((< ikey left-count)
(setf (%itreap-left itreap)
(recur (%itreap-left itreap) ikey))
(force-up itreap)
itreap)
((> ikey left-count)
(setf (%itreap-right itreap)
(recur (%itreap-right itreap) (- ikey left-count 1)))
(force-up itreap)
itreap)
(t
(itreap-merge (%itreap-left itreap) (%itreap-right itreap)))))))
(recur itreap index)))
(defmacro itreap-push (obj itreap pos)
"Pushes OBJ to ITREAP at POS."
`(setf ,itreap (itreap-insert ,itreap ,pos ,obj)))
(defmacro itreap-pop (itreap pos)
"Returns the object at POS and deletes it."
(let ((p (gensym)))
`(let ((,p ,pos))
(prog1 (itreap-ref ,itreap ,p)
(setf ,itreap (itreap-delete ,itreap ,p))))))
(declaim (inline itreap-map))
(defun itreap-map (function itreap)
"Successively applies FUNCTION to ITREAP[0], ..., ITREAP[SIZE-1]."
(declare (function function))
(labels ((recur (node)
(when node
(recur (%itreap-left node))
(funcall function (%itreap-value node))
(recur (%itreap-right node))
(force-up node))))
(recur itreap)))
(defmethod print-object ((object itreap) stream)
(print-unreadable-object (object stream :type t)
(let ((init t))
(itreap-map (lambda (x)
(if init
(setq init nil)
(write-char #\ stream))
(write x :stream stream))
object))))
(defmacro do-itreap ((var itreap &optional result) &body body)
"Successively binds ITREAP[0], ..., ITREAP[SIZE-1] to VAR and executes BODY
each time."
`(block nil
(itreap-map (lambda (,var) ,@body) ,itreap)
,result))
(defun itreap (&rest args)
;; NOTE: It takes O(nlog(n)). Use MAKE-ITREAP for efficiency.
(labels ((recur (list position itreap)
(declare ((integer 0 #.most-positive-fixnum) position))
(if (null list)
itreap
(recur (cdr list)
(1+ position)
(itreap-insert itreap position (car list))))))
(recur args 0 nil)))
(declaim (inline itreap-ref))
(defun itreap-ref (itreap index)
"Returns the element ITREAP[INDEX]."
(declare ((integer 0 #.most-positive-fixnum) index))
(labels ((%ref (itreap index)
(declare ((integer 0 #.most-positive-fixnum) index))
(prog1
(let ((left-count (itreap-count (%itreap-left itreap))))
(cond ((< index left-count)
(%ref (%itreap-left itreap) index))
((> index left-count)
(%ref (%itreap-right itreap) (- index left-count 1)))
(t (%itreap-value itreap))))
(force-up itreap))))
(%ref itreap index)))
(declaim (inline (setf itreap-ref)))
(defun (setf itreap-ref) (new-value itreap index)
"Sets ITREAP[INDEX] to the given value."
(declare ((integer 0 #.most-positive-fixnum) index))
(labels ((%set (itreap index)
(declare ((integer 0 #.most-positive-fixnum) index))
(prog1
(let ((left-count (itreap-count (%itreap-left itreap))))
(cond ((< index left-count)
(%set (%itreap-left itreap) index))
((> index left-count)
(%set (%itreap-right itreap) (- index left-count 1)))
(t (setf (%itreap-value itreap) new-value))))
(force-up itreap))))
(%set itreap index)
new-value))
(declaim (inline itreap-query))
(defun itreap-query (itreap l r)
"Queries the `sum' (w.r.t. OP) of the interval [L, R)."
(declare ((integer 0 #.most-positive-fixnum) l r))
(labels
((recur (itreap l r)
(declare ((integer 0 #.most-positive-fixnum) l r))
(unless itreap
(return-from recur +op-identity+))
(if (and (zerop l) (= r (%itreap-count itreap)))
(itreap-accumulator itreap)
(let ((left-count (itreap-count (%itreap-left itreap))))
(if (<= l left-count)
(if (< left-count r)
;; LEFT-COUNT is in [L, R)
(op (op (recur (%itreap-left itreap) l (min r left-count))
(%itreap-value itreap))
(recur (%itreap-right itreap) 0 (- r left-count 1)))
;; LEFT-COUNT is in [R, END)
(recur (%itreap-left itreap) l (min r left-count)))
;; LEFT-COUNT is in [0, L)
(recur (%itreap-right itreap) (- l left-count 1) (- r left-count 1)))))))
(recur itreap l r)))
(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 ()
(declare #.OPT)
(let* ((n (read))
(q (read))
(as (make-array n :element-type 'uint62)))
(declare (uint32 n q))
(dotimes (i n)
(setf (aref as i) (pack-node (read-fixnum) (+ i 1))))
(let ((dp (make-itreap n :initial-contents as)))
(with-buffered-stdout
(dotimes (_ q)
(let* ((kind (read-fixnum))
(l (- (read-fixnum) 1))
(r (- (read-fixnum) 1)))
(if (= kind 1)
(let ((lval (itreap-ref dp l))
(rval (itreap-ref dp r)))
(setf (itreap-ref dp l) (pack-node (node-value rval) (node-index lval))
(itreap-ref dp r) (pack-node (node-value lval) (node-index rval))))
(println (node-index (itreap-query dp l (+ r 1)))))))))))
#-swank (main)