AtCoder Regular Contest 097

Submission #3960770

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 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))
  (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 ((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 ()
  (let* ((n (read))
         (m (read))
         (seq (make-array n :element-type 'uint32))
         (tree (make-union-find-tree n)))
    (split-ints-into-vector (read-line) seq :key #'1-)
    (dotimes (_ m)
      (split-ints-and-bind (x y) (read-line)
        (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ソースコード長 4270 Byte
File nameファイル名
Exec time実行時間 363 ms
Memory usageメモリ使用量 60008 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 251 ms 29280 KB
0_001.txt AC 93 ms 16868 KB
0_002.txt AC 93 ms 16864 KB
0_003.txt AC 92 ms 16864 KB
1_004.txt AC 211 ms 51684 KB
1_005.txt AC 350 ms 60008 KB
1_006.txt AC 363 ms 60000 KB
1_007.txt AC 93 ms 16864 KB
1_008.txt AC 93 ms 16868 KB
1_009.txt AC 92 ms 16868 KB
1_010.txt AC 93 ms 16864 KB
1_011.txt AC 93 ms 16872 KB
1_012.txt AC 92 ms 16864 KB
1_013.txt AC 93 ms 16872 KB
1_014.txt AC 97 ms 18916 KB
1_015.txt AC 93 ms 16864 KB
1_016.txt AC 92 ms 16868 KB
1_017.txt AC 95 ms 16868 KB
1_018.txt AC 201 ms 47588 KB
1_019.txt AC 175 ms 25056 KB
1_020.txt AC 175 ms 25064 KB
1_021.txt AC 178 ms 25060 KB
1_022.txt AC 358 ms 60004 KB