結果

問題 No.1449 新プロランド
ユーザー linuxmetellinuxmetel
提出日時 2021-03-23 21:39:53
言語 Common Lisp
(sbcl 2.3.8)
結果
WA  
(最新)
AC  
(最初)
実行時間 -
コード長 5,286 bytes
コンパイル時間 413 ms
コンパイル使用メモリ 43,484 KB
実行使用メモリ 35,424 KB
最終ジャッジ日時 2023-08-25 16:44:49
合計ジャッジ時間 2,651 ms
ジャッジサーバーID
（参考情報） 		judge12 / judge11
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 13 ms
31,588 KB
testcase_01 AC 16 ms
29,284 KB
testcase_02 AC 21 ms
29,292 KB
testcase_03 AC 13 ms
29,304 KB
testcase_04 AC 14 ms
32,112 KB
testcase_05 AC 82 ms
33,420 KB
testcase_06 AC 59 ms
31,360 KB
testcase_07 AC 33 ms
31,300 KB
testcase_08 AC 59 ms
31,364 KB
testcase_09 AC 43 ms
29,332 KB
testcase_10 AC 35 ms
31,388 KB
testcase_11 AC 18 ms
29,372 KB
testcase_12 AC 52 ms
33,416 KB
testcase_13 AC 47 ms
31,432 KB
testcase_14 AC 18 ms
29,312 KB
testcase_15 AC 66 ms
34,032 KB
testcase_16 AC 44 ms
29,392 KB
testcase_17 AC 50 ms
31,416 KB
testcase_18 AC 13 ms
31,640 KB
testcase_19 AC 14 ms
32,192 KB
testcase_20 AC 12 ms
29,300 KB
testcase_21 AC 24 ms
29,284 KB
testcase_22 AC 18 ms
29,288 KB
testcase_23 AC 30 ms
31,324 KB
testcase_24 AC 36 ms
29,388 KB
testcase_25 AC 13 ms
31,656 KB
testcase_26 WA -
testcase_27 AC 93 ms
35,424 KB
testcase_28 WA -
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 25 AUG 2023 04:44:46 PM):
; processing (DEFCONSTANT INF ...)
; processing (DEFCONSTANT -INF ...)
; processing (DEFMACRO SWAP ...)
; processing (DEFUN MAX-FUN ...)
; processing (DEFCLASS BINARY-HEAP ...)
; processing (DECLAIM (INLINE LEFT))
; processing (DEFUN LEFT ...)
; processing (DECLAIM (INLINE RIGHT))
; processing (DEFUN RIGHT ...)
; processing (DECLAIM (INLINE PARE))
; processing (DEFUN PARE ...)
; processing (DEFUN MAKE-BINARY-HEAP ...)
; processing (DEFUN BINARY-HEAP-PUSH ...)
; processing (DEFUN BINARY-HEAP-POP ...)
; processing (DEFUN BINARY-HEAP-MOST ...)
; processing (DEFUN BINARY-HEAP-EMPTY ...)
; processing (DEFUN DIJKSTRA ...)
; processing (DEFMACRO DEF-READ! ...)
; processing (DEF-READ! *N* ...)
; processing (DEFPARAMETER *G* ...)
; processing (LOOP :REPEAT ...)
; processing (DEFPARAMETER *T* ...)
; processing (FORMAT T ...)

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

ソースコード

diff # 

; inf, -inf です (おそらく実装依存で SBCL では動く)
(defconstant  inf #.DOUBLE-FLOAT-POSITIVE-INFINITY)
(defconstant -inf #.DOUBLE-FLOAT-NEGATIVE-INFINITY)

(defmacro swap (p q)       
  (let ((g (gensym)))
    `(let ((,g ,q)) (setf ,q ,p ,p ,g))))
 
(defun max-fun (f x y)
  (if (funcall f x y)
      x
      y))
 
(defclass binary-heap ()
  ((vec :accessor .binary-heap-vec
        :initform (make-array 8192 :initial-element nil)
        :initarg :vec)
   (emp :accessor .binary-heap-emp
        :initform 0
        :initarg :emp)
   (cap :accessor .binary-heap-cap
        :initform 8192
        :initarg :cap)
   (fun :accessor .binary-heap-fun
        :initform #'>
        :initarg :fun)))
 
(declaim (inline left))
(defun left (i)
  (+ (* i 2) 1))
 
(declaim (inline right))
(defun right (i)
  (+ (* i 2) 2))
 
(declaim (inline pare))
(defun pare (i)
  (floor (1- i) 2))
 
(defun make-binary-heap (&key (cap 8192) (fun #'>))
  (make-instance 'binary-heap :cap cap :fun fun
                 :vec (make-array cap :initial-element nil)))
 
(defun binary-heap-push (heap x)
  (let* ((vec (.binary-heap-vec heap))
         (emp (.binary-heap-emp heap))
         (i emp)
         (fun (.binary-heap-fun heap)))
    (setf (aref vec emp) x)
    (loop until (= i 0)
          while (funcall fun (aref vec i) (aref vec (pare i)))
          do (swap (aref vec i) (aref vec (pare i)))
             (setq i (pare i)))
    (setf (.binary-heap-emp heap) (1+ emp))
    x))
 
(defun binary-heap-pop (heap)
  (if (= (.binary-heap-emp heap) 0)
      nil
      (let* ((vec (.binary-heap-vec heap))
             (ret (aref vec 0))
             (emp (setf (.binary-heap-emp heap) (1- (.binary-heap-emp heap))))
             (fun (.binary-heap-fun heap))
             (i 0))
        (setf (aref vec 0) (aref vec emp) (aref vec emp) nil)
        (loop until (>= (right i) emp)
              while (funcall fun (max-fun fun
                                          (aref vec (left i))
                                          (aref vec (right i)))
                             (aref vec i))
              do (if (funcall fun (aref vec (left i)) (aref vec (right i)))
                     (progn (swap (aref vec (left i)) (aref vec i))
                            (setq i (left i)))
                     (progn (swap (aref vec (right i)) (aref vec i))
                            (setq i (right i)))))
        (when (and (= (left i) (- emp 1))
                   (funcall fun (aref vec (left i)) (aref vec i)))
          (swap (aref vec (left i)) (aref vec i)))
        ret)))
 
(defun binary-heap-most (heap)
  (aref (.binary-heap-vec heap) 0))
 
(defun binary-heap-empty (heap)
  (equal (.binary-heap-emp heap) 0))
 
; graph グラフ
; time 各頂点での時間
; start 最初の地点
(defun dijkstra (graph time start)
  (let* (; (list 最短時間 (min 1001 食べた量) 頂点番号)
         (que (make-binary-heap :cap 16384 :fun #'(lambda (p q) (< (car p) (car q))))) ; 優先度付きキュー
         
         ; start からの各頂点までの最短時間 (inf に初期化)
         ; (aref d 頂点番号 食べた時間)
         (d (make-array (list (1+ (length graph)) 1005) :initial-element inf)))
    (setf (aref d start (aref time 0)) (aref time 0)) ; d の最初の頂点 を 初期化
    (binary-heap-push que (list 0 0 start)) ; start をキューに追加
    (loop :with p = nil
          :until (binary-heap-empty que)
          :do (setq p (binary-heap-pop que))
              ;(princ p)
          ;:do (princ (aref d (third p) (second p)))
          :unless (< (aref d (third p) (second p)) (first p))
          :do (destructuring-bind (a b c) p
                (loop :for e :in (aref graph c)
                      :do (destructuring-bind (to . cost) e
                            ;(princ e) (princ p) (fresh-line)
                            (when (> (aref d to (min 1001 (+ b (aref time c))))
                                     (+ a (floor cost (+ b (aref time c))) (aref time c)))
                              (setf (aref d to (min 1001 (+ b (aref time c))))
                                    (+ a (floor cost (+ b (aref time c))) (aref time c)))
                              (binary-heap-push que (list (aref d to (min 1001 (+ b (aref time c))))
                                                          (min 1001 (+ b (aref time c)))
                                                          to)))))))
    d))


; read してグローバル変数を定義します
; (def-read! *a* *b* *c*)
; (defvar *a* (read)) (defvar *b* (read)) (defvar *c* (read))
(defmacro def-read! (&rest args)
    `(progn
       ,@(loop :for i :in args
               :collect `(defvar ,i (read)))))

(def-read! *n* *m*)

(defparameter *g* (make-array *n* :initial-element '()))

(loop :repeat *m*
      :do (let ((a (1- (read)))
                (b (1- (read)))
                (c (read)))
            (push (cons a c) (aref *g* b))
            (push (cons b c) (aref *g* a))))

(defparameter *t* (concatenate 'vector (loop :repeat *n*
                                             :collect (read))))

(format t "~a~%" (let ((d (dijkstra *g* *t* 0)))
                   (loop :for i :below 1005
                         :minimize (aref d (1- *n*) i))))
;(princ *t*)
0