結果
| 問題 | No.1301 Strange Graph Shortest Path |
| ユーザー |
 sansaqua
|
| 提出日時 | 2020-11-27 22:16:47 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 496 ms / 3,000 ms |
| コード長 | 16,920 bytes |
| コンパイル時間 | 1,128 ms |
| コンパイル使用メモリ | 60,668 KB |
| 実行使用メモリ | 133,968 KB |
| 最終ジャッジ日時 | 2023-10-09 21:20:02 |
| 合計ジャッジ時間 | 14,464 ms |
|
ジャッジサーバーID （参考情報） |
judge12 / judge13 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 14 ms
28,808 KB |
| testcase_01 | AC | 13 ms
28,984 KB |
| testcase_02 | AC | 494 ms
128,496 KB |
| testcase_03 | AC | 256 ms
73,172 KB |
| testcase_04 | AC | 496 ms
129,264 KB |
| testcase_05 | AC | 271 ms
77,256 KB |
| testcase_06 | AC | 312 ms
77,300 KB |
| testcase_07 | AC | 301 ms
79,336 KB |
| testcase_08 | AC | 257 ms
73,144 KB |
| testcase_09 | AC | 297 ms
75,240 KB |
| testcase_10 | AC | 258 ms
75,296 KB |
| testcase_11 | AC | 325 ms
81,452 KB |
| testcase_12 | AC | 326 ms
79,380 KB |
| testcase_13 | AC | 496 ms
133,908 KB |
| testcase_14 | AC | 294 ms
75,236 KB |
| testcase_15 | AC | 296 ms
75,244 KB |
| testcase_16 | AC | 486 ms
130,564 KB |
| testcase_17 | AC | 425 ms
130,688 KB |
| testcase_18 | AC | 288 ms
77,264 KB |
| testcase_19 | AC | 309 ms
79,384 KB |
| testcase_20 | AC | 307 ms
82,768 KB |
| testcase_21 | AC | 307 ms
81,412 KB |
| testcase_22 | AC | 315 ms
79,336 KB |
| testcase_23 | AC | 305 ms
79,320 KB |
| testcase_24 | AC | 314 ms
82,752 KB |
| testcase_25 | AC | 476 ms
130,564 KB |
| testcase_26 | AC | 301 ms
79,320 KB |
| testcase_27 | AC | 322 ms
79,380 KB |
| testcase_28 | AC | 273 ms
79,312 KB |
| testcase_29 | AC | 490 ms
132,592 KB |
| testcase_30 | AC | 461 ms
130,564 KB |
| testcase_31 | AC | 475 ms
130,552 KB |
| testcase_32 | AC | 12 ms
25,768 KB |
| testcase_33 | AC | 229 ms
130,616 KB |
| testcase_34 | AC | 429 ms
133,968 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 09 OCT 2023 09:19:47 PM): ; processing (IN-PACKAGE :CL-USER) ; processing (DEFPARAMETER *OPT* ...) ; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...) ; processing (SETQ *RANDOM-STATE* ...) ; processing (DEFINE-INT-TYPES 2 ...) ; processing (DEFCONSTANT +MOD+ ...) ; processing (DEFMACRO DBG ...) ; processing (DECLAIM (INLINE PRINTLN)) ; processing (DEFUN PRINTLN ...) ; processing (DEFPACKAGE :CP/MAX-FLOW ...) ; processing (IN-PACKAGE :CP/MAX-FLOW) ; processing (DEFINE-CONDITION MAX-FLOW-OVERFLOW ...) ; processing (DEFSTRUCT (EDGE #) ...) ; processing (DEFMETHOD PRINT-OBJECT ...) ; processing (DEFUN ADD-EDGE ...) ; processing (DECLAIM (INLINE REINITIALIZE-FLOW-NETWORK)) ; processing (DEFUN REINITIALIZE-FLOW-NETWORK ...) ; processing (DEFPACKAGE :CP/MIN-COST-FLOW ...) ; processing (IN-PACKAGE :CP/MIN-COST-FLOW) ; processing (DEFTYPE COST-TYPE ...) ; processing (DEFCONSTANT +INF-COST+ ...) ; processing (ASSERT (AND # ...)) ; processing (DEFSTRUCT (CEDGE # ...) ...) ; processing (DEFINE-CONDITION NOT-ENOUGH-CAPACITY-ERROR ...) ; processing (DEFMETHOD PRINT-OBJECT ...) ; processing (DEFUN ADD-CEDGE ...) ; processing (DEFPACKAGE :CP/SSP ...) ; processing (IN-PACKAGE :CP/SSP) ; processing (DEFSTRUCT (HEAP # ...) ...) ; processing (DEFUN HEAP-PUSH ...) ; file: /home/judge/data/code/Main.lisp ; in: DEFUN HEAP-PUSH ; (ADJUST-ARRAY (CP/SSP::HEAP-COSTS CP/SSP::HEAP) (* POSITION 2)) ; ; note: doing signed word to integer coercion (cost 20) ; (ADJUST-ARRAY (CP/SSP::HEAP-VERTICES CP/SSP::HEAP) (* POSITION 2)) ; ; note: doing signed word to integer coercion (cost 20) ; processing (DEFUN HEAP-POP ...) ; processing (DECLAIM (INLINE HEAP-EMPTY-P)) ; processing (DEFUN HEAP-EMPTY-P ...) ; processing (DECLAIM (INLINE HEAP-REINITIALIZE)) ; processing (DEFUN HEAP-REINITIALIZE ...) ; processing (DEFMACRO THE-COST-TYPE ...) ; processing (DEFUN MIN-COST-FLOW! ...) ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MIN-CO
ソースコード
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *opt*
#+swank '(optimize (speed 3) (safety 2))
#-swank '(optimize (speed 3) (safety 0) (debug 0)))
#+swank (ql:quickload '(:cl-debug-print :fiveam :cp/util) :silent t)
#+swank (use-package :cp/util :cl-user)
#-swank (set-dispatch-macro-character
#\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))
#+sbcl (setq *random-state* (seed-random-state (nth-value 1 (get-time-of-day)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)
(macrolet ((def (b)
`(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
(define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(def ,b)) bits))))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64))
(defconstant +mod+ 1000000007)
(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)))
(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
(let ((*read-default-float-format*
(if (typep obj 'double-float) 'double-float *read-default-float-format*)))
(prog1 (princ obj stream) (terpri stream))))
;; BEGIN_INSERTED_CONTENTS
(defpackage :cp/max-flow
(:use :cl)
(:export #:edge #:add-edge #:reinitialize-flow-network #:max-flow-overflow
#:edge-to #:edge-capacity #:edge-default-capacity #:edge-reversed))
(in-package :cp/max-flow)
(define-condition max-flow-overflow (error)
((graph :initarg :graph :reader max-flow-overflow-graph))
(:report
(lambda (condition stream)
(format stream "MOST-POSITIVE-FIXNUM or more units can flow on graph ~W."
(max-flow-overflow-graph condition)))))
(defstruct (edge (:constructor %make-edge
(to capacity reversed
&aux (default-capacity capacity))))
(to nil :type (integer 0 #.most-positive-fixnum))
(capacity 0 :type (integer 0 #.most-positive-fixnum))
(default-capacity 0 :type (integer 0 #.most-positive-fixnum))
(reversed nil :type (or null edge)))
(defmethod print-object ((edge edge) stream)
(let ((*print-circle* t))
(call-next-method)))
(defun add-edge (graph from-idx to-idx capacity &key bidirectional)
"FROM-IDX, TO-IDX := index of vertex
GRAPH := vector of lists of all the edges that goes from each vertex
If BIDIRECTIONAL is true, ADD-EDGE adds the reversed edge of the same
capacity in addition."
(declare (optimize (speed 3))
((simple-array list (*)) graph))
(let* ((dep (%make-edge to-idx capacity nil))
(ret (%make-edge from-idx
(if bidirectional capacity 0)
dep)))
(setf (edge-reversed dep) ret)
(push dep (aref graph from-idx))
(push ret (aref graph to-idx))))
(declaim (inline reinitialize-flow-network))
(defun reinitialize-flow-network (graph)
"Sets the current CAPACITY of every edge in GRAPH to the default
capacity. That is, this function reinitialize the graph network to the state
prior to sending flow."
(loop for edges across graph
do (dolist (edge edges)
(setf (edge-capacity edge) (edge-default-capacity edge)))))
;;;
;;; Minimum cost flow (SSP)
;;;
(defpackage :cp/min-cost-flow
(:use :cl :cp/max-flow)
(:export #:cedge #:cedge-p #:copy-cedge #:add-cedge #:+inf-cost+ #:cost-type
#:cedge-reversed #:cedge-cost #:cedge-capacity #:cedge-to #:cedge-default-capacity
#:not-enough-capacity-error #:not-enough-capacity-error-graph
#:not-enough-capacity-error-flow #:not-enough-capacity-error-score))
(in-package :cp/min-cost-flow)
;; COST-TYPE and +INF-COST+ may be changed. (A supposed use case is to adopt
;; bignum).
(deftype cost-type () 'fixnum)
(defconstant +inf-cost+ most-positive-fixnum)
(assert (and (typep +inf-cost+ 'cost-type)
(subtypep 'cost-type 'integer)))
(defstruct (cedge (:constructor %make-cedge)
(:include edge))
(cost 0 :type cost-type))
(define-condition not-enough-capacity-error (error)
((graph :initarg :graph :reader not-enough-capacity-error-graph)
(flow :initarg :flow :reader not-enough-capacity-error-flow)
(score :initarg :score :reader not-enough-capacity-error-score))
(:report
(lambda (c s)
(format s "Cannot send ~A units of flow on graph ~A due to not enough capacity."
(not-enough-capacity-error-flow c)
(not-enough-capacity-error-graph c)))))
(defmethod print-object ((cedge cedge) stream)
(let ((*print-circle* t))
(call-next-method)))
(defun add-cedge (graph from-idx to-idx cost capacity)
"FROM-IDX, TO-IDX := index of vertex
GRAPH := vector of list of all the edges that goes from the vertex"
(declare ((simple-array list (*)) graph)
(cost-type cost))
(let* ((dep (%make-cedge :to to-idx :capacity capacity :cost cost))
(ret (%make-cedge :to from-idx :capacity 0 :cost (- cost) :reversed dep)))
(setf (cedge-reversed dep) ret)
(push dep (aref graph from-idx))
(push ret (aref graph to-idx))))
(defpackage :cp/ssp
(:use :cl :cp/min-cost-flow)
(:export #:min-cost-flow!))
(in-package :cp/ssp)
;; binary heap for Dijkstra's algorithm
(defstruct (heap (:constructor make-heap
(size
&aux (costs (make-array (1+ size) :element-type 'cost-type))
(vertices (make-array (1+ size) :element-type 'fixnum))))
(:copier nil)
(:predicate nil))
(costs nil :type (simple-array cost-type (*)))
(vertices nil :type (simple-array fixnum (*)))
(position 1 :type (integer 1 #.most-positive-fixnum)))
(defun heap-push (cost vertex heap)
(declare (optimize (speed 3)))
(symbol-macrolet ((position (heap-position heap)))
(when (>= position (length (heap-costs heap)))
(setf (heap-costs heap)
(adjust-array (heap-costs heap) (* position 2))
(heap-vertices heap)
(adjust-array (heap-vertices heap) (* position 2))))
(let ((costs (heap-costs heap))
(vertices (heap-vertices heap)))
(labels ((heapify (pos)
(declare (optimize (safety 0)))
(unless (= pos 1)
(let ((parent-pos (ash pos -1)))
(when (< (aref costs pos) (aref costs parent-pos))
(rotatef (aref costs pos) (aref costs parent-pos))
(rotatef (aref vertices pos) (aref vertices parent-pos))
(heapify parent-pos))))))
(setf (aref costs position) cost
(aref vertices position) vertex)
(heapify position)
(incf position)
heap))))
(defun heap-pop (heap)
(declare (optimize (speed 3)))
(symbol-macrolet ((position (heap-position heap)))
(let ((costs (heap-costs heap))
(vertices (heap-vertices heap)))
(labels ((heapify (pos)
(declare (optimize (safety 0))
((integer 1 #.most-positive-fixnum) pos))
(let* ((child-pos1 (+ pos pos))
(child-pos2 (1+ child-pos1)))
(when (<= child-pos1 position)
(if (<= child-pos2 position)
(if (< (aref costs child-pos1) (aref costs child-pos2))
(unless (< (aref costs pos) (aref costs child-pos1))
(rotatef (aref costs pos) (aref costs child-pos1))
(rotatef (aref vertices pos) (aref vertices child-pos1))
(heapify child-pos1))
(unless (< (aref costs pos) (aref costs child-pos2))
(rotatef (aref costs pos) (aref costs child-pos2))
(rotatef (aref vertices pos) (aref vertices child-pos2))
(heapify child-pos2)))
(unless (< (aref costs pos) (aref costs child-pos1))
(rotatef (aref costs pos) (aref costs child-pos1))
(rotatef (aref vertices pos) (aref vertices child-pos1))))))))
(multiple-value-prog1 (values (aref costs 1) (aref vertices 1))
(decf position)
(setf (aref costs 1) (aref costs position)
(aref vertices 1) (aref vertices position))
(heapify 1))))))
(declaim (inline heap-empty-p))
(defun heap-empty-p (heap)
(= (heap-position heap) 1))
(declaim (inline heap-reinitialize))
(defun heap-reinitialize (heap)
(setf (heap-position heap) 1)
heap)
(defmacro the-cost-type (form)
(reduce (lambda (x y) `(,(car form) (the cost-type ,x) (the cost-type ,y)))
(cdr form)))
(defun min-cost-flow! (graph src-idx dest-idx flow &key edge-count (if-overflow :error) bellman-ford)
"Returns the minimum cost to send FLOW units from SRC-IDX to DEST-IDX in
GRAPH. This function destructively modifies GRAPH.
EDGE-COUNT := initial reserved size for heap (it should be the number of edges)
IF-OVERFLOW := :error | nil
If BELLMAN-FORD is true, this function does Bellman-Ford before all. It should
be enabled for a graph that contains negative edges: Currently this function
returns a correct result for a graph that contains negative edges, even when
BELLMAN-FORD is disabled (only if no negative **cycles** are contained, of
course). In this case, however, the worst-case time complexity is
exponential.
As a special case, if an input network is for a weighted bipartite matching that
contains negative weights, this function works without Bellman-Ford."
(declare (optimize (speed 3))
((integer 0 #.most-positive-fixnum) flow src-idx dest-idx)
((simple-array list (*)) graph))
(let* ((size (length graph))
(edge-count (or edge-count (* size 2)))
(prev-vertices (make-array size :element-type 'fixnum :initial-element 0))
(prev-edges (locally
(declare (sb-ext:muffle-conditions style-warning))
(make-array size :element-type 'cedge)))
(potential (make-array size :element-type 'cost-type :initial-element 0))
(dists (make-array size :element-type 'cost-type))
(pqueue (make-heap edge-count))
(res 0))
(declare (fixnum edge-count)
(cost-type res))
(labels ((update-potential ()
(when (= (aref dists dest-idx) +inf-cost+)
(if if-overflow
(error 'not-enough-capacity-error :flow flow :graph graph :score res)
(return-from min-cost-flow! res)))
(dotimes (v size)
(setf (aref potential v)
(min +inf-cost+ (+ (aref potential v) (aref dists v)))))))
(when bellman-ford
(fill dists +inf-cost+)
(setf (aref dists src-idx) 0)
(dotimes (_ (- size 1))
(dotimes (v size)
(let ((dist (aref dists v)))
(when (< dist +inf-cost+)
(dolist (cedge (aref graph v))
(when (> (cedge-capacity cedge) 0)
(let ((to (cedge-to cedge)))
(setf (aref dists to)
(min (aref dists to) (+ dist (cedge-cost cedge)))))))))))
(update-potential))
(loop (when (<= flow 0)
(return-from min-cost-flow! res))
(fill dists +inf-cost+)
(setf (aref dists src-idx) 0)
(heap-reinitialize pqueue)
(heap-push 0 src-idx pqueue)
(loop until (heap-empty-p pqueue)
do (multiple-value-bind (cost v) (heap-pop pqueue)
(declare (cost-type cost)
(fixnum v))
(when (<= cost (aref dists v))
(dolist (edge (aref graph v))
(let* ((next-v (cedge-to edge))
(next-cost (the-cost-type
(+ (aref dists v)
(cedge-cost edge)
(aref potential v)
(- (aref potential next-v))))))
(when (and (> (cedge-capacity edge) 0)
(> (aref dists next-v) next-cost))
(setf (aref dists next-v) next-cost
(aref prev-vertices next-v) v
(aref prev-edges next-v) edge)
(heap-push next-cost next-v pqueue)))))))
(update-potential)
(let ((max-flow flow))
(declare ((integer 0 #.most-positive-fixnum) max-flow))
(do ((v dest-idx (aref prev-vertices v)))
((= v src-idx))
(setq max-flow (min max-flow (cedge-capacity (aref prev-edges v)))))
(decf flow max-flow)
(incf res (the cost-type (* max-flow (aref potential dest-idx))))
(do ((v dest-idx (aref prev-vertices v)))
((= v src-idx))
(decf (cedge-capacity (aref prev-edges v)) max-flow)
(incf (cedge-capacity (cedge-reversed (aref prev-edges v))) max-flow)))))))
(defpackage :cp/read-fixnum
(:use :cl)
(:export #:read-fixnum))
(in-package :cp/read-fixnum)
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
"NOTE: cannot read -2^62"
(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 #\-))
(setq 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))))))))
;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/read-fixnum :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/min-cost-flow :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/ssp :cl-user))
(in-package :cl-user)
;;;
;;; Body
;;;
(defun main ()
(let* ((n (read))
(m (read))
(graph (make-array n :element-type 'list :initial-element nil)))
(dotimes (_ m)
(let ((u (- (read-fixnum) 1))
(v (- (read-fixnum) 1))
(c (read-fixnum))
(d (read-fixnum)))
(add-cedge graph u v c 1)
(add-cedge graph v u c 1)
(add-cedge graph u v d 1)
(add-cedge graph v u d 1)))
(println (min-cost-flow! graph 0 (- n 1) 2))))
#-swank (main)
;;;
;;; Test and benchmark
;;;
#+swank
(progn
(defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname))
(setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*))
(uiop:chdir *default-pathname-defaults*)
(defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*))
(defparameter *problem-url* "https://yukicoder.me/problems/no/1301"))
#+swank
(defun gen-dat ()
(uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
(format out "")))
#+swank
(defun bench (&optional (out (make-broadcast-stream)))
(time (run *dat-pathname* out)))
#+(and sbcl (not swank))
(eval-when (:compile-toplevel)
(when (or (> sb-c::*compiler-warning-count* 0)
sb-c::*undefined-warnings*)
(error "count: ~D, undefined warnings: ~A"
sb-c::*compiler-warning-count*
sb-c::*undefined-warnings*)))
;; To run: (5am:run! :sample)
#+swank
(5am:test :sample
(5am:is
(equal "8
"
(run "3 2
1 2 1 4
2 3 1 2
" nil)))
(5am:is
(equal "3
"
(run "3 3
1 2 1 4
2 3 1 5
1 3 1 6
" nil))))