結果
問題 | No.930 数列圧縮 |
ユーザー | sansaqua |
提出日時 | 2019-11-22 23:02:29 |
言語 | Common Lisp (sbcl 2.3.8) |
結果 |
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 |
(要ログイン)
テストケース
テストケース表示入力 | 結果 | 実行時間 実行使用メモリ |
---|---|---|
testcase_00 | AC | 11 ms
23,936 KB |
testcase_01 | AC | 12 ms
24,064 KB |
testcase_02 | AC | 12 ms
23,936 KB |
testcase_03 | AC | 12 ms
24,064 KB |
testcase_04 | AC | 13 ms
24,064 KB |
testcase_05 | AC | 12 ms
24,064 KB |
testcase_06 | AC | 13 ms
24,064 KB |
testcase_07 | AC | 14 ms
24,064 KB |
testcase_08 | AC | 42 ms
28,032 KB |
testcase_09 | AC | 72 ms
28,800 KB |
testcase_10 | AC | 50 ms
27,776 KB |
testcase_11 | AC | 47 ms
28,160 KB |
testcase_12 | AC | 53 ms
28,672 KB |
testcase_13 | AC | 43 ms
29,440 KB |
testcase_14 | AC | 48 ms
30,592 KB |
testcase_15 | AC | 54 ms
29,824 KB |
testcase_16 | AC | 57 ms
29,824 KB |
testcase_17 | AC | 76 ms
29,568 KB |
testcase_18 | AC | 88 ms
29,824 KB |
testcase_19 | AC | 68 ms
29,568 KB |
testcase_20 | AC | 66 ms
29,824 KB |
testcase_21 | AC | 57 ms
29,568 KB |
testcase_22 | AC | 12 ms
24,064 KB |
testcase_23 | AC | 54 ms
29,696 KB |
testcase_24 | AC | 12 ms
24,064 KB |
testcase_25 | AC | 12 ms
23,936 KB |
testcase_26 | AC | 12 ms
23,936 KB |
コンパイルメッセージ
; 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)))