結果

問題 No.885 アマリクエリ
ユーザー sansaquasansaqua
提出日時 2019-09-14 10:42:23
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 345 ms / 2,000 ms
コード長 8,883 bytes
コンパイル時間 611 ms
コンパイル使用メモリ 52,160 KB
実行使用メモリ 55,612 KB
最終ジャッジ日時 2023-09-19 05:17:30
合計ジャッジ時間 3,642 ms
ジャッジサーバーID
(参考情報)
judge13 / judge12
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 45 ms
27,664 KB
testcase_01 AC 327 ms
48,268 KB
testcase_02 AC 107 ms
33,992 KB
testcase_03 AC 58 ms
25,600 KB
testcase_04 AC 60 ms
27,604 KB
testcase_05 AC 47 ms
29,332 KB
testcase_06 AC 32 ms
27,668 KB
testcase_07 AC 42 ms
37,404 KB
testcase_08 AC 40 ms
25,620 KB
testcase_09 AC 345 ms
55,612 KB
testcase_10 AC 12 ms
27,220 KB
testcase_11 AC 10 ms
25,228 KB
testcase_12 AC 12 ms
25,228 KB
testcase_13 AC 13 ms
25,424 KB
testcase_14 AC 13 ms
25,468 KB
testcase_15 AC 14 ms
27,488 KB
testcase_16 AC 12 ms
28,604 KB
testcase_17 AC 11 ms
25,328 KB
testcase_18 AC 12 ms
27,272 KB
testcase_19 AC 11 ms
25,212 KB
testcase_20 AC 11 ms
27,340 KB
testcase_21 AC 12 ms
27,276 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 19 SEP 2023 05:17:26 AM):
; processing (SB-INT:DEFCONSTANT-EQX OPT ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DISABLE-DEBUGGER)
; processing (DEFSTRUCT (TREAP # ...) ...)
; processing (DECLAIM (INLINE TREAP-SPLIT) ...)
; 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 (DECLAIM (INLINE TREAP-MAP))
; processing (DEFUN TREAP-MAP ...)
; processing (DEFMETHOD PRINT-OBJECT ...)
; processing (DEFMACRO DO-TREAP ...)
; processing (DEFMACRO WITH-BUFFERED-STDOUT ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (DEFMACRO DBG ...)
; processing (DEFMACRO DEFINE-INT-TYPES ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFUN MAIN ...)
; processing (MAIN)

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.251

ソースコード

diff #

;; -*- 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
;;;
;;; Treap with explicit key
;;; Virtually it works like std::map, std::multiset, or java.util.TreeMap.
;;;


;; Tips to use this structure as 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.

;; Treap with explicit key
(defstruct (treap (:constructor %make-treap (key priority value &key left right))
                  (:copier nil)
                  (:conc-name %treap-))
  (key 0 :type fixnum)
  (value 0 :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-split)
         (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))
  (labels ((recur (treap)
             (if (null treap)
                 (values nil nil)
                 (if (funcall order (%treap-key treap) key)
                     (multiple-value-bind (left right)
                         (recur (%treap-right treap))
                       (setf (%treap-right treap) left)
                       (values treap right))
                     (multiple-value-bind (left right)
                         (recur (%treap-left treap))
                       (setf (%treap-left treap) right)
                       (values left treap))))))
    (recur 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))
  (let ((node (%make-treap key (random most-positive-fixnum) value)))
    (labels ((recur (treap)
               (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))
                     node)
                   (progn
                     (if (funcall order (%treap-key node) (%treap-key treap))
                         (setf (%treap-left treap)
                               (recur (%treap-left treap)))
                         (setf (%treap-right treap)
                               (recur (%treap-right treap))))
                     treap))))
      (recur 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))
                      t))
                   ((funcall order (%treap-key treap) key)
                    (when (find-and-update (%treap-right treap))
                      t))
                   (t (setf (%treap-value treap)
                            (if if-exists
                                (funcall if-exists (%treap-value treap))
                                value))
                      t))))
    (if (find-and-update treap)
        treap
        (treap-insert treap key value :order order))))

(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)))))
    (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))

;; 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))))))))

(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))
         treap
         (sum 0))
    (declare (uint62 n sum))
    (dotimes (i n)
      (let ((a (read-fixnum)))
        (incf sum a)
        (setq treap (treap-ensure-key treap a 1 :if-exists #'1+))))
    (let ((q (read)))
      (declare (uint32 q))
      (with-buffered-stdout
        (dotimes (i q)
          (let ((x (read-fixnum)))
            (multiple-value-bind (left right) (treap-split treap x)
              (setq treap left)
              (do-treap (key count right)
                (declare (uint31 key count))
                (let ((new-key (mod key x)))
                  (declare (uint31 new-key))
                  (setq treap (treap-ensure-key treap new-key count :if-exists (lambda (i) (+ i count))))
                  (decf sum (* count (- key new-key)))))
              (println sum))))))))

#-swank (main)
0