結果

問題 No.274 The Wall
ユーザー sansaquasansaqua
提出日時 2019-09-18 02:07:44
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 868 ms / 2,000 ms
コード長 5,800 bytes
コンパイル時間 290 ms
コンパイル使用メモリ 44,016 KB
実行使用メモリ 344,136 KB
最終ジャッジ日時 2024-06-22 02:30:33
合計ジャッジ時間 3,310 ms
ジャッジサーバーID
(参考情報)
judge4 / judge3
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 10 ms
31,040 KB
testcase_01 AC 10 ms
27,048 KB
testcase_02 AC 10 ms
27,048 KB
testcase_03 AC 265 ms
138,788 KB
testcase_04 AC 12 ms
33,044 KB
testcase_05 AC 11 ms
27,052 KB
testcase_06 AC 12 ms
29,132 KB
testcase_07 AC 11 ms
27,048 KB
testcase_08 AC 12 ms
30,908 KB
testcase_09 AC 12 ms
33,044 KB
testcase_10 AC 11 ms
26,924 KB
testcase_11 AC 868 ms
344,136 KB
testcase_12 AC 31 ms
29,484 KB
testcase_13 AC 11 ms
26,924 KB
testcase_14 AC 18 ms
27,052 KB
testcase_15 AC 31 ms
27,180 KB
testcase_16 AC 201 ms
77,412 KB
testcase_17 AC 187 ms
78,404 KB
testcase_18 AC 176 ms
79,464 KB
testcase_19 AC 45 ms
29,304 KB
testcase_20 AC 49 ms
29,320 KB
testcase_21 AC 51 ms
29,324 KB
testcase_22 AC 59 ms
33,276 KB
testcase_23 AC 58 ms
31,492 KB
testcase_24 AC 54 ms
31,360 KB
testcase_25 AC 54 ms
33,504 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 22 JUN 2024 02:30:29 AM):

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

ソースコード

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