Submission #6218164 - AtCoder Grand Contest 002

Contest Duration: 2016-07-31 21:00:00+0900 - 2016-07-31 22:50:00+0900 (local time) (110 minutes) Back to Home

Submission #6218164

Source Code Expand

;; -*- coding: utf-8 -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0)))
  #+swank (progn (ql:quickload '(:cl-debug-print :fiveam))
                 (shadow :run)
                 (use-package :fiveam))
  #-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil (values) t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS
(defmacro with-output-buffer (&body body)
  "Buffers all outputs to *STANDARD-OUTPUT* in BODY and flushes them to
*STANDARD-OUTPUT* after BODY has been done (without error). Note that only
BASE-CHAR is allowed."
  (let ((out (gensym)))
    `(let ((,out (make-string-output-stream :element-type 'base-char)))
       (let ((*standard-output* ,out))
         ,@body)
       (write-string (get-output-stream-string ,out)))))

;; Scheme-style named let
(defmacro nlet (name args &body body)
  (labels ((ensure-list (x) (if (listp x) x (list x))))
    (let ((args (mapcar #'ensure-list args)))
      `(labels ((,name ,(mapcar #'car args) ,@body))
         (,name ,@(mapcar #'cadr args))))))

(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))))))))

;;;
;;; Partially persistent disjoint set
;;;

(defstruct (persistent-disjoint-set
            (:constructor make-persistent-disjoint-set
                (size
                 &aux
                 ;; DATA holds a negative integer as the size of the
                 ;; connected component and a non-negative integer as
                 ;; the parent.
                 (data (make-array size :element-type 'fixnum :initial-element -1))
                 ;; TIMESTAMPS records the time when each vertex is no
                 ;; longer a root.
                 (timestamps (make-array size :element-type '(integer 0 #.most-positive-fixnum)
                                              :initial-element most-positive-fixnum))
                 ;; record history of each connected component: (time . size)
                 (history
                  (let ((res (make-array size :element-type '(vector fixnum))))
                    (dotimes (i size res)
                      (setf (aref res i)
                            (make-array 2 :element-type 'fixnum
                                        :fill-pointer 2
                                        :initial-contents '(-1 1))))))))
            (:conc-name pds-))
  "partially persistent disjoint set"
  (data nil :type (simple-array fixnum (*)))
  (now 0 :type (integer 0 #.most-positive-fixnum))
  (timestamps nil :type (simple-array (integer 0 #.most-positive-fixnum) (*)))
  (history nil :type (simple-array (vector fixnum) (*))))

;; FIXME: add error handling of PDS-ROOT and PDS-CONNECTED-P. (It is too slow to
;; naively add this error to these functions.)
(define-condition persistent-disjoint-set-query-future (simple-error)
  ((disjoint-set :initarg :disjoint-set :reader pds-query-future-disjoint-set)
   (specified-time :initarg :specified-time :reader pds-query-future-specified-time))
  (:report
   (lambda (condition stream)
     (format stream "Attempted to query future information. Current time is ~W and specified time is ~W."
             (pds-now (pds-query-future-disjoint-set condition))
             (pds-query-future-specified-time condition)))))

(declaim (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) pds-root))
(defun pds-root (x time disjoint-set)
  "Returns the root of X at TIME."
  (declare (optimize (speed 3) (safety 0))
           ((integer 0 #.most-positive-fixnum) x time))
  (if (< time (aref (pds-timestamps disjoint-set) x))
      x
      (pds-root (aref (pds-data disjoint-set) x) time disjoint-set)))

(declaim (inline pds-unite!))
(defun pds-unite! (x1 x2 disjoint-set)
  "Destructively unites X1 and X2."
  (declare ((or null (integer 0 #.most-positive-fixnum))))
  (symbol-macrolet ((now (pds-now disjoint-set)))
    (let ((time (+ 1 now)))
      (setf now time)
      (let ((timestamps (pds-timestamps disjoint-set))
            (data (pds-data disjoint-set))
            (history (pds-history disjoint-set))
            (root1 (pds-root x1 time disjoint-set))
            (root2 (pds-root x2 time disjoint-set)))
        (declare ((integer 0 #.most-positive-fixnum) root1 root2))
        (unless (= root1 root2)
          (when (> (aref data root1) (aref data root2))
            (rotatef root1 root2))
          ;; (size root1) >= (size root2)
          (incf (aref data root1) (aref data root2))
          (setf (aref data root2) root1
                (aref timestamps root2) time)
          (vector-push-extend time (aref history root1))
          (vector-push-extend (the fixnum (- (aref data root1))) (aref history root1))
          t)))))

(declaim (inline pds-connected-p))
(defun pds-connected-p (x1 x2 time disjoint-set)
  "Checks if X1 and X2 have the same root at TIME."
  (= (pds-root x1 time disjoint-set) (pds-root x2 time disjoint-set)))

(defun pds-opening-time (x1 x2 disjoint-set)
  "Returns the earliest time when X1 and X2 were connected. Returns NIL if X1
and X2 are not connected yet."
  (declare #.OPT
           ((integer 0 #.most-positive-fixnum) x1 x2)
           (persistent-disjoint-set disjoint-set))
  (labels ((bisect (ng ok)
             (declare ((integer 0 #.most-positive-fixnum) ng ok))
             (if (<= (- ok ng) 1)
                 ok
                 (let ((mid (ash (+ ng ok) -1)))
                   (if (pds-connected-p x1 x2 mid disjoint-set)
                       (bisect ng mid)
                       (bisect mid ok))))))
    (declare (optimize (safety 0)))
    (when (pds-connected-p x1 x2 (pds-now disjoint-set) disjoint-set)
      (bisect 0 (pds-now disjoint-set)))))

(declaim (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) pds-size))
(defun pds-size (x time disjoint-set)
  "Returns the size of X at TIME."
  (declare #.OPT
           ((integer 0 #.most-positive-fixnum) x time))
  (when (< (pds-now disjoint-set) time)
    (error 'persistent-disjoint-set-query-future :specified-time time :disjoint-set disjoint-set))
  (let* ((root (pds-root x time disjoint-set))
         (root-history (aref (pds-history disjoint-set) root)))
    (declare (optimize (safety 0)))
    ;; detect the latest time equal to or earlier than TIME 
    (labels ((bisect-left-1 (ok ng)
               (declare ((integer 0 #.most-positive-fixnum) ok ng))
               (if (<= (- ng ok) 1)
                   ok
                   (let ((mid (ash (+ ok ng) -1)))
                     (if (<= (aref root-history (* 2 mid)) time)
                         (bisect-left-1 mid ng)
                         (bisect-left-1 ok mid))))))
      (aref root-history (+ 1 (* 2 (bisect-left-1 0 (ash (length root-history) -1))))))))

(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 ()
  (declare #.OPT)
  (let* ((n (read))
         (m (read))
         (dset (make-persistent-disjoint-set n)))
    (declare (uint32 n m))
    (dotimes (_ m)
      (let ((a (- (read-fixnum) 1))
            (b (- (read-fixnum) 1)))
        (pds-unite! a b dset)))
    (let ((q (the uint32 (read))))
      (with-output-buffer
        (dotimes (_ q)
          (let* ((x (- (read-fixnum) 1))
                 (y (- (read-fixnum) 1))
                 (z (read-fixnum))
                 (opening-time (pds-opening-time x y dset))
                 (threshold (pds-size x opening-time dset)))
            (declare (uint32 x y z threshold))
            (if (< threshold z)
                (nlet bisect ((ng opening-time) (ok m))
                  (declare (uint32 ng ok))
                  (if (<= (- ok ng) 1)
                      (println ok)
                      (let ((mid (ash (+ ok ng) -1)))
                        (if (>= (pds-size x mid dset) z)
                            (bisect ng mid)
                            (bisect mid ok)))))
                (nlet bisect ((ng 0) (ok opening-time))
                  (declare (uint32 ng ok))
                  (if (<= (- ok ng) 1)
                      (println ok)
                      (let ((mid (ash (+ ok ng) -1)))
                        (if (>= (+ (pds-size x mid dset)
                                   (pds-size y mid dset))
                                z)
                            (bisect ng mid)
                            (bisect mid ok))))))))))))

#-swank(main)

Submission Info

Submission Time	2019-07-02 22:42:23+0900
Task	D - Stamp Rally
User	sansaqua
Language	Common Lisp (SBCL 1.1.14)
Score	1000
Code Size	10466 Byte
Status	AC
Exec Time	1232 ms
Memory	50408 KiB

Judge Result

Set Name

Sample

All

Score / Max Score

0 / 0

1000 / 1000

Status

× 1

× 33

Set Name	Test Cases
Sample	0_00.txt
All	0_00.txt, 1_00.txt, 1_01.txt, 1_02.txt, 1_03.txt, 1_04.txt, 1_05.txt, 1_06.txt, 1_07.txt, 1_08.txt, 1_09.txt, 1_10.txt, 1_11.txt, 1_12.txt, 1_13.txt, 1_14.txt, 1_15.txt, 1_16.txt, 1_17.txt, 1_18.txt, 1_19.txt, 1_20.txt, 1_21.txt, 1_22.txt, 1_23.txt, 1_24.txt, 1_25.txt, 1_26.txt, 1_27.txt, 1_28.txt, 1_29.txt, 1_30.txt, 1_31.txt

Case Name	Status	Exec Time	Memory
0_00.txt	AC	101 ms	21220 KiB
1_00.txt	AC	867 ms	50408 KiB
1_01.txt	AC	906 ms	50400 KiB
1_02.txt	AC	1232 ms	50400 KiB
1_03.txt	AC	973 ms	50408 KiB
1_04.txt	AC	1210 ms	48360 KiB
1_05.txt	AC	989 ms	48356 KiB
1_06.txt	AC	1197 ms	48356 KiB
1_07.txt	AC	997 ms	48352 KiB
1_08.txt	AC	1062 ms	50400 KiB
1_09.txt	AC	941 ms	50400 KiB
1_10.txt	AC	916 ms	50408 KiB
1_11.txt	AC	842 ms	50408 KiB
1_12.txt	AC	779 ms	48356 KiB
1_13.txt	AC	753 ms	48360 KiB
1_14.txt	AC	670 ms	50400 KiB
1_15.txt	AC	680 ms	50404 KiB
1_16.txt	AC	936 ms	48352 KiB
1_17.txt	AC	937 ms	50400 KiB
1_18.txt	AC	929 ms	48356 KiB
1_19.txt	AC	938 ms	50400 KiB
1_20.txt	AC	921 ms	48356 KiB
1_21.txt	AC	934 ms	50408 KiB
1_22.txt	AC	933 ms	48356 KiB
1_23.txt	AC	942 ms	48360 KiB
1_24.txt	AC	913 ms	48356 KiB
1_25.txt	AC	930 ms	48352 KiB
1_26.txt	AC	913 ms	48352 KiB
1_27.txt	AC	940 ms	48356 KiB
1_28.txt	AC	927 ms	48356 KiB
1_29.txt	AC	917 ms	48352 KiB
1_30.txt	AC	931 ms	48356 KiB
1_31.txt	AC	909 ms	48356 KiB