;; -*- 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 )) (not (funcall order 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 )) (not (funcall order 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)))