Submission #6776804
Source Code Expand
;; -*- 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 (ql:quickload '(:cl-debug-print :fiveam))
#-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil (values) t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy
;; BEGIN_INSERTED_CONTENTS
;;;
;;; Memoization macro
;;;
;;
;; Basic usage:
;; (with-cache (:hash-table :test #'equal :key #'cons)
;; (defun add (a b)
;; (+ a b)))
;; This function caches the returned values for already passed combinations of
;; arguments. In this case ADD stores the key (CONS A B) and the corresponding
;; value to a hash-table when evaluating (ADD A B) for the first time; ADD
;; returns the stored value when it is called with the same arguments
;; (w.r.t. EQUAL) again.
;;
;; The storage for the cache can be hash-table or array. Let's see an example
;; for array:
;; (with-cache (:array (10 20 30) :initial-element -1 :element-type 'fixnum)
;; (defun foo (a b c) ... ))
;; This form caches the value of FOO in the array created by (make-array (list
;; 10 20 30) :initial-element -1 :element-type 'fixnum). Note that
;; INITIAL-ELEMENT must always be given here as it is used as the flag for `not
;; yet stored'. (Therefore INITIAL-ELEMENT should be a value FOO doesn't take.)
;;
;; If you want to ignore some arguments, you can use `*' in dimensions:
;; (with-cache (:array (10 10 * 10) :initial-element -1)
;; (defun foo (a b c d) ...)) ; => C is ignored when querying or storing cache
;;
;; Available definition forms in WITH-CACHE are DEFUN, LABELS, FLET, and
;; SB-INT:NAMED-LET.
;;
;; You can debug the memoized function by :DEBUG option:
;; (with-cache (:array (10 10) :initial-element -1 :debug t)
;; (defun foo (x y) ...))
;; Then FOO is traced as with CL:TRACE.
;;
;; FIXME: *RECURSION-DEPTH* should be included within the macro.
(declaim (type (integer 0 #.most-positive-fixnum) *recursion-depth*))
(defparameter *recursion-depth* 0)
(defmacro with-cache ((cache-type &rest cache-attribs) def-form)
"CACHE-TYPE := :HASH-TABLE | :ARRAY"
(assert (member cache-type '(:hash-table :array)))
(let* ((dimensions-with-* (when (eql cache-type :array) (first cache-attribs)))
(dimensions (remove '* dimensions-with-*))
(rank (length dimensions))
(rest-attribs (ecase cache-type
(:hash-table cache-attribs)
(:array (cdr cache-attribs))))
(key (prog1 (getf rest-attribs :key) (remf rest-attribs :key)))
(debug (prog1 (getf rest-attribs :debug) (remf rest-attribs :debug)))
(cache-form (case cache-type
(:hash-table `(make-hash-table ,@rest-attribs))
(:array `(make-array (list ,@dimensions) ,@rest-attribs))))
(initial-element (when (eql cache-type :array)
(assert (member :initial-element rest-attribs))
(getf rest-attribs :initial-element))))
(let ((cache (gensym "CACHE"))
(value (gensym))
(present-p (gensym))
(name-alias (gensym))
(args-lst (gensym))
(indices (loop repeat rank collect (gensym))))
(labels ((debug (name args obj)
(let ((value (gensym)))
(if debug
`(progn
(format t "~&~A~A: (~A ~{~A~^ ~}) =>"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',name
(list ,@args))
(let ((,value (let ((*recursion-depth* (1+ *recursion-depth*)))
,obj)))
(format t "~&~A~A: (~A ~{~A~^ ~}) => ~A"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',name
(list ,@args)
,value)
,value))
obj)))
(make-cache-check-form (cache-type name args)
(debug name
args
(case cache-type
(:hash-table
`(let ((,args-lst (funcall ,(or key #'list) ,@args)))
(multiple-value-bind (,value ,present-p)
(gethash ,args-lst ,cache)
(if ,present-p
,value
(setf (gethash ,args-lst ,cache)
(,name-alias ,@args))))))
(:array
(let ((memoized-args (loop for dimension in dimensions-with-*
for arg in args
unless (eql dimension '*)
collect arg)))
(if key
`(multiple-value-bind ,indices
(funcall ,key ,@memoized-args)
(let ((,value (aref ,cache ,@indices)))
(if (eql ,initial-element ,value)
(setf (aref ,cache ,@indices)
(,name-alias ,@args))
,value)))
`(let ((,value (aref ,cache ,@memoized-args)))
(if (eql ,initial-element ,value)
(setf (aref ,cache ,@memoized-args)
(,name-alias ,@args))
,value))))))))
(make-reset-form (cache-type)
(case cache-type
(:hash-table `(setf ,cache (make-hash-table ,@rest-attribs)))
(:array `(prog1 nil
(fill (array-storage-vector ,cache) ,initial-element)))))
(make-reset-name (name)
(intern (format nil "RESET-~A" (symbol-name name))))
(extract-declarations (body)
(remove-if-not (lambda (form) (eql 'declare (car form))) body)))
(ecase (car def-form)
((defun)
(destructuring-bind (_ name args &body body) def-form
(declare (ignore _))
`(let ((,cache ,cache-form))
(defun ,(make-reset-name name) () ,(make-reset-form cache-type))
(defun ,name ,args
,@(extract-declarations body)
(labels ((,name-alias ,args ,@body))
(declare (inline ,name-alias))
,(make-cache-check-form cache-type name args))))))
((nlet #+sbcl sb-int:named-let)
(destructuring-bind (_ name bindings &body body) def-form
(declare (ignore _))
`(let ((,cache ,cache-form))
(,(car def-form) ,name ,bindings
,@(extract-declarations body)
,(let ((args (mapcar (lambda (x) (if (atom x) x (car x))) bindings)))
`(labels ((,name-alias ,args ,@body))
(declare (inline ,name-alias))
,(make-cache-check-form cache-type name args)))))))
((labels flet)
(destructuring-bind (_ definitions &body labels-body) def-form
(declare (ignore _))
(destructuring-bind (name args &body body) (car definitions)
`(let ((,cache ,cache-form))
(,(car def-form)
((,(make-reset-name name) () ,(make-reset-form cache-type))
(,name ,args
,@(extract-declarations body)
(labels ((,name-alias ,args ,@body))
(declare (inline ,name-alias))
,(make-cache-check-form cache-type name args)))
,@(cdr definitions))
(declare (ignorable #',(make-reset-name name)))
,@labels-body))))))))))
(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))))))))
(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
(define-modify-macro minf (new-value)
(lambda (x y) (min x y)))
(defconstant +inf+ #x7fffffff)
(defun main ()
(declare #.OPT)
(let* ((n (read))
(graph (make-array n :element-type 'list :initial-element nil))
(xs (make-array n :element-type 'uint32)))
(declare ((simple-array list (*)) graph))
(loop for i from 1 below n
do (push i (aref graph (- (read-fixnum) 1))))
(dotimes (i n)
(setf (aref xs i) (read-fixnum)))
(with-cache (:array (1001) :element-type 'int32 :initial-element -1)
(labels ((dfs (v)
(declare (values uint32))
(let ((k (length (aref graph v))) ; the number of children
(adjs (coerce (aref graph v) '(simple-array uint32 (*)))))
(declare (uint32 k))
(with-cache (:array ((+ k 1) 5001) :element-type 'int32 :initial-element -1)
(sb-int:named-let recur ((y k) (z (aref xs v)))
(if (zerop y)
0
(let ((vertex (aref adjs (- y 1)))
(res +inf+))
(declare (uint32 res))
(when (<= (aref xs vertex) z)
(minf res (+ (recur (- y 1) (- z (aref xs vertex)))
(dfs vertex))))
(when (<= (dfs vertex) z)
(minf res (+ (recur (- y 1) (- z (dfs vertex)))
(aref xs vertex))))
res)))))))
(write-line (if (= +inf+ (dfs 0))
"IMPOSSIBLE"
"POSSIBLE"))))))
#-swank (main)
Submission Info
| Submission Time |
|
| Task |
E - Bichrome Tree |
| User |
sansaqua |
| Language |
Common Lisp (SBCL 1.1.14) |
| Score |
700 |
| Code Size |
12738 Byte |
| Status |
AC |
| Exec Time |
303 ms |
| Memory |
84964 KiB |
Judge Result
| Set Name |
Sample |
All |
| Score / Max Score |
0 / 0 |
700 / 700 |
| Status |
|
|
| Set Name |
Test Cases |
| Sample |
subtask0_0.txt, subtask0_1.txt, subtask0_2.txt, subtask0_3.txt |
| All |
01.txt, 02.txt, 03.txt, 04.txt, 05.txt, 06.txt, 07.txt, 08.txt, 09.txt, 10.txt, 11.txt, 12.txt, 13.txt, 14.txt, 15.txt, 16.txt, 17.txt, 18.txt, 19.txt, 20.txt, 21.txt, 22.txt, 23.txt, 24.txt, 25.txt, 26.txt, 27.txt, 28.txt, 29.txt, 30.txt, 31.txt, 32.txt, 33.txt, 34.txt, 35.txt, 36.txt, 37.txt, 38.txt, 39.txt, 40.txt, subtask0_0.txt, subtask0_1.txt, subtask0_2.txt, subtask0_3.txt |
| Case Name |
Status |
Exec Time |
Memory |
| 01.txt |
AC |
303 ms |
84964 KiB |
| 02.txt |
AC |
107 ms |
29160 KiB |
| 03.txt |
AC |
104 ms |
23012 KiB |
| 04.txt |
AC |
131 ms |
72292 KiB |
| 05.txt |
AC |
132 ms |
72292 KiB |
| 06.txt |
AC |
134 ms |
74340 KiB |
| 07.txt |
AC |
117 ms |
59880 KiB |
| 08.txt |
AC |
135 ms |
72296 KiB |
| 09.txt |
AC |
118 ms |
59872 KiB |
| 10.txt |
AC |
104 ms |
23012 KiB |
| 11.txt |
AC |
108 ms |
33256 KiB |
| 12.txt |
AC |
114 ms |
47584 KiB |
| 13.txt |
AC |
132 ms |
74344 KiB |
| 14.txt |
AC |
131 ms |
72292 KiB |
| 15.txt |
AC |
132 ms |
74336 KiB |
| 16.txt |
AC |
132 ms |
70244 KiB |
| 17.txt |
AC |
131 ms |
74340 KiB |
| 18.txt |
AC |
132 ms |
74336 KiB |
| 19.txt |
AC |
133 ms |
72292 KiB |
| 20.txt |
AC |
132 ms |
72288 KiB |
| 21.txt |
AC |
105 ms |
27112 KiB |
| 22.txt |
AC |
104 ms |
23008 KiB |
| 23.txt |
AC |
115 ms |
53732 KiB |
| 24.txt |
AC |
113 ms |
45540 KiB |
| 25.txt |
AC |
116 ms |
57828 KiB |
| 26.txt |
AC |
132 ms |
74340 KiB |
| 27.txt |
AC |
132 ms |
74340 KiB |
| 28.txt |
AC |
132 ms |
74344 KiB |
| 29.txt |
AC |
132 ms |
74340 KiB |
| 30.txt |
AC |
132 ms |
74344 KiB |
| 31.txt |
AC |
132 ms |
74340 KiB |
| 32.txt |
AC |
132 ms |
74212 KiB |
| 33.txt |
AC |
131 ms |
74336 KiB |
| 34.txt |
AC |
131 ms |
74340 KiB |
| 35.txt |
AC |
131 ms |
76388 KiB |
| 36.txt |
AC |
131 ms |
74340 KiB |
| 37.txt |
AC |
131 ms |
74340 KiB |
| 38.txt |
AC |
132 ms |
76392 KiB |
| 39.txt |
AC |
132 ms |
76384 KiB |
| 40.txt |
AC |
132 ms |
74340 KiB |
| subtask0_0.txt |
AC |
105 ms |
23012 KiB |
| subtask0_1.txt |
AC |
106 ms |
23008 KiB |
| subtask0_2.txt |
AC |
105 ms |
23008 KiB |
| subtask0_3.txt |
AC |
104 ms |
23008 KiB |