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
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
AC × 5
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