提出 #6094721

---

ソースコード 拡げる

;; -*- coding: utf-8 -*-
(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 (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil (values) t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS
(defstruct (queue (:constructor make-queue
                    (&optional list &aux (tail (last list)))))
  (list nil :type list)
  (tail nil :type (or null (cons t null))))

(declaim (inline enqueue))
(defun enqueue (obj queue)
  "Pushes OBJ to the end of QUEUE."
  (symbol-macrolet ((list (queue-list queue))
                    (tail (queue-tail queue)))
    (if (null list)
        (setf tail (list obj)
              list tail)
        (setf (cdr tail) (list obj)
              tail (cdr tail))))
  queue)

(declaim (inline dequeue))
(defun dequeue (queue)
  "Pops OBJ from the front of QUEUE."
  (pop (queue-list queue)))

(declaim (inline queue-empty-p))
(defun queue-empty-p (queue)
  (null (queue-list queue)))

(declaim (inline enqueue-front))
(defun enqueue-front (obj queue)
  "Pushes OBJ to the front of QUEUE."
  (symbol-macrolet ((list (queue-list queue))
                    (tail (queue-tail queue)))
    (if (null list)
        (setf tail (list obj)
              list tail)
        (push obj list))
    queue))

;; Scheme-style named let
(defmacro nlet (name args &body body)
  (labels ((ensure-list (x) (if (listp x) x (list x))))
    (let ((args (mapcar #'ensure-list args)))
      `(labels ((,name ,(mapcar #'car args) ,@body))
         (,name ,@(mapcar #'cadr args))))))

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  (declare #.OPT)
  (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))))))))

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

(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 (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

(defconstant +mod+ 1000000007)

;; Body

(defun first-win-p (xs revgraph degs threshold)
  (declare #.OPT
           ((simple-array uint32 (*)) degs xs)
           ((simple-array list (*)) revgraph)
           (uint32 threshold))
  (let* ((n (length revgraph))
         (dp0 (make-array n :element-type 'int8 :initial-element -1))
         (dp1 (make-array n :element-type 'int8 :initial-element -1))
         (degs0 (copy-seq degs))
         (degs1 (copy-seq degs))
         ;; vertex . turn
         (q (make-queue)))
    (dotimes (i n)
      (if (>= (aref xs i) threshold)
          (progn (setf (aref dp0 i) 1)
                 (enqueue (cons i 0) q))
          (progn (setf (aref dp1 i) 1)
                 (enqueue (cons i 1) q)))
      (when (zerop (aref degs i))
        (if (>= (aref xs i) threshold)
            (progn (setf (aref dp1 i) 0)
                   (enqueue (cons i 1) q))
            (progn (setf (aref dp0 i) 0)
                   (enqueue (cons i 0) q)))))
    (loop until (queue-empty-p q)
          for (vertex . turn) of-type (uint32 . uint32) = (dequeue q)
          for dp = (if (= turn 0) dp0 dp1)
          for opponent-dp = (if (= turn 0) dp1 dp0)
          for degs = (if (= turn 0) degs0 degs1)
          for opponent-degs = (if (= turn 0) degs1 degs0)
          do (dolist (prev (aref revgraph vertex))
               (when (= (aref opponent-dp prev) -1)
                 (decf (aref opponent-degs prev))
                 (if (zerop (aref dp vertex))
                     (progn (setf (aref opponent-dp prev) 1)
                            (enqueue (cons prev (logxor 1 turn)) q))
                     (when (zerop (aref opponent-degs prev))
                       (setf (aref opponent-dp prev) 0)
                       (enqueue (cons prev (logxor 1 turn)) q))))))
    (= 1 (aref dp0 0))))

(defun main ()
  (let* ((n (read))
         (m (read))
         (xs (make-array n :element-type 'uint32))
         (revgraph (make-array n :element-type 'list :initial-element nil))
         (degs (make-array n :element-type 'uint32 :initial-element 0)))
    (dotimes (i n) (setf (aref xs i) (read-fixnum)))
    (dotimes (i m)
      (let ((a (- (read-fixnum) 1))
            (b (- (read-fixnum) 1)))
        (push a (aref revgraph b))
        (incf (aref degs a))))
    (nlet bisect ((ok 0) (ng #xffffffff))
      (if (<= (- ng ok) 1)
          (println ok)
          (let ((mid (ash (+ ok ng) -1)))
            (if (first-win-p xs revgraph degs mid)
                (bisect mid ng)
                (bisect ok mid)))))))

#-swank(main)

提出情報

ジャッジ結果