Submission #8527753
Source Code Expand
;; -*- 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
(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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
(declare #.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 #\-))
(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))))))))
;;;
;;; Implicit treap
;;; (treap with implicit key)
;;;
;; Note:
;; - An empty treap is NIL.
(declaim (inline op))
(defun op (a b)
"Is a binary operator comprising a monoid."
(declare (fixnum a b))
(the fixnum (+ a b)))
(defconstant +op-identity+ 0
"identity element w.r.t. OP")
(defstruct (itreap (:constructor %make-itreap (value priority &key left right (count 1) (accumulator value)))
(:copier nil)
(:conc-name %itreap-))
(value +op-identity+ :type fixnum)
(accumulator +op-identity+ :type fixnum)
(priority 0 :type (integer 0 #.most-positive-fixnum))
(count 1 :type (integer 0 #.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."
(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 (top)
"Properly swaps the priorities of the node and its two children."
(declare #.OPT)
(when top
(let ((high-priority-node top))
(when (and (%itreap-left top)
(> (%itreap-priority (%itreap-left top))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-left top)))
(when (and (%itreap-right top)
(> (%itreap-priority (%itreap-right top))
(%itreap-priority high-priority-node)))
(setq high-priority-node (%itreap-right top)))
(unless (eql high-priority-node top)
(rotatef (%itreap-priority high-priority-node)
(%itreap-priority top))
(%heapify high-priority-node)))))
(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 #.OPT
((or null (simple-array uint31 (*))) 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)))
(defun itreap-split (itreap index)
"Destructively splits the ITREAP into two nodes [0, INDEX) and [INDEX, N),
where N is the number of elements of the ITREAP."
(declare #.OPT
((integer 0 #.most-positive-fixnum) index))
(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."
(declare #.OPT
((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 node)
"Destructively inserts OBJ into ITREAP and returns the resultant treap.
You cannot rely on the side effect. Use the returned value."
(declare #.OPT
((or null itreap) itreap)
(itreap node)
((integer 0 #.most-positive-fixnum) index))
(setf (%itreap-value node) obj
(%itreap-accumulator node) obj
(%itreap-count node) 1)
(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)))
(declaim (ftype (function * (values itreap itreap &optional)) itreap-delete))
(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 #.OPT
((integer 0 #.most-positive-fixnum) index))
(let (res)
(labels ((recur (itreap ikey)
(declare ((integer 0 #.most-positive-fixnum) ikey)
(values (or null itreap) &optional))
(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
(setq res itreap)
(itreap-merge (%itreap-left itreap) (%itreap-right itreap)))))))
(values (recur itreap index) res))))
(defmacro itreap-pop (itreap pos)
(let ((p (gensym)))
`(let ((,p ,pos))
(setf ,itreap (itreap-delete ,itreap ,p)))))
(defun itreap-ref (itreap index)
"Returns the element ITREAP[INDEX]."
(declare #.OPT
((integer 0 #.most-positive-fixnum) index))
(labels ((%ref (itreap index)
(declare ((integer 0 #.most-positive-fixnum) index))
(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))))))
(%ref itreap index)))
(declaim (ftype (function * (values fixnum &optional)) itreap-query))
(defun itreap-query (itreap l r)
"Queries the `sum' (w.r.t. OP) of the range ITREAP[L, R)."
(declare #.OPT
((integer 0 #.most-positive-fixnum) l r))
(labels
((recur (itreap l r)
(declare ((integer 0 #.most-positive-fixnum) l r))
(unless itreap
(return-from recur +op-identity+))
(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)))))))
(recur itreap l r)))
;;;
;;; Utilities for sorted treap
;;;
(declaim (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) itreap-bisect-left))
(defun itreap-bisect-left (itreap threshold)
"Takes a **sorted** treap and returns the smallest index that satisfies
ITREAP[index] >= THRESHOLD, where >= is the complement of ORDER. Returns the
size of ITREAP if ITREAP[length-1] < THRESHOLD. The time complexity is
O(log(n))."
(declare #.OPT
(fixnum threshold))
(labels ((recur (count itreap)
(declare ((integer 0 #.most-positive-fixnum) count))
(cond ((null itreap) nil)
((< (%itreap-value itreap) threshold)
(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-insort))
(defun itreap-insort (itreap obj node)
"Does insertion to the sorted treap."
(let ((pos (itreap-bisect-left itreap obj)))
(itreap-insert itreap pos obj node)))
(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* 'double-float))
(prog1 (princ obj stream) (terpri stream))))
(defconstant +mod+ 1000000007)
;;;
;;; Body
;;;
(defconstant +inf+ most-positive-fixnum)
(defun %sort! (vec)
(declare #.OPT
((simple-array uint31 (*)) vec)
(inline sort))
(sort vec #'<))
(gc :full t)
(defun main ()
(declare #.OPT)
(let* ((w (read))
(h (read))
(n (read))
(xs (make-array (* 2 n) :element-type 'uint31))
(ys (make-array (* 2 n) :element-type 'uint31))
(res-value +inf+)
(res-x +inf+)
(res-y +inf+))
(declare (uint31 w h n)
(fixnum res-value res-x res-y)
(ignore w h))
(dotimes (i n)
(let ((x (read-fixnum))
(y (read-fixnum)))
(setf (aref xs i) x
(aref xs (+ i n)) x
(aref ys i) y
(aref ys (+ i n)) y)))
(let* ((sorted-xs (copy-seq xs))
(sorted-ys (copy-seq ys)))
(%sort! sorted-xs)
(%sort! sorted-ys)
(let ((dp-x (make-itreap (* 2 n) :initial-contents sorted-xs))
(dp-y (make-itreap (* 2 n) :initial-contents sorted-ys)))
(dotimes (i n)
(let* ((pivot-x (aref xs i))
(pivot-y (aref ys i))
(x-pos (itreap-bisect-left dp-x pivot-x))
(y-pos (itreap-bisect-left dp-y pivot-y)))
(multiple-value-bind (new-dp-x node1) (itreap-delete dp-x x-pos)
(multiple-value-bind (new-dp-y node2) (itreap-delete dp-y y-pos)
(setq dp-x new-dp-x
dp-y new-dp-y)
(let* ((x-dist (- (itreap-query dp-x n (- (* 2 n) 1))
(itreap-query dp-x 0 (- n 1))))
(y-dist (- (itreap-query dp-y n (- (* 2 n) 1))
(itreap-query dp-y 0 (- n 1))))
(value (+ x-dist y-dist))
(mid-x (itreap-ref dp-x (- n 1)))
(mid-y (itreap-ref dp-y (- n 1))))
(declare (fixnum x-dist y-dist mid-x mid-y))
(when (or (< value res-value)
(and (= value res-value)
(or (< mid-x res-x)
(and (= mid-x res-x)
(< mid-y res-y)))))
(setq res-value value
res-x mid-x
res-y mid-y))
(setq dp-x (itreap-insort dp-x pivot-x node1)
dp-y (itreap-insort dp-y pivot-y node2)))))))))
(println res-value)
(format t "~D ~D~%" res-x res-y)))
#-swank (main)
Submission Info
| Submission Time | |
|---|---|
| Task | D - 歩くサンタクロース (Walking Santa) |
| User | sansaqua |
| Language | Common Lisp (SBCL 1.1.14) |
| Score | 100 |
| Code Size | 17084 Byte |
| Status | AC |
| Exec Time | 632 ms |
| Memory | 43784 KiB |
Judge Result
| Set Name | set01 | set02 | set03 | set04 | set05 | set06 | set07 | set08 | set09 | set10 | set11 | set12 | set13 | set14 | set15 | set16 | set17 | set18 | set19 | set20 | ||||||||||||||||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Score / Max Score | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | 5 / 5 | ||||||||||||||||||||||||||||||||||||||||
| Status |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| Set Name | Test Cases |
|---|---|
| set01 | 01-01, 01-02, 01-03, 01-04, 01-05 |
| set02 | 02-01, 02-02, 02-03, 02-04, 02-05 |
| set03 | 03-01, 03-02, 03-03, 03-04, 03-05 |
| set04 | 04-01, 04-02, 04-03, 04-04, 04-05 |
| set05 | 05-01, 05-02, 05-03, 05-04, 05-05 |
| set06 | 06-01, 06-02, 06-03, 06-04, 06-05 |
| set07 | 07-01, 07-02, 07-03, 07-04, 07-05 |
| set08 | 08-01, 08-02, 08-03, 08-04, 08-05 |
| set09 | 09-01, 09-02, 09-03, 09-04, 09-05 |
| set10 | 10-01, 10-02, 10-03, 10-04, 10-05 |
| set11 | 11-01, 11-02, 11-03, 11-04, 11-05 |
| set12 | 12-01, 12-02, 12-03, 12-04, 12-05 |
| set13 | 13-01, 13-02, 13-03, 13-04, 13-05 |
| set14 | 14-01, 14-02, 14-03, 14-04, 14-05 |
| set15 | 15-01, 15-02, 15-03, 15-04, 15-05 |
| set16 | 16-01, 16-02, 16-03, 16-04, 16-05 |
| set17 | 17-01, 17-02, 17-03, 17-04, 17-05 |
| set18 | 18-01, 18-02, 18-03, 18-04, 18-05 |
| set19 | 19-01, 19-02, 19-03, 19-04, 19-05 |
| set20 | 20-01, 20-02, 20-03, 20-04, 20-05 |
| Case Name | Status | Exec Time | Memory |
|---|---|---|---|
| 01-01 | AC | 241 ms | 35560 KiB |
| 01-02 | AC | 241 ms | 35556 KiB |
| 01-03 | AC | 242 ms | 35556 KiB |
| 01-04 | AC | 241 ms | 35556 KiB |
| 01-05 | AC | 241 ms | 35560 KiB |
| 02-01 | AC | 241 ms | 35560 KiB |
| 02-02 | AC | 241 ms | 35552 KiB |
| 02-03 | AC | 243 ms | 35556 KiB |
| 02-04 | AC | 241 ms | 35556 KiB |
| 02-05 | AC | 241 ms | 35560 KiB |
| 03-01 | AC | 241 ms | 35556 KiB |
| 03-02 | AC | 241 ms | 35556 KiB |
| 03-03 | AC | 241 ms | 35556 KiB |
| 03-04 | AC | 241 ms | 35560 KiB |
| 03-05 | AC | 241 ms | 35560 KiB |
| 04-01 | AC | 242 ms | 35556 KiB |
| 04-02 | AC | 242 ms | 35556 KiB |
| 04-03 | AC | 241 ms | 35552 KiB |
| 04-04 | AC | 241 ms | 35552 KiB |
| 04-05 | AC | 244 ms | 35556 KiB |
| 05-01 | AC | 244 ms | 35552 KiB |
| 05-02 | AC | 244 ms | 35556 KiB |
| 05-03 | AC | 244 ms | 35556 KiB |
| 05-04 | AC | 243 ms | 35560 KiB |
| 05-05 | AC | 244 ms | 35556 KiB |
| 06-01 | AC | 244 ms | 35560 KiB |
| 06-02 | AC | 243 ms | 35560 KiB |
| 06-03 | AC | 243 ms | 35552 KiB |
| 06-04 | AC | 243 ms | 35552 KiB |
| 06-05 | AC | 244 ms | 35560 KiB |
| 07-01 | AC | 243 ms | 35556 KiB |
| 07-02 | AC | 246 ms | 35556 KiB |
| 07-03 | AC | 244 ms | 35560 KiB |
| 07-04 | AC | 245 ms | 35560 KiB |
| 07-05 | AC | 245 ms | 35552 KiB |
| 08-01 | AC | 246 ms | 35560 KiB |
| 08-02 | AC | 245 ms | 35552 KiB |
| 08-03 | AC | 244 ms | 35552 KiB |
| 08-04 | AC | 246 ms | 35556 KiB |
| 08-05 | AC | 245 ms | 35556 KiB |
| 09-01 | AC | 585 ms | 43776 KiB |
| 09-02 | AC | 574 ms | 43780 KiB |
| 09-03 | AC | 572 ms | 43776 KiB |
| 09-04 | AC | 575 ms | 43776 KiB |
| 09-05 | AC | 574 ms | 43776 KiB |
| 10-01 | AC | 574 ms | 43780 KiB |
| 10-02 | AC | 572 ms | 43784 KiB |
| 10-03 | AC | 574 ms | 43780 KiB |
| 10-04 | AC | 574 ms | 43780 KiB |
| 10-05 | AC | 573 ms | 43780 KiB |
| 11-01 | AC | 607 ms | 43784 KiB |
| 11-02 | AC | 609 ms | 43780 KiB |
| 11-03 | AC | 607 ms | 43780 KiB |
| 11-04 | AC | 612 ms | 43780 KiB |
| 11-05 | AC | 617 ms | 43784 KiB |
| 12-01 | AC | 630 ms | 43780 KiB |
| 12-02 | AC | 620 ms | 43784 KiB |
| 12-03 | AC | 614 ms | 43776 KiB |
| 12-04 | AC | 621 ms | 43780 KiB |
| 12-05 | AC | 616 ms | 43776 KiB |
| 13-01 | AC | 615 ms | 43776 KiB |
| 13-02 | AC | 616 ms | 43780 KiB |
| 13-03 | AC | 616 ms | 43776 KiB |
| 13-04 | AC | 618 ms | 43784 KiB |
| 13-05 | AC | 612 ms | 43784 KiB |
| 14-01 | AC | 613 ms | 43784 KiB |
| 14-02 | AC | 615 ms | 43784 KiB |
| 14-03 | AC | 614 ms | 43780 KiB |
| 14-04 | AC | 613 ms | 43780 KiB |
| 14-05 | AC | 613 ms | 43776 KiB |
| 15-01 | AC | 241 ms | 35560 KiB |
| 15-02 | AC | 242 ms | 35552 KiB |
| 15-03 | AC | 612 ms | 43780 KiB |
| 15-04 | AC | 612 ms | 43776 KiB |
| 15-05 | AC | 613 ms | 43780 KiB |
| 16-01 | AC | 613 ms | 43780 KiB |
| 16-02 | AC | 617 ms | 43776 KiB |
| 16-03 | AC | 609 ms | 43780 KiB |
| 16-04 | AC | 568 ms | 43784 KiB |
| 16-05 | AC | 620 ms | 43784 KiB |
| 17-01 | AC | 612 ms | 43780 KiB |
| 17-02 | AC | 609 ms | 43780 KiB |
| 17-03 | AC | 608 ms | 43780 KiB |
| 17-04 | AC | 625 ms | 43780 KiB |
| 17-05 | AC | 590 ms | 43776 KiB |
| 18-01 | AC | 632 ms | 43780 KiB |
| 18-02 | AC | 620 ms | 43784 KiB |
| 18-03 | AC | 611 ms | 43776 KiB |
| 18-04 | AC | 527 ms | 43780 KiB |
| 18-05 | AC | 627 ms | 43780 KiB |
| 19-01 | AC | 612 ms | 43780 KiB |
| 19-02 | AC | 617 ms | 43780 KiB |
| 19-03 | AC | 617 ms | 43780 KiB |
| 19-04 | AC | 586 ms | 43780 KiB |
| 19-05 | AC | 579 ms | 43780 KiB |
| 20-01 | AC | 617 ms | 43780 KiB |
| 20-02 | AC | 617 ms | 43776 KiB |
| 20-03 | AC | 613 ms | 43784 KiB |
| 20-04 | AC | 625 ms | 43776 KiB |
| 20-05 | AC | 575 ms | 43780 KiB |