結果

問題 No.274 The Wall
ユーザー sansaquasansaqua
提出日時 2019-09-18 00:33:03
言語 Common Lisp
(sbcl 2.3.8)
結果
TLE  
実行時間 -
コード長 6,589 bytes
コンパイル時間 144 ms
コンパイル使用メモリ 44,208 KB
実行使用メモリ 661,516 KB
最終ジャッジ日時 2023-09-21 20:34:48
合計ジャッジ時間 33,481 ms
ジャッジサーバーID
(参考情報)
judge11 / judge13
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 TLE -
testcase_01 TLE -
testcase_02 TLE -
testcase_03 MLE -
testcase_04 TLE -
testcase_05 TLE -
testcase_06 TLE -
testcase_07 TLE -
testcase_08 TLE -
testcase_09 TLE -
testcase_10 TLE -
testcase_11 TLE -
testcase_12 AC 34 ms
24,568 KB
testcase_13 MLE -
testcase_14 AC 676 ms
235,500 KB
testcase_15 AC 269 ms
133,156 KB
testcase_16 AC 481 ms
237,684 KB
testcase_17 AC 473 ms
236,296 KB
testcase_18 AC 497 ms
236,264 KB
testcase_19 AC 66 ms
32,660 KB
testcase_20 AC 57 ms
26,576 KB
testcase_21 AC 57 ms
26,656 KB
testcase_22 AC 58 ms
30,372 KB
testcase_23 AC 58 ms
26,708 KB
testcase_24 AC 58 ms
26,584 KB
testcase_25 AC 57 ms
28,632 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 21 SEP 2023 08:34:13 PM):
; 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 (DEFSTRUCT (SCC #) ...)
; processing (DECLAIM (INLINE %MAKE-REVGRAPH))
; processing (DEFUN %MAKE-REVGRAPH ...)
; 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.043

ソースコード

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
;;;

(defstruct (scc (:constructor %make-scc (graph revgraph components count)))
  (graph nil :type (simple-array list (*)))
  ;; reversed graph
  (revgraph nil :type (simple-array list (*)))
  ;; components[i] := strongly connected component of the i-th vertex
  (components nil :type (simple-array (unsigned-byte 32) (*)))
  ;; the total number of strongly connected components
  (count 0 :type (unsigned-byte 32)))

(declaim (inline %make-revgraph))
(defun %make-revgraph (graph)
  (let* ((revgraph (make-array 8000 :element-type 'list :initial-element nil)))
    (dotimes (i 8000)
      (dolist (dest (aref graph i))
        (push i (aref revgraph dest))))
    revgraph))

(defun make-scc (graph &optional revgraph)
  "GRAPH := vector of adjacency lists
REVGRAPH := NIL | reversed graph of GRAPH"
  (declare #.OPT
           ((simple-array list (*)) graph)
           ((or null (simple-array list (*))) revgraph))
  (let* ((revgraph (or revgraph (%make-revgraph graph)))
         (visited (make-array 8000 :element-type 'bit :initial-element 0))
         (posts (make-array 8000 :element-type '(unsigned-byte 32)))
         (components (make-array 8000 :element-type '(unsigned-byte 32)))
         (pointer 0)
         (ord 0) ; ordinal number for a strongly connected component
         )
    (declare ((unsigned-byte 32) pointer ord)
             (dynamic-extent visited posts))
    (labels ((dfs (v)
               (setf (aref visited v) 1)
               (dolist (neighbor (aref graph v))
                 (when (zerop (aref visited neighbor))
                   (dfs neighbor)))
               (setf (aref posts pointer) v)
               (incf pointer))
             (reversed-dfs (v ord)
               (setf (aref visited v) 1
                     (aref components v) ord)
               (dolist (neighbor (aref revgraph v))
                 (when (zerop (aref visited neighbor))
                   (reversed-dfs neighbor ord)))))
      (dotimes (v 8000)
        (when (zerop (aref visited v))
          (dfs v)))
      (fill visited 0)
      (loop for i from 7999 downto 0
            for v = (aref posts i)
            when (zerop (aref visited v))
            do (reversed-dfs v ord)
               (incf ord))
      (%make-scc graph revgraph components ord))))

(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 4000 :element-type 'uint16))
         (rs (make-array 4000 :element-type 'uint16))
         (graph (make-array 8000 :element-type 'list :initial-element nil)))
    (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 2000)) (- m r 1)
              (aref rs (+ i 2000)) (- m l 1))))
    (labels ((overlap-p (x y)
               (let ((l1 (aref ls x))
                     (r1 (aref rs x))
                     (l2 (aref ls y))
                     (r2 (aref rs y)))
                 (not (or (< r1 l2) (< r2 l1)))))
             (negate (x)
               (declare (uint16 x))
               (let ((res (+ x 4000)))
                 (if (>= res 8000)
                     (- res 8000)
                     res)))
             (add-clause! (literal1 literal2 bool1 bool2)
               (unless bool1
                 (setq literal1 (negate literal1)))
               (unless bool2
                 (setq literal2 (negate literal2)))
               (push literal2 (aref graph (negate literal1)))
               (push literal1 (aref graph (negate literal2)))))
      (declare (inline negate overlap-p))
      (gc :full t)
      (dotimes (x 4000)
        (loop for y from (+ x 1) below 4000
              do (when (and (/= (+ x n) y)
                            (overlap-p x y))
                   (add-clause! x y nil nil))))
      (dotimes (x n)
        (add-clause! x (+ x 2000) t t)
        (add-clause! x (+ x 2000) nil nil))
      (let* ((scc (make-scc graph))
             (comps (scc-components scc)))
        (write-line
         (if (loop for x below 4000
                   thereis (= (aref comps x)
                              (aref comps (+ x 4000))))
             "NO"
             "YES"))))))

#-swank (main)
0