AtCoder Regular Contest 097

Submission #3960878

Source codeソースコード

(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 (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

(defmacro bufferd-read-line (&optional (buffer-size 30) (in '*standard-input*) (terminate-char #\Space))
  (let ((buffer (gensym)) (c (gensym)) (idx (gensym)))
    `(let ((,buffer (load-time-value (make-string ,buffer-size
                                                  :element-type 'base-char
                                                  :initial-element ,terminate-char))))
       (declare (simple-base-string ,buffer))
       (loop for ,c of-type base-char =
           #-swank (code-char (read-byte ,in nil #\Newline))
           #+swank (read-char ,in nil #\Newline)
        for ,idx from 0
        until (char= ,c #\Newline)
        do (setf (schar ,buffer ,idx) ,c)
        finally (setf (schar ,buffer ,idx) ,terminate-char)
                (return ,buffer)))))

(defmacro split-ints-and-bind (arg-lst string &body body)
  (let ((pos1 (gensym "POS"))
	(pos2 (gensym "POS"))
	(str (gensym "STR")))
    (labels ((expand (arg-lst &optional (init-pos1 t))
	       (if (null arg-lst)
		   `((let* ((,pos1 ,(if init-pos1 0 `(1+ ,pos2)))
			    (,pos2 (position #\space ,str :start ,pos1 :test #'char=))
			    (,(car arg-lst) (parse-integer ,str :start ,pos1 :end ,pos2)))
		       ,@(expand (cdr arg-lst) nil))))))
      `(let ((,str ,string))
         (declare (string ,str))
	 ,@(expand arg-lst)))))

(declaim (inline split-ints-into-vector))
(defun split-ints-into-vector (str dest-arr &key (offset 0) (key #'identity))
  (declare ((simple-array * (*)) dest-arr)
           ((integer 0 #.most-positive-fixnum) offset)
           (function key)
           (string str))
  (loop for idx from offset below (length dest-arr)
        for pos1 = 0 then (1+ pos2)
        for pos2 = (position #\space str :start pos1 :test #'char=)
        do (setf (aref dest-arr idx)
                 (funcall key (parse-integer str :start pos1 :end pos2)))
        finally (return dest-arr)))

(defstruct (union-find-tree
            (:constructor make-union-find-tree
                 (parents (let ((arr (make-array size :element-type '(integer 0 #.most-positive-fixnum))))
                            (dotimes (i size arr) (setf (aref arr i) i))))
                 (ranks (make-array size :element-type '(integer 0 #.most-positive-fixnum)
                                         :initial-element 0)))))
  (parents nil :type (simple-array (integer 0 #.most-positive-fixnum) (*)))
  (ranks nil :type (simple-array (integer 0 #.most-positive-fixnum) (*))))

(declaim (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) uf-root))
(defun uf-root (x uf-tree)
  "Returns the root of X."
  (declare #.OPT ((integer 0 #.most-positive-fixnum) x))
  (let ((parents (union-find-tree-parents uf-tree)))
    (if (= x (aref parents x))
        (setf (aref parents x)
              (uf-root (aref parents x) uf-tree)))))

(declaim (inline uf-unite!))
(defun uf-unite! (x1 x2 uf-tree)
  "Unites X1 and X2 destructively."
  (let ((root1 (uf-root x1 uf-tree))
        (root2 (uf-root x2 uf-tree))
        (parents (union-find-tree-parents uf-tree))
        (ranks (union-find-tree-ranks uf-tree)))
    (cond ((= root1 root2) nil)
          ((< (aref ranks root1) (aref ranks root2))
           (setf (aref parents root1) root2))
          ((= (aref ranks root1) (aref ranks root2))
           (setf (aref parents root2) root1)
           (incf (aref ranks root1)))
          (t (setf (aref parents root2) root1)))))

(declaim (inline uf-connected-p))
(defun uf-connected-p (x1 x2 uf-tree)
  "Checks if X1 and X2 have the same root."
  (= (uf-root x1 uf-tree) (uf-root x2 uf-tree)))

(defmacro define-int-types (&rest bits)
     ,@(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 4 7 8 15 16 31 32 62 63 64)

(defmacro println (obj &optional (stream '*standard-output*))
  `(let ((*read-default-float-format* 'double-float))
     (prog1 (princ ,obj ,stream) (terpri ,stream))))

;; Hauptteil

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (m (read))
         (seq (make-array n :element-type 'uint32))
         (tree (make-union-find-tree n)))
    (declare (uint32 n m)
             ((simple-array uint32 (*)) seq))
    (split-ints-into-vector (read-line) seq :key #'1-)
    (dotimes (_ m)
      (split-ints-and-bind (x y) (bufferd-read-line 20)
        (declare (uint32 x y))
        (uf-unite! (aref seq (- x 1)) (aref seq (- y 1)) tree)))
     (loop for i below n
           count (uf-connected-p i (aref seq i) tree)))))



Task問題 D - Equals
User nameユーザ名 sansaqua
Created time投稿日時
Language言語 Common Lisp (SBCL 1.1.14)
Status状態 AC
Score得点 400
Source lengthソースコード長 5232 Byte
File nameファイル名
Exec time実行時間 298 ms
Memory usageメモリ使用量 33764 KB

Test case


Set name Score得点 / Max score Cases
Sample - 0_000.txt,0_001.txt,0_002.txt,0_003.txt
All 400 / 400 0_000.txt,0_001.txt,0_002.txt,0_003.txt,1_004.txt,1_005.txt,1_006.txt,1_007.txt,1_008.txt,1_009.txt,1_010.txt,1_011.txt,1_012.txt,1_013.txt,1_014.txt,1_015.txt,1_016.txt,1_017.txt,1_018.txt,1_019.txt,1_020.txt,1_021.txt,1_022.txt

Test case

Case name Status状態 Exec time実行時間 Memory usageメモリ使用量
0_000.txt AC 298 ms 33764 KB
0_001.txt AC 113 ms 20960 KB
0_002.txt AC 113 ms 20960 KB
0_003.txt AC 113 ms 20960 KB
1_004.txt AC 152 ms 20964 KB
1_005.txt AC 237 ms 29160 KB
1_006.txt AC 243 ms 29160 KB
1_007.txt AC 114 ms 20964 KB
1_008.txt AC 113 ms 20964 KB
1_009.txt AC 113 ms 20964 KB
1_010.txt AC 114 ms 20964 KB
1_011.txt AC 113 ms 20964 KB
1_012.txt AC 114 ms 20964 KB
1_013.txt AC 115 ms 20964 KB
1_014.txt AC 116 ms 20964 KB
1_015.txt AC 114 ms 20964 KB
1_016.txt AC 115 ms 20964 KB
1_017.txt AC 115 ms 20968 KB
1_018.txt AC 150 ms 20964 KB
1_019.txt AC 182 ms 29152 KB
1_020.txt AC 181 ms 29156 KB
1_021.txt AC 182 ms 29152 KB
1_022.txt AC 243 ms 29156 KB