提出 #5192029

---

ソースコード 拡げる

;; -*- 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 (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS
(declaim (inline gemm))
(defun gemm (a b &key (op+ #'+) (op* #'*) (identity+ 0))
  (declare ((simple-array * (* *)) a b)
           (function op+ op*))
  (let ((c (make-array (list (the uint32 (array-dimension a 0))
                             (the uint32 (array-dimension b 1)))
                       :element-type 'uint32)))
    (dotimes (col (array-dimension a 0))
      (dotimes (row (array-dimension b 1))
        (let ((res identity+))
          (dotimes (k (array-dimension a 1))
            (setf res
                  (funcall op+ res (funcall op* (aref a col k) (aref b k row)))))
          (setf (aref c col row) res))))
    c))

(declaim (inline generalized-power))
(defun generalized-power (base power op identity)
  (declare ((integer 0 #.most-positive-fixnum) power)
           (function op))
  (labels ((recur (x p)
             (declare ((integer 0 #.most-positive-fixnum) p))
             (cond ((zerop p) identity)
                   ((evenp p) (recur (funcall op x x) (ash p -1)))
                   (t (funcall op x (recur x (- p 1)))))))
    (recur base power)))

(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)
  (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)
  (pop (queue-list queue)))

(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 main ()
  (declare #.OPT)
  (let* ((n (read))
         (a (- (read) 1))
         (b (- (read) 1))
         (m (read))
         (adja (make-array (list n n) :element-type 'uint32 :initial-element 0))
         ;; dist . city
         (q (make-queue))
         (marked (make-array n :element-type 'bit :initial-element 0))
         (iden (make-array (list n n) :element-type 'uint32 :initial-element 0)))
    (declare (uint8 n a b m))
    (dotimes (i n) (setf (aref iden i i) 1))
    (dotimes (_ m)
      (let ((x (- (read) 1))
            (y (- (read) 1)))
        (setf (aref adja x y) 1
              (aref adja y x) 1)))
    (enqueue (cons 0 a) q)
    (let* ((mindist (loop for (dist . city) of-type (uint8 . uint8) = (dequeue q)
                          until (= city b)
                          do (loop for j below n
                                   when (and (= 1 (aref adja city j))
                                             (zerop (aref marked j)))
                                   do (setf (aref marked j) 1)
                                      (enqueue (cons (+ 1 dist) j) q))
                          finally (return dist)))
           (mat (generalized-power adja
                                   mindist
                                   (lambda (m1 m2)
                                     (declare ((simple-array uint32 (* *)) m1 m2))
                                     (gemm m1 m2
                                           :op+ (lambda (x y)
                                                  (declare (uint32 x y))
                                                  (mod (+ x y) +mod+))
                                           :op* (lambda (x y)
                                                  (declare (uint32 x y))
                                                  (mod (* x y) +mod+))))
                                   iden)))
      (println (aref mat a b)))))

#-swank(main)

提出情報

ジャッジ結果