結果
問題 | No.898 tri-βutree |
ユーザー |
|
提出日時 | 2019-10-04 23:08:17 |
言語 | Common Lisp (sbcl 2.5.0) |
結果 |
AC
|
実行時間 | 500 ms / 4,000 ms |
コード長 | 11,295 bytes |
コンパイル時間 | 1,183 ms |
コンパイル使用メモリ | 44,032 KB |
実行使用メモリ | 51,456 KB |
最終ジャッジ日時 | 2024-11-08 22:22:13 |
合計ジャッジ時間 | 11,025 ms |
ジャッジサーバーID (参考情報) |
judge1 / judge4 |
外部呼び出し有り |
(要ログイン)
ファイルパターン | 結果 |
---|---|
sample | AC * 1 |
other | AC * 21 |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 08 NOV 2024 10:22:00 PM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN BUILD-LCA-TABLE ; (AREF GRAPH V) ; ; note: unable to ; optimize ; because: ; Upgraded element type of array is not known at compile time. ; ; compilation unit finished ; printed 1 note ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.109
ソースコード
#-swank(unless (member :child-sbcl *features*)(quit:unix-status(process-exit-code(run-program *runtime-pathname*`("--control-stack-size" "256MB""--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(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 (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))))))));;;;;; Lowest common ancestor of tree by binary lifting;;; build: O(nlog(n));;; query: O(log(n));;;;; PAY ATTENTION TO THE STACK SIZE! BUILD-LCA-TABLE 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))(parents (make-array (list size max-level):element-type 'lca-vertex-number))(weights (make-array size :element-type '(unsigned-byte 62):initial-element 0))))(:conc-name lca-))(max-level nil :type (integer 0 #.most-positive-fixnum))(depths nil :type (simple-array lca-vertex-number (*)))(parents nil :type (simple-array lca-vertex-number (* *)))(weights nil :type (simple-array (unsigned-byte 62) (*))))(defun build-lca-table (root graph)"GRAPH := vector of adjacency lists"(declare (optimize (speed 3))(vector graph))(let* ((size (length graph))(lca-table (make-lca-table size))(depths (lca-depths lca-table))(weights (lca-weights lca-table))(parents (lca-parents lca-table))(max-level (lca-max-level lca-table)))(labels ((dfs (v prev-v depth weight)(declare (lca-vertex-number v prev-v)(uint62 weight))(setf (aref depths v) depth)(setf (aref weights v) weight)(setf (aref parents v 0) prev-v)(dolist (node (aref graph v))(let ((dest (car node))(dweight (cdr node)))(declare (lca-vertex-number dest)(uint62 dweight))(unless (= dest prev-v)(dfs dest v (+ 1 depth) (+ weight dweight)))))))(dfs root -1 0 0)(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)))(defun get-lca (u v lca-table)"Returns the lowest common ancestor of the vertices U and V."(declare (optimize (speed 3))(lca-vertex-number u v))(let* ((depths (lca-depths lca-table))(parents (lca-parents lca-table))(max-level (lca-max-level lca-table)));; 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 (setf u (aref parents u k)v (aref parents v k))finally (return (aref parents u 0))))))(declaim (inline distance-on-tree))(defun distance-on-tree (u v lca-table)"Returns the distance of U and V."(declare (optimize (speed 3)))(let ((weights (lca-depths lca-table))(lca (get-lca u v lca-table)))(+ (- (aref weights u) (aref weights lca))(- (aref weights v) (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)))(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));; to . weight(graph (make-array n :element-type 'list :initial-element nil)))(dotimes (i (- n 1))(let ((u (read-fixnum))(v (read-fixnum))(w (read-fixnum)))(push (cons u w) (aref graph v))(push (cons v w) (aref graph u))))(let* ((table (build-lca-table 0 graph))(depths (lca-depths table))(q (read)))(labels ((calc-dist (u v)(let ((weights (lca-weights table))(lca (get-lca u v table)))(- (+ (aref weights u)(aref weights v))(* 2 (aref weights lca))))))(dotimes (_ q)(println(let* ((x (read-fixnum))(y (read-fixnum))(z (read-fixnum))(lca-xy (get-lca x y table))(lca-yz (get-lca y z table))(lca-zx (get-lca z x table)))(labels ((frob (x y z)(let ((lca-xy (get-lca x y table))(lca-yz (get-lca y z table))(lca-zx (get-lca z x table))(shallow (min (aref depths lca-xy)(aref depths lca-yz)(aref depths lca-zx)))(deep (max (aref depths lca-xy)(aref depths lca-yz)(aref depths lca-zx))))(if (/= shallow (aref depths lca-xy))(frob y z x)(cond ((= deep (aref depths lca-yz));; yzのlcaが深い(+ (calc-dist x y)(calc-dist z lca-yz)))((= deep (aref depths lca-zx));; zxのlcaが深い(+ (calc-dist x y)(calc-dist z lca-zx)))(t (error "Huh?")))))))(frob x y z)))))))))#-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)))#+swank(5am:test :sample(5am:is (io-equal "50 1 51 2 402 3 73 4 160 1 20 2 11 2 01 0 22 0 12 1 0""454545454545"))(5am:is (io-equal "80 1 70 6 81 2 11 3 1003 4 23 7 47 5 11362 3 00 2 32 0 33 0 20 3 23 2 06 3 46 4 33 4 63 6 44 6 34 3 62 7 42 4 74 7 24 2 77 2 47 4 22 6 72 7 66 2 76 7 27 2 67 6 23 4 73 7 44 3 74 7 37 3 47 4 36 4 76 7 44 6 74 7 67 6 47 4 6""108108108108108108117117117117117117107107107107107107120120120120120120666666121121121121121121"))(5am:is (io-equal "60 5 80 1 71 4 1001 2 11 3 262 3 42 4 33 2 43 4 24 2 34 3 2""103103103103103103")))