AtCoder Regular Contest 097

Submission #3960859

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)

;; BEGIN_INSERTED_CONTENTS
(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)
		   body
		   `((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
                (size
                 &aux
                 (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))
        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)
  `(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 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) (bufferd-read-line 20)
        (uf-unite! (aref seq (- x 1)) (aref seq (- y 1)) tree)))
    (println
     (loop for i below n
           count (uf-connected-p i (aref seq i) tree)))))

#-swank(main)

Submission

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

Test case

Set

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 257 ms 30560 KB
0_001.txt AC 97 ms 18920 KB
0_002.txt AC 97 ms 18916 KB
0_003.txt AC 97 ms 18912 KB
1_004.txt AC 156 ms 18916 KB
1_005.txt AC 258 ms 27108 KB
1_006.txt AC 263 ms 27104 KB
1_007.txt AC 98 ms 18920 KB
1_008.txt AC 96 ms 18916 KB
1_009.txt AC 96 ms 18920 KB
1_010.txt AC 96 ms 18920 KB
1_011.txt AC 96 ms 18916 KB
1_012.txt AC 97 ms 18916 KB
1_013.txt AC 97 ms 18916 KB
1_014.txt AC 98 ms 18920 KB
1_015.txt AC 97 ms 18916 KB
1_016.txt AC 96 ms 18920 KB
1_017.txt AC 97 ms 18912 KB
1_018.txt AC 149 ms 18916 KB
1_019.txt AC 178 ms 27108 KB
1_020.txt AC 176 ms 27112 KB
1_021.txt AC 180 ms 27108 KB
1_022.txt AC 263 ms 27108 KB