結果
| 問題 | No.1300 Sum of Inversions |
| ユーザー |
 sansaqua
|
| 提出日時 | 2020-11-29 21:01:14 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
WA
|
| 実行時間 | - |
| コード長 | 28,866 bytes |
| コンパイル時間 | 1,563 ms |
| コンパイル使用メモリ | 85,076 KB |
| 実行使用メモリ | 59,904 KB |
| 最終ジャッジ日時 | 2023-10-11 02:37:26 |
| 合計ジャッジ時間 | 25,845 ms |
|
ジャッジサーバーID （参考情報） |
judge11 / judge12 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 12 ms
25,772 KB |
| testcase_01 | AC | 12 ms
25,728 KB |
| testcase_02 | AC | 13 ms
28,912 KB |
| testcase_03 | WA | - |
| testcase_04 | WA | - |
| testcase_05 | WA | - |
| testcase_06 | WA | - |
| testcase_07 | WA | - |
| testcase_08 | WA | - |
| testcase_09 | WA | - |
| testcase_10 | WA | - |
| testcase_11 | WA | - |
| testcase_12 | WA | - |
| testcase_13 | WA | - |
| testcase_14 | WA | - |
| testcase_15 | WA | - |
| testcase_16 | WA | - |
| testcase_17 | WA | - |
| testcase_18 | WA | - |
| testcase_19 | WA | - |
| testcase_20 | WA | - |
| testcase_21 | WA | - |
| testcase_22 | WA | - |
| testcase_23 | WA | - |
| testcase_24 | WA | - |
| testcase_25 | WA | - |
| testcase_26 | WA | - |
| testcase_27 | WA | - |
| testcase_28 | WA | - |
| testcase_29 | WA | - |
| testcase_30 | WA | - |
| testcase_31 | WA | - |
| testcase_32 | WA | - |
| testcase_33 | AC | 224 ms
56,768 KB |
| testcase_34 | AC | 271 ms
56,752 KB |
| testcase_35 | AC | 140 ms
58,760 KB |
| testcase_36 | AC | 154 ms
59,904 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 11 OCT 2023 02:37:00 AM): ; processing (IN-PACKAGE :CL-USER) ; processing (DEFPARAMETER *OPT* ...) ; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...) ; processing (SETQ *RANDOM-STATE* ...) ; processing (DEFINE-INT-TYPES 2 ...) ; processing (DEFCONSTANT +MOD+ ...) ; processing (DEFMACRO DBG ...) ; processing (DECLAIM (INLINE PRINTLN)) ; processing (DEFUN PRINTLN ...) ; processing (DEFPACKAGE :CP/MOD-OPERATIONS ...) ; processing (IN-PACKAGE :CP/MOD-OPERATIONS) ; processing (DEFMACRO DEFINE-MOD-OPERATIONS ...) ; processing (DEFINE-MOD-OPERATIONS COMMON-LISP-USER::+MOD+ ...) ; processing (DEFPACKAGE :CP/READ-FIXNUM ...) ; processing (IN-PACKAGE :CP/READ-FIXNUM) ; processing (DECLAIM (FTYPE # ...)) ; processing (DEFUN READ-FIXNUM ...) ; processing (DEFPACKAGE :CP/IMPLICIT-TREAP ...) ; processing (IN-PACKAGE :CP/IMPLICIT-TREAP) ; processing (DECLAIM (INLINE OP)) ; processing (DEFUN OP ...) ; processing (DEFCONSTANT +OP-IDENTITY+ ...) ; processing (DEFCONSTANT +UPDATER-IDENTITY+ ...) ; processing (DEFSTRUCT (ITREAP # ...) ...) ; processing (DECLAIM (INLINE ITREAP-COUNT)) ; processing (DEFUN ITREAP-COUNT ...) ; processing (DECLAIM (INLINE ITREAP-ACCUMULATOR)) ; processing (DEFUN ITREAP-ACCUMULATOR ...) ; processing (DECLAIM (INLINE UPDATE-COUNT)) ; processing (DEFUN UPDATE-COUNT ...) ; processing (DECLAIM (INLINE UPDATE-ACCUMULATOR)) ; processing (DEFUN UPDATE-ACCUMULATOR ...) ; processing (DECLAIM (INLINE FORCE-UP)) ; processing (DEFUN FORCE-UP ...) ; processing (DEFUN %HEAPIFY ...) ; processing (DECLAIM (INLINE MAKE-ITREAP)) ; processing (DEFUN MAKE-ITREAP ...) ; processing (DEFINE-CONDITION INVALID-ITREAP-INDEX-ERROR ...) ; processing (DEFUN ITREAP-SPLIT ...) ; processing (DEFUN ITREAP-MERGE ...) ; processing (DEFUN ITREAP-INSERT ...) ; processing (DEFUN ITREAP-DELETE ...) ; processing (DEFMACRO ITREAP-PUSH ...) ; processing (DEFMACRO ITREAP-POP ...) ; processing (DECLAIM (INLINE ITREAP-MAP)) ; processing (DEFU
ソースコード
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *opt*
#+swank '(optimize (speed 3) (safety 2))
#-swank '(optimize (speed 3) (safety 0) (debug 0)))
#+swank (ql:quickload '(:cl-debug-print :fiveam :cp/util) :silent t)
#+swank (use-package :cp/util :cl-user)
#-swank (set-dispatch-macro-character
#\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))
#+sbcl (setq *random-state* (seed-random-state (nth-value 1 (get-time-of-day)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)
(macrolet ((def (b)
`(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
(define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(def ,b)) bits))))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64))
(defconstant +mod+ 998244353)
(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)))
(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
(let ((*read-default-float-format*
(if (typep obj 'double-float) 'double-float *read-default-float-format*)))
(prog1 (princ obj stream) (terpri stream))))
;; BEGIN_INSERTED_CONTENTS
;;;
;;; Arithmetic operations with static modulus
;;;
(defpackage :cp/mod-operations
(:use :cl)
(:export #:define-mod-operations))
(in-package :cp/mod-operations)
(defmacro define-mod-operations
(divisor &optional (package #+sbcl (sb-int:sane-package) #-sbcl *package*))
(let ((mod* (intern "MOD*" package))
(mod+ (intern "MOD+" package))
(mod- (intern "MOD-" package))
(incfmod (intern "INCFMOD" package))
(decfmod (intern "DECFMOD" package))
(mulfmod (intern "MULFMOD" package)))
`(progn
(defun ,mod* (&rest args)
(cond ((cdr args) (reduce (lambda (x y) (mod (* x y) ,divisor)) args))
(args (mod (car args) ,divisor))
(t 1)))
(defun ,mod+ (&rest args)
(cond ((cdr args) (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))
(args (mod (car args) ,divisor))
(t 0)))
(defun ,mod- (&rest args)
(if (cdr args)
(reduce (lambda (x y) (mod (- x y) ,divisor)) args)
(mod (- (car args)) ,divisor)))
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(locally (declare (sb-ext:muffle-conditions warning))
(sb-c:define-source-transform ,mod* (&rest args)
(case (length args)
(0 1)
(1 `(mod ,(car args) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args))))
(sb-c:define-source-transform ,mod+ (&rest args)
(case (length args)
(0 0)
(1 `(mod ,(car args) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args))))
(sb-c:define-source-transform ,mod- (&rest args)
(case (length args)
(0 (values nil t))
(1 `(mod (- ,(car args)) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (- ,x ,y) ,',divisor)) args))))))
(define-modify-macro ,incfmod (delta)
(lambda (x y) (mod (+ x y) ,divisor)))
(define-modify-macro ,decfmod (delta)
(lambda (x y) (mod (- x y) ,divisor)))
(define-modify-macro ,mulfmod (multiplier)
(lambda (x y) (mod (* x y) ,divisor))))))
(define-mod-operations cl-user::+mod+ :cl-user)
(defpackage :cp/read-fixnum
(:use :cl)
(:export #:read-fixnum))
(in-package :cp/read-fixnum)
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
"NOTE: cannot read -2^62"
(declare #.cl-user::*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 #\-))
(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))))))))
;;;
;;; Implicit treap
;;; (treap with implicit key)
;;;
;; TODO: abstraction
(defpackage :cp/implicit-treap
(:use :cl)
(:export #:itreap #:itreap-p #:itreap-count #:itreap-accumulator
#:make-itreap #:invalid-itreap-index-error #:itreap-ref
#:itreap-split #:itreap-merge #:itreap-insert #:itreap-delete
#:itreap-push #:itreap-pop #:itreap-map #:do-itreap
#:itreap-fold #:itreap-fold-bisect #:itreap-fold-bisect-from-end
#:itreap-update #:itreap-reverse
#:itreap-bisect-left #:itreap-bisect-right #:itreap-insort))
(in-package :cp/implicit-treap)
;; Note:
;; - An empty treap is NIL.
(declaim (inline op))
(defun op (a b)
"Is a binary operator comprising a monoid."
(declare ((unsigned-byte 31) a b))
(let ((res (+ a b)))
(the (unsigned-byte 31)
(if (>= res cl-user::+mod+)
(- res cl-user::+mod+)
res))))
(defconstant +op-identity+ 0
"identity element w.r.t. OP")
(defconstant +updater-identity+ 0
"identity element w.r.t. UPDATER-OP")
(defstruct (itreap (:constructor %make-itreap (value priority &key left right (count 1) (accumulator value)))
(:copier nil)
(:conc-name %itreap-))
(value +op-identity+ :type (unsigned-byte 31))
(accumulator +op-identity+ :type (unsigned-byte 31))
(priority 0 :type (integer 0 #.most-positive-fixnum))
(count 1 :type (mod #.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 of ITREAP."
(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))))
(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 (node)
"Makes it max-heap w.r.t. priorities by swapping the priorities of the whole
treap."
(declare (optimize (speed 3) (safety 0)))
(when node
(let ((high-priority-node node))
(when (and (%itreap-left node)
(> (%itreap-priority (%itreap-left node))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-left node)))
(when (and (%itreap-right node)
(> (%itreap-priority (%itreap-right node))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-right node)))
(unless (eql high-priority-node node)
(rotatef (%itreap-priority high-priority-node)
(%itreap-priority node))
(%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 ITREAP at INDEX and returns two treaps (in ascending
order)."
(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. Note that this `merge' is different
from CL:MERGE and rather close to CL:CONCATENATE."
(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 at INDEX and returns the resultant treap.
You cannot rely on the side effect. Use the returned value."
(declare #.cl-user::*opt*
((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: This function takes O(nlog(n)) time. 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))
(unless (< index (itreap-count itreap))
(error 'invalid-itreap-index-error :itreap itreap :index 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))
(unless (< index (itreap-count itreap))
(error 'invalid-itreap-index-error :itreap itreap :index 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-fold))
(defun itreap-fold (itreap l r)
"Returns the `sum' (w.r.t. OP) of the range ITREAP[L, R)."
(declare ((integer 0 #.most-positive-fixnum) l r))
(unless (<= l r (itreap-count itreap))
(error 'invalid-itreap-index-error :itreap itreap :index (cons l r)))
(labels
((recur (itreap l r)
(declare ((integer 0 #.most-positive-fixnum) l r))
(unless itreap
(return-from recur +op-identity+))
(prog1
(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)))))
(force-up itreap))))
(recur itreap l r)))
;; FIXME: might be problematic when two priorities collide and START is not
;; zero. (It will be negligible from the viewpoint of probability, however.)
(declaim (inline itreap-fold-bisect))
(defun itreap-fold-bisect (itreap test &optional (start 0))
"Returns the largest index that satisfies (FUNCALL TEST (OP ITREAP[START]
ITREAP[START+1] ... ITREAP[index-1])).
Note:
- (FUNCALL TEST +OP-IDENTITY+) must be true.
- TEST must be monotone in the target range.
"
(declare ((integer 0 #.most-positive-fixnum) start))
(assert (funcall test +op-identity+))
(multiple-value-bind (itreap-prefix itreap)
(if (zerop start)
(values nil itreap)
(itreap-split itreap start))
(labels
((recur (itreap offset prev-sum)
(declare ((integer 0 #.most-positive-fixnum) offset)
#+sbcl (values (integer 0 #.most-positive-fixnum)))
(unless itreap
(return-from recur offset))
(let ((sum prev-sum))
(prog1
(cond ((not (funcall test (setq sum (op sum (itreap-accumulator (%itreap-left itreap))))))
(recur (%itreap-left itreap) offset prev-sum))
((not (funcall test (setq sum (op sum (%itreap-value itreap)))))
(+ offset (itreap-count (%itreap-left itreap))))
(t
(recur (%itreap-right itreap)
(+ offset (itreap-count (%itreap-left itreap)) 1)
sum)))
(force-up itreap)))))
(prog1 (+ start (recur itreap 0 +op-identity+))
(itreap-merge itreap-prefix itreap)))))
(declaim (inline itreap-fold-bisect-from-end))
(defun itreap-fold-bisect-from-end (itreap test &optional end)
"Returns the smallest index that satisfies (FUNCALL TEST (OP ITREAP[index]
ITREAP[index+1] ... ITREAP[END-1])).
Note:
- (FUNCALL TEST +OP-IDENTITY+) must be true.
- TEST must be monotone in the target range.
"
(declare ((or null (integer 0 #.most-positive-fixnum)) end))
(assert (funcall test +op-identity+))
(multiple-value-bind (itreap itreap-suffix)
(if end
(itreap-split itreap end)
(values itreap nil))
(labels
((recur (itreap offset prev-sum)
(declare ((integer 0 #.most-positive-fixnum) offset)
#+sbcl (values (integer 0 #.most-positive-fixnum)))
(unless itreap
(return-from recur offset))
(let ((sum prev-sum))
(prog1
(cond ((not (funcall test (setq sum (op (itreap-accumulator (%itreap-right itreap)) sum))))
(recur (%itreap-right itreap) offset prev-sum))
((not (funcall test (setq sum (op (%itreap-value itreap) sum))))
(+ offset (itreap-count (%itreap-right itreap))))
(t
(recur (%itreap-left itreap)
(+ offset (itreap-count (%itreap-right itreap)) 1)
sum)))
(force-up itreap)))))
(prog1 (- (or end (itreap-count itreap))
(recur itreap 0 +op-identity+))
(itreap-merge itreap itreap-suffix)))))
;;;
;;; Below are utilities for treap whose values are sorted w.r.t. some order
;;;
(declaim (inline itreap-bisect-left)
(ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) itreap-bisect-left))
(defun itreap-bisect-left (itreap value order &key (key #'identity))
"Takes a **sorted** treap and returns the smallest index that satisfies
ITREAP[index] >= VALUE, where >= is the complement of ORDER. In other words,
this function returns a leftmost index at which value can be inserted with
keeping the order. Returns the size of ITREAP if ITREAP[length-1] <
VALUE. The time complexity is O(log(n))."
(labels ((recur (count itreap)
(declare ((integer 0 #.most-positive-fixnum) count))
(cond ((null itreap) nil)
((funcall order (funcall key (%itreap-value itreap)) value)
(recur count (%itreap-right itreap)))
(t
(let ((left-count (- count (itreap-count (%itreap-right itreap)) 1)))
(or (recur left-count (%itreap-left itreap))
left-count))))))
(or (recur (itreap-count itreap) itreap)
(itreap-count itreap))))
(declaim (inline itreap-bisect-right)
(ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) itreap-bisect-right))
(defun itreap-bisect-right (itreap value order &key (key #'identity))
"Takes a **sorted** treap and returns the smallest index that satisfies
VALUE < ITREAP[index], where < is ORDER. In other words, this function
returns a rightmost index at which VALUE can be inserted with keeping the
order. Returns the size of ITREAP if ITREAP[length-1] <= VALUE. The time
complexity is O(log(n))."
(labels ((recur (count itreap)
(declare ((integer 0 #.most-positive-fixnum) count))
(cond ((null itreap) nil)
((funcall order value (funcall key (%itreap-value itreap)))
(let ((left-count (- count (itreap-count (%itreap-right itreap)) 1)))
(or (recur left-count (%itreap-left itreap))
left-count)))
(t
(recur count (%itreap-right itreap))))))
(or (recur (itreap-count itreap) itreap)
(itreap-count itreap))))
(declaim (inline itreap-insort))
(defun itreap-insort (itreap obj order)
"Does insertion to the sorted treap with keeping the order. You cannot rely on
the side effect. Use the returned value."
(let ((pos (itreap-bisect-left itreap obj order)))
(itreap-insert itreap pos obj)))
;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/mod-operations :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/implicit-treap :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/read-fixnum :cl-user))
(in-package :cl-user)
;;;
;;; Body
;;;
(defun main ()
(declare #.*opt*)
(let* ((n (read))
(as (make-array n :element-type 'uint31 :initial-element 0))
(rsums (make-array n :element-type 'uint31 :initial-element 0))
(lsums (make-array n :element-type 'uint31 :initial-element 0))
(rcounts (make-array n :element-type 'uint31 :initial-element 0))
(lcounts (make-array n :element-type 'uint31 :initial-element 0))
(res 0))
(declare (uint31 res n))
(dotimes (i n)
(setf (aref as i) (mod (read-fixnum) +mod+)))
(let (itreap)
(loop for i from 0 below n
for a = (aref as i)
for pos = (itreap-bisect-left itreap a #'>)
do (setf (aref lcounts i) pos
(aref lsums i) (itreap-fold itreap 0 pos)
itreap (itreap-insort itreap a #'>))))
(let (itreap)
(loop for i from (- n 1) downto 0
for a = (aref as i)
for pos = (itreap-bisect-left itreap a #'<)
do (setf (aref rcounts i) pos
(aref rsums i) (itreap-fold itreap 0 pos)
itreap (itreap-insort itreap a #'<))))
(dotimes (i n)
(let ((a (aref as i)))
(incfmod res (mod* (aref lcounts i) (aref rcounts i) a))
(incfmod res (mod* (aref lsums i) (aref rcounts i)))
(incfmod res (mod* (aref rsums i) (aref lcounts i)))))
(println res)))
#-swank (main)
;;;
;;; Test and benchmark
;;;
#+swank
(progn
(defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname))
(setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*))
(uiop:chdir *default-pathname-defaults*)
(defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*))
(defparameter *problem-url* "https://yukicoder.me/problems/no/1300"))
#+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)))
#+(and sbcl (not swank))
(eval-when (:compile-toplevel)
(when (or (> sb-c::*compiler-warning-count* 0)
sb-c::*undefined-warnings*)
(error "count: ~D, undefined warnings: ~A"
sb-c::*compiler-warning-count*
sb-c::*undefined-warnings*)))
;; To run: (5am:run! :sample)
#+swank
(5am:test :sample
(5am:is
(equal "6
"
(run "3
3 2 1
" nil)))
(5am:is
(equal "15
"
(run "4
4 2 3 1
" nil)))
(5am:is
(equal "69
"
(run "10
3 1 4 1 5 9 2 6 5 3
" nil))))