結果
| 問題 |
No.930 数列圧縮
|
| コンテスト | |
| ユーザー |
 sansaqua
|
| 提出日時 | 2019-11-22 23:02:29 |
| 言語 | Common Lisp (sbcl 2.5.0) |
| 結果 |
AC
|
| 実行時間 | 88 ms / 2,000 ms |
| コード長 | 18,950 bytes |
| コンパイル時間 | 829 ms |
| コンパイル使用メモリ | 80,900 KB |
| 実行使用メモリ | 30,592 KB |
| 最終ジャッジ日時 | 2024-10-11 04:39:21 |
| 合計ジャッジ時間 | 3,805 ms |
|
ジャッジサーバーID （参考情報） |
judge3 / judge5 |
（要ログイン）
| ファイルパターン | 結果 |
|---|---|
| sample | AC * 3 |
| other | AC * 24 |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 11 OCT 2024 04:39:17 AM): ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.242
ソースコード
;; -*- 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
;; 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
;; Treap accessible by index (O(log(n))).
;; Virtually it works like std::set of C++ or TreeSet of Java.
;; Note:
;; - You shouldn't insert duplicate keys into a treap unless you know what you
;; are doing.
;; - You cannot rely on the side effect when you call any destructive operations
;; on a treap. Always use the returned value.
;; - An empty treap is NIL.
(defstruct (treap (:constructor %make-treap (key priority &key left right (count 1)))
(:copier nil)
(:conc-name %treap-))
(key 0 :type fixnum)
(priority 0 :type (integer 0 #.most-positive-fixnum))
(count 0 :type (integer 0 #.most-positive-fixnum))
(left nil :type (or null treap))
(right nil :type (or null treap)))
(declaim (inline treap-count))
(defun treap-count (treap)
"Returns the size of the (nullable) TREAP."
(declare ((or null treap) treap))
(if (null treap)
0
(%treap-count treap)))
(declaim (inline update-count))
(defun update-count (treap)
(declare (treap treap))
(setf (%treap-count treap)
(+ 1
(treap-count (%treap-left treap))
(treap-count (%treap-right treap)))))
(declaim (inline treap-find))
(defun treap-find (key treap &key (order #'<))
"Returns KEY if TREAP contains it, otherwise NIL.
An element in TREAP is considered to be equal to KEY iff (and (not (funcall
order key <element>)) (not (funcall order <element> key))) is true."
(declare ((or null treap) treap))
(labels ((recur (treap)
(cond ((null treap) nil)
((funcall order key (%treap-key treap))
(recur (%treap-left treap)))
((funcall order (%treap-key treap) key)
(recur (%treap-right treap)))
(t key))))
(recur treap)))
(declaim (inline treap-position))
(defun treap-position (key treap &key (order #'<))
"Returns the index if TREAP contains KEY, otherwise NIL.
An element in TREAP is considered to be equal to KEY iff (and (not (funcall
order key <element>)) (not (funcall order <element> key))) is true."
(declare ((or null treap) treap))
(labels ((recur (count treap)
(declare ((integer 0 #.most-positive-fixnum) count))
(cond ((null treap) nil)
((funcall order (%treap-key treap) key)
(recur count (%treap-right treap)))
((funcall order key (%treap-key treap))
(let ((left-count (- count (treap-count (%treap-right treap)) 1)))
(recur left-count (%treap-left treap))))
(t (- count (treap-count (%treap-right treap)) 1)))))
(recur (treap-count treap) treap)))
(declaim (inline treap-bisect-left)
(ftype (function * (values (integer 0 #.most-positive-fixnum) t &optional)) treap-bisect-left))
(defun treap-bisect-left (value treap &key (order #'<))
"Returns the smallest index and the corresponding key that satisfies
TREAP[index] >= VALUE. Returns the size of TREAP and VALUE if TREAP[size-1] <
VALUE."
(labels ((recur (count treap)
(declare ((integer 0 #.most-positive-fixnum) count))
(cond ((null treap) (values nil nil))
((funcall order (%treap-key treap) value)
(recur count (%treap-right treap)))
(t (let ((left-count (- count (treap-count (%treap-right treap)) 1)))
(multiple-value-bind (idx key)
(recur left-count (%treap-left treap))
(if idx
(values idx key)
(values left-count (%treap-key treap)))))))))
(declare (ftype (function * (values t t &optional)) recur))
(multiple-value-bind (idx key)
(recur (treap-count treap) treap)
(if idx
(values idx key)
(values (treap-count treap) value)))))
(declaim (inline treap-split)
(ftype (function * (values (or null treap) (or null treap) &optional)) treap-split))
(defun treap-split (key treap &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 ((or null treap) treap))
(labels ((recur (treap)
(cond ((null treap)
(values nil nil))
((funcall order (%treap-key treap) key)
(multiple-value-bind (left right) (recur (%treap-right treap))
(setf (%treap-right treap) left)
(update-count treap)
(values treap right)))
(t
(multiple-value-bind (left right) (recur (%treap-left treap))
(setf (%treap-left treap) right)
(update-count treap)
(values left treap))))))
(recur treap)))
(declaim (inline treap-insert))
(defun treap-insert (key treap &key (order #'<))
"Destructively inserts KEY into TREAP and returns the resultant treap."
(declare ((or null treap) treap))
(let ((node (%make-treap key (random most-positive-fixnum))))
(labels ((recur (treap)
(declare (treap node))
(cond ((null treap) node)
((> (%treap-priority node) (%treap-priority treap))
(setf (values (%treap-left node) (%treap-right node))
(treap-split (%treap-key node) treap :order order))
(update-count node)
node)
(t
(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))))
(update-count treap)
treap))))
(recur treap))))
(defmacro treap-push (obj treap)
"Pushes OBJ to TREAP at POS."
`(setf ,treap (treap-insert ,obj ,treap)))
;; It takes O(nlog(n)).
(defun treap (order &rest keys)
(loop with res = nil
for key in keys
do (setf res (treap-insert key res :order order))
finally (return res)))
;; Reference: https://cp-algorithms.com/data_structures/treap.html
(declaim (inline make-treap))
(defun make-treap (sorted-vector)
"Makes a treap from the given SORTED-VECTOR in O(n). Note that this function
doesn't check if the SORTED-VECTOR is actually sorted w.r.t. your intended
order. The consequence is undefined when a non-sorted vector is passed."
(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))))
(setf (%treap-left node) (build l mid))
(setf (%treap-right node) (build (+ mid 1) r))
(heapify node)
(update-count node)
node))))
(build 0 (length sorted-vector))))
(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. (TREAP-UNITE is the analogue of the former.)"
(declare (optimize (speed 3))
((or null treap) left right))
(cond ((null left) right)
((null right) left)
((> (%treap-priority left) (%treap-priority right))
(setf (%treap-right left)
(treap-merge (%treap-right left) right))
(update-count left)
left)
(t
(setf (%treap-left right)
(treap-merge left (%treap-left right)))
(update-count right)
right)))
(declaim (inline treap-delete))
(defun treap-delete (key treap &key (order #'<))
"Destructively deletes the KEY in TREAP and returns the resultant treap."
(declare ((or null treap) treap))
(labels ((recur (treap)
(cond ((null treap) nil)
((funcall order key (%treap-key treap))
(setf (%treap-left treap) (recur (%treap-left treap)))
(update-count treap)
treap)
((funcall order (%treap-key treap) key)
(setf (%treap-right treap) (recur (%treap-right treap)))
(update-count treap)
treap)
(t
(treap-merge (%treap-left treap) (%treap-right treap))))))
(declare (ftype (function * (values (or null treap) &optional)) recur))
(recur treap)))
(defun treap-map (function treap)
"Successively applies FUNCTION to TREAP[0], ..., TREAP[SIZE-1]. FUNCTION must
take one argument."
(declare (function function))
(when treap
(treap-map function (%treap-left treap))
(funcall function (%treap-key treap))
(treap-map function (%treap-right treap))))
(defmethod print-object ((object treap) stream)
(print-unreadable-object (object stream :type t)
(let ((init t))
(treap-map (lambda (key)
(if init
(setq init nil)
(write-char #\ stream))
(write key :stream stream))
object))))
(define-condition invalid-treap-index-error (type-error)
((treap :initarg :treap :reader invalid-treap-index-error-treap)
(index :initarg :index :reader invalid-treap-index-error-index))
(:report
(lambda (condition stream)
(format stream "Invalid index ~W for treap ~W."
(invalid-treap-index-error-index condition)
(invalid-treap-index-error-treap condition)))))
(defun treap-ref (treap index)
"Index access"
(declare ((or null treap) treap)
((integer 0 #.most-positive-fixnum) index))
(when (>= index (treap-count treap))
(error 'invalid-treap-index-error :treap treap :index index))
(labels ((%ref (treap index)
(declare (optimize (speed 3) (safety 0))
((integer 0 #.most-positive-fixnum) index))
(let ((left-count (treap-count (%treap-left treap))))
(cond ((< index left-count)
(%ref (%treap-left treap) index))
((> index left-count)
(%ref (%treap-right treap) (- index left-count 1)))
(t (%treap-key treap))))))
(%ref treap index)))
(declaim (inline treap-unite))
(defun treap-unite (treap1 treap2 &key (order #'<))
"Merges two trees with keeping the order."
(labels
((recur (l r)
(cond ((null l) r)
((null r) l)
(t (when (< (%treap-priority l) (%treap-priority r))
(rotatef l r))
(multiple-value-bind (lchild rchild)
(treap-split (%treap-key l) r :order order)
(setf (%treap-left l) (recur (%treap-left l) lchild)
(%treap-right l) (recur (%treap-right l) rchild))
l)))))
(recur treap1 treap2)))
(defun treap-reverse (treap)
(labels ((recur (treap)
(unless (null treap)
(let ((left (recur (%treap-left treap)))
(right (recur (%treap-right treap))))
(setf (%treap-left treap) right
(%treap-right treap) left)
(update-count treap)
treap))))
(recur treap)))
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
(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 ()
(let* ((n (read))
(as (make-array n :element-type 'uint32))
(poses (make-array n :element-type 'uint32))
(ords (make-array n :element-type 'uint32)))
(labels ((%princ (x)
(princ (+ x 1))))
(dotimes (i n)
(let ((a (- (read-fixnum) 1)))
(setf (aref as i) a)
(setf (aref poses a) i)
(setf (aref ords i) i)))
(block increasing
(let ((treap (make-treap ords)))
(loop for x from 0 below (aref as 0)
for pos = (aref poses x)
for last-pos = (treap-ref treap (- (treap-count treap) 1))
do (when (= pos last-pos)
(return-from increasing))
(setq treap (treap-delete pos treap)))
(write-line "Yes")
(loop for x from 0 below (aref as 0)
do (%princ x)
(write-char #\ ))
(setq treap (treap-delete 0 treap))
(treap-map (lambda (pos)
(%princ (aref as pos))
(write-char #\ ))
treap)
(return-from main)))
(block decreasing
(let ((treap (make-treap ords)))
(loop for x from (- n 1) above (aref as (- n 1))
for pos = (aref poses x)
for init-pos = (treap-ref treap 0)
do (when (= pos init-pos)
(return-from decreasing))
(setq treap (treap-delete pos treap)))
(write-line "Yes")
(loop for x from (- n 1) above (aref as (- n 1))
do (%princ x)
(write-char #\ ))
(setq treap (treap-delete (- n 1) treap))
(treap-map (lambda (pos)
(%princ (aref as pos))
(write-char #\ ))
(treap-reverse treap))
(return-from main)))
(write-line "No"))))
#-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 "C:/msys64/usr/bin/cat.exe" '("/dev/clipboard") :output out)))
#+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)))