結果
| 問題 | No.1300 Sum of Inversions |
| ユーザー |
 sansaqua
|
| 提出日時 | 2020-11-27 21:58:30 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 1,270 ms / 2,000 ms |
| コード長 | 28,729 bytes |
| コンパイル時間 | 704 ms |
| コンパイル使用メモリ | 88,500 KB |
| 実行使用メモリ | 60,060 KB |
| 最終ジャッジ日時 | 2023-10-01 05:43:36 |
| 合計ジャッジ時間 | 30,663 ms |
|
ジャッジサーバーID （参考情報） |
judge15 / judge12 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 13 ms
25,872 KB |
| testcase_01 | AC | 13 ms
29,088 KB |
| testcase_02 | AC | 12 ms
25,868 KB |
| testcase_03 | AC | 940 ms
48,716 KB |
| testcase_04 | AC | 909 ms
51,860 KB |
| testcase_05 | AC | 723 ms
47,824 KB |
| testcase_06 | AC | 1,089 ms
54,828 KB |
| testcase_07 | AC | 1,028 ms
53,972 KB |
| testcase_08 | AC | 1,160 ms
54,760 KB |
| testcase_09 | AC | 1,142 ms
56,008 KB |
| testcase_10 | AC | 585 ms
44,524 KB |
| testcase_11 | AC | 584 ms
42,532 KB |
| testcase_12 | AC | 929 ms
48,624 KB |
| testcase_13 | AC | 890 ms
50,688 KB |
| testcase_14 | AC | 1,270 ms
54,780 KB |
| testcase_15 | AC | 1,139 ms
52,808 KB |
| testcase_16 | AC | 984 ms
50,756 KB |
| testcase_17 | AC | 558 ms
40,524 KB |
| testcase_18 | AC | 659 ms
42,576 KB |
| testcase_19 | AC | 794 ms
46,596 KB |
| testcase_20 | AC | 812 ms
46,596 KB |
| testcase_21 | AC | 804 ms
46,608 KB |
| testcase_22 | AC | 738 ms
44,612 KB |
| testcase_23 | AC | 1,106 ms
52,744 KB |
| testcase_24 | AC | 747 ms
44,536 KB |
| testcase_25 | AC | 637 ms
42,508 KB |
| testcase_26 | AC | 618 ms
42,560 KB |
| testcase_27 | AC | 703 ms
44,544 KB |
| testcase_28 | AC | 1,191 ms
54,852 KB |
| testcase_29 | AC | 799 ms
49,840 KB |
| testcase_30 | AC | 1,152 ms
54,780 KB |
| testcase_31 | AC | 732 ms
44,544 KB |
| testcase_32 | AC | 774 ms
46,664 KB |
| testcase_33 | AC | 374 ms
60,060 KB |
| testcase_34 | AC | 414 ms
58,872 KB |
| testcase_35 | AC | 175 ms
56,908 KB |
| testcase_36 | AC | 190 ms
56,824 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 01 OCT 2023 05:43:02 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"
(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))
(mod (+ a b) cl-user::+mod+))
(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 (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: 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 ()
(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))
(dotimes (i n)
(setf (aref as i) (read-fixnum)))
(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 #'>))
#>itreap))
(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 #'<))))
(dbg rsums lsums rcounts lcounts)
(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))))