結果
問題 | No.386 貪欲な領主 |
ユーザー |
|
提出日時 | 2019-11-09 16:58:51 |
言語 | Common Lisp (sbcl 2.5.0) |
結果 |
AC
|
実行時間 | 245 ms / 2,000 ms |
コード長 | 10,468 bytes |
コンパイル時間 | 1,092 ms |
コンパイル使用メモリ | 46,336 KB |
実行使用メモリ | 55,168 KB |
最終ジャッジ日時 | 2024-09-15 04:37:13 |
合計ジャッジ時間 | 2,320 ms |
ジャッジサーバーID (参考情報) |
judge2 / judge4 |
外部呼び出し有り |
(要ログイン)
ファイルパターン | 結果 |
---|---|
other | AC * 16 |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 15 SEP 2024 04:37:10 AM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MAKE-LCA-TABLE ; (AREF WEIGHTS 0) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; (AREF WEIGHTS V) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; (AREF GRAPH V) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; (AREF WEIGHTS DEST) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; (+ COST (AREF WEIGHTS DEST)) ; ; note: forced to do GENERIC-+ (cost 10) ; unable to do inline fixnum arithmetic (cost 2) because: ; The second argument is a T, not a FIXNUM. ; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &OPTIONAL). ; unable to do inline (unsigned-byte 64) arithmetic (cost 4) because: ; The second argument is a T, not a (UNSIGNED-BYTE 64). ; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES ; (UNSIGNED-BYTE 64) ; &OPTIONAL). ; etc. ; in: DEFUN DISTANCE-ON-TREE ; (AREF WEIGHTS LCA) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; (+ (- (AREF COSTS U) (AREF COSTS LCA)) (- (AREF COSTS V) (AREF COSTS LCA)) ; (AREF WEIGHTS LCA)) ; ; note: forced to do GENERIC-+ (cost 10) ; unable to do inline fixnum arithmetic (cost 2) because: ; The first argument is a (INTEGER -9223372036854775806 9223372036854775806), not a FIXNUM. ; The second argument is a T, not a FIXNUM. ; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &OPTIONAL). ; unable to do inline (unsigned-byte 64) arithm
ソースコード
#-swank(unless (member :child-sbcl *features*)(quit:unix-status(process-exit-code(run-program *runtime-pathname*`("--control-stack-size" "128MB""--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options""--eval" "(push :child-sbcl *features*)""--script" ,(namestring *load-pathname*)):output t :error t :input t))));; -*- 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(declaim (ftype (function * (values fixnum &optional)) read-fixnum))(defun read-fixnum (&optional (in *standard-input*))(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))))))));;;;;; Lowest common ancestor of tree (or forest) by binary lifting;;; build: O(nlog(n));;; query: O(log(n));;;;; PAY ATTENTION TO THE STACK SIZE! THE CONSTRUCTOR DOES DFS.(deftype lca-vertex-number () '(signed-byte 32))(defstruct (lca-table(:constructor %make-lca-table(size&aux;; requires 1 + log_2{size-1}(max-level (+ 1 (integer-length (- size 2))))(depths (make-array size:element-type 'lca-vertex-number:initial-element -1))(costs (make-array size :element-type '(unsigned-byte 62)))(parents (make-array (list size max-level):element-type 'lca-vertex-number))))(:conc-name lca-))(max-level nil :type (integer 0 #.most-positive-fixnum))(depths nil :type (simple-array lca-vertex-number (*)))(costs nil :type (simple-array (unsigned-byte 62) (*)))(parents nil :type (simple-array lca-vertex-number (* *))))(defun make-lca-table (graph weights &key root (key #'identity))"GRAPH := vector of adjacency listsROOT := null | non-negative fixnumIf ROOT is null, this function traverses each connected component of GRAPH froman arbitrarily picked vertex. Otherwise this function traverses GRAPH only fromROOT; GRAPH must be tree in the latter case."(declare (optimize (speed 3))(vector graph weights)(function key)((or null (integer 0 #.most-positive-fixnum)) root))(let* ((size (length graph))(lca-table (%make-lca-table size))(depths (lca-depths lca-table))(costs (lca-costs lca-table))(parents (lca-parents lca-table))(max-level (lca-max-level lca-table)))(labels ((dfs (v prev-v depth cost)(declare (lca-vertex-number v prev-v)(fixnum cost))(setf (aref depths v) depth)(setf (aref parents v 0) prev-v)(setf (aref costs v) cost)(dolist (node (aref graph v))(let ((dest (funcall key node)))(declare (lca-vertex-number dest))(unless (= dest prev-v)(dfs dest v (+ 1 depth) (+ cost (aref weights dest))))))))(if root(dfs root -1 0 (aref weights 0))(dotimes (v size)(when (= (aref depths v) -1)(dfs v -1 0 (aref weights v)))))(dotimes (k (- max-level 1))(dotimes (v size)(if (= -1 (aref parents v k))(setf (aref parents v (+ k 1)) -1)(setf (aref parents v (+ k 1))(aref parents (aref parents v k) k)))))lca-table)))(define-condition two-vertices-disconnected-error (simple-error)((lca-table :initarg :lca-table :accessor two-vertices-disconnected-error-lca-table)(vertex1 :initarg :vertex1 :accessor two-vertices-disconnected-error-vertex1)(vertex2 :initarg :vertex2 :accessor two-vertices-disconnected-error-vertex2))(:report(lambda (c s)(format s "~W and ~W are disconnected on lca-table ~W"(two-vertices-disconnected-error-vertex1 c)(two-vertices-disconnected-error-vertex2 c)(two-vertices-disconnected-error-lca-table c)))))(defun get-lca (vertex1 vertex2 lca-table)"Returns the lowest common ancestor of the vertices VERTEX1 and VERTEX2."(declare (optimize (speed 3))((and lca-vertex-number (integer 0)) vertex1 vertex2))(let* ((u vertex1)(v vertex2)(depths (lca-depths lca-table))(parents (lca-parents lca-table))(max-level (lca-max-level lca-table)))(declare (lca-vertex-number u v));; Ensures depth[u] <= depth[v](when (> (aref depths u) (aref depths v))(rotatef u v))(dotimes (k max-level)(when (logbitp k (- (aref depths v) (aref depths u)))(setf v (aref parents v k))))(if (= u v)u(loop for k from (- max-level 1) downto 0unless (= (aref parents u k) (aref parents v k))do (setq u (aref parents u k)v (aref parents v k))finally (if (= (aref parents u 0) -1)(error 'two-vertices-disconnected-error:lca-table lca-table:vertex1 vertex1:vertex2 vertex2)(return (aref parents u 0)))))))(declaim (inline distance-on-tree))(defun distance-on-tree (u v lca-table weights)"Returns the distance between two vertices U and V."(declare (optimize (speed 3)))(let ((costs (lca-costs lca-table))(lca (get-lca u v lca-table)))(+ (- (aref costs u) (aref costs lca))(- (aref costs v) (aref costs lca))(aref weights lca))))(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 ()(let* ((n (read))(graph (make-array n :element-type 'list :initial-element nil))(us (make-array n :element-type 'uint8)))(dotimes (i (- n 1))(let ((a (read-fixnum))(b (read-fixnum)))(push a (aref graph b))(push b (aref graph a))))(dotimes (i n)(setf (aref us i) (read-fixnum)))(let ((lca-table (make-lca-table graph us))(m (read))(res 0))(dotimes (_ m)(let* ((a (read-fixnum))(b (read-fixnum))(c (read-fixnum))(cost (distance-on-tree a b lca-table us)))(incf res (* cost c))))(println res))))#-swank (main);;;;;; Test and benchmark;;;#+swank(defun io-equal (in-string out-string &key (function #'main) (test #'equal))"Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true ifthe string output to *STANDARD-OUTPUT* is equal to OUT-STRING."(labels ((ensure-last-lf (s)(if (eql (uiop:last-char s) #\Linefeed)s(uiop:strcat s uiop:+lf+))))(funcall test(ensure-last-lf out-string)(with-output-to-string (out)(let ((*standard-output* out))(with-input-from-string (*standard-input* (ensure-last-lf in-string))(funcall function)))))))#+swank(defun get-clipbrd ()(with-output-to-string (out)(run-program "C:/msys64/usr/bin/cat.exe" '("/dev/clipboard") :output out)))#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))#+swank(defun run (&optional thing (out *standard-output*))"THING := null | string | symbol | pathnamenull: run #'MAIN using the text on clipboard as input.string: run #'MAIN using the string as input.symbol: alias of FIVEAM:RUN!.pathname: run #'MAIN using the text file as input."(let ((*standard-output* out))(etypecase thing(null(with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))(main)))(string(with-input-from-string (*standard-input* (delete #\Return thing))(main)))(symbol (5am:run! thing))(pathname(with-open-file (*standard-input* thing)(main))))))#+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)))