結果

問題 No.274 The Wall
ユーザー sansaquasansaqua
提出日時 2019-09-18 02:07:44
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 627 ms / 2,000 ms
コード長 5,800 bytes
コンパイル時間 79 ms
コンパイル使用メモリ 39,876 KB
実行使用メモリ 339,924 KB
最終ジャッジ日時 2023-09-04 02:42:47
合計ジャッジ時間 3,132 ms
ジャッジサーバーID
（参考情報） 		judge13 / judge12
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 14 ms
23,280 KB
testcase_01 AC 14 ms
27,304 KB
testcase_02 AC 14 ms
25,372 KB
testcase_03 AC 194 ms
129,216 KB
testcase_04 AC 13 ms
25,480 KB
testcase_05 AC 13 ms
25,372 KB
testcase_06 AC 13 ms
25,396 KB
testcase_07 AC 13 ms
23,376 KB
testcase_08 AC 14 ms
27,120 KB
testcase_09 AC 13 ms
27,048 KB
testcase_10 AC 14 ms
27,268 KB
testcase_11 AC 627 ms
339,924 KB
testcase_12 AC 27 ms
23,680 KB
testcase_13 AC 13 ms
23,356 KB
testcase_14 AC 19 ms
23,432 KB
testcase_15 AC 29 ms
23,664 KB
testcase_16 AC 202 ms
75,128 KB
testcase_17 AC 195 ms
72,036 KB
testcase_18 AC 214 ms
77,248 KB
testcase_19 AC 44 ms
23,716 KB
testcase_20 AC 49 ms
23,652 KB
testcase_21 AC 51 ms
23,736 KB
testcase_22 AC 54 ms
25,736 KB
testcase_23 AC 54 ms
25,824 KB
testcase_24 AC 54 ms
27,380 KB
testcase_25 AC 54 ms
23,696 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 04 SEP 2023 02:42:43 AM):
; processing (SB-INT:DEFCONSTANT-EQX OPT ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DISABLE-DEBUGGER)
; processing (DEFMACRO DEFINE-INT-TYPES ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (DEFUN MAKE-SCC ...)
; processing (DEFMACRO DBG ...)
; processing (DEFUN MAIN ...)
; processing (MAIN)

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.033

ソースコード

diff # 

;; -*- 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
           #\# #\> (lambda (s c p) (declare (ignore c p)) (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
           #-swank (sb-kernel:ansi-stream in))
  (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))))))))

;;;
;;; Strongly connected components of directed graph
;;;

(defun make-scc (graph)
  "GRAPH := vector of adjacency lists"
  (declare #.OPT
           ((simple-array list (*)) graph))
  (let* ((n (length graph))
         (ords (make-array n :element-type 'uint31 :initial-element 0))
         (lows (make-array n :element-type 'uint31 :initial-element 0))
         (components (make-array n :element-type 'uint31))
         (stack (make-array n :element-type 'uint31))
         (in-stack (make-array n :element-type 'bit :initial-element 0))
         (time 0)
         (ord 0)
         (pointer 0))
    (declare (uint31 time ord pointer))
    (labels ((visit (v)
               (incf time)
               (setf (aref lows v) time
                     (aref ords v) time)
               (setf (aref stack pointer) v)
               (incf pointer)
               (setf (aref in-stack v) 1)
               (dolist (neighbor (aref graph v))
                 (cond ((zerop (aref ords neighbor))
                        (visit neighbor)
                        (setf (aref lows v)
                              (min (aref lows v) (aref lows neighbor))))
                       ((= 1 (aref in-stack neighbor))
                        (setf (aref lows v)
                              (min (aref lows v) (aref ords neighbor))))))
               (when (= (aref lows v) (aref ords v))
                 (loop
                   (decf pointer)
                   (let ((w (aref stack pointer)))
                     (setf (aref in-stack w) 0)
                     (setf (aref components w) ord)
                     (when (= v w)
                       (return))))
                 (incf ord))))
      (dotimes (v n)
        (when (zerop (aref ords v))
          (visit v)))
      components)))

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

;;;
;;; Body
;;;

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (m (read))
         (ls (make-array (* 2 n) :element-type 'uint16))
         (rs (make-array (* 2 n) :element-type 'uint16))
         (graph (make-array (* 4 n) :element-type 'list :initial-element nil))
         (2n (* 2 n))
         (4n (* 4 n)))
    (declare (uint16 n m))
    (dotimes (i n)
      (let* ((l (read-fixnum))
             (r (read-fixnum)))
        (declare (uint16 l r))
        (setf (aref ls i) l
              (aref rs i) r
              (aref ls (+ i n)) (- m r 1)
              (aref rs (+ i n)) (- m l 1))))
    (labels ((negate (x)
               (declare (uint16 x))
               (let ((res (+ x 2n)))
                 (if (>= res 4n)
                     (- res 4n)
                     res)))
             (add-clause! (literal1 literal2)
               (declare (uint16 literal1 literal2))
               (push (negate literal2) (aref graph literal1))
               (push (negate literal1) (aref graph literal2))))
      (declare (inline negate))
      (gc :full t)
      (dotimes (x 2n)
        (loop for y from (+ x 1) below 2n
              do (when (and (/= (+ x n) y)
                            (not (or (< (aref rs x) (aref ls y))
                                     (< (aref rs y) (aref ls x)))))
                   (add-clause! x y))))
      (dotimes (x n)
        (add-clause! (negate x) (negate (+ x n)))
        (add-clause! x (+ x n)))
      (let* ((comps (make-scc graph)))
        (declare ((simple-array uint31 (*)) comps))
        (write-line
         (if (loop for x below 2n
                   thereis (= (aref comps x)
                              (aref comps (+ x 2n))))
             "NO"
             "YES"))))))

#-swank (main)
0