Submission #7450936
Source Code Expand
;; -*- 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
;;;
;;; Binomial coefficient in double float
;;; build: O(n)
;;;
(defconstant +binom-size+ 170)
(declaim ((simple-array double-float (*)) *fact*))
(defparameter *fact* (make-array +binom-size+ :element-type 'double-float)
"table of factorials")
(defun initialize-binom ()
(declare (optimize (speed 3) (safety 0)))
(setf (aref *fact* 0) 1d0
(aref *fact* 1) 1d0)
(loop for i from 2 below +binom-size+
do (setf (aref *fact* i) (* (float i 1d0) (aref *fact* (- i 1))))))
(initialize-binom)
(declaim (inline binom))
(defun binom (n k)
"Returns nCk."
(if (or (< n k) (< n 0) (< k 0))
0d0
(/ (aref *fact* n)
(* (aref *fact* k) (aref *fact* (- n k))))))
(declaim (inline perm))
(defun perm (n k)
"Returns nPk."
(if (or (< n k) (< n 0) (< k 0))
0d0
(/ (aref *fact* n) (aref *fact* (- n k)))))
(declaim (inline multinomial))
(defun multinomial (&rest ks)
"Returns the multinomial coefficient K!/k_1!k_2!...k_n! for K = k_1 + k_2 +
... + k_n. (multinomial) returns 1d0."
(let ((sum 0)
(result 1d0))
(declare ((integer 0 #.most-positive-fixnum) sum)
(double-float result))
(dolist (k ks)
(declare ((integer 0 #.most-positive-fixnum) k))
(incf sum k)
(setq result (* result (aref *fact* k))))
(/ (aref *fact* sum) result)))
;;;
;;; 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 return 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 is 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 stores 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 never takes.)
;;
;; If you want to ignore some arguments, you can put `*' in dimensions:
;; (with-cache (:array (10 10 * 10) :initial-element -1)
;; (defun foo (a b c d) ...)) ; then 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 trace the memoized function by :TRACE option:
;; (with-cache (:array (10 10) :initial-element -1 :trace t)
;; (defun foo (x y) ...))
;; Then FOO is traced as with CL:TRACE.
;;
;; TODO & NOTE: Currently a memoized function is not enclosed with a block of
;; the function name.
;; FIXME: *RECURSION-DEPTH* should be included within the macro.
(declaim (type (integer 0 #.most-positive-fixnum) *recursion-depth*))
(defparameter *recursion-depth* 0)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun %enclose-with-trace (fname args form)
(let ((value (gensym)))
`(progn
(format t "~&~A~A: (~A ~{~A~^ ~}) =>"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',fname
(list ,@args))
(let ((,value (let ((*recursion-depth* (1+ *recursion-depth*)))
,form)))
(format t "~&~A~A: (~A ~{~A~^ ~}) => ~A"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',fname
(list ,@args)
,value)
,value))))
(defun %extract-declarations (body)
(remove-if-not (lambda (form) (and (consp form) (eql 'declare (car form))))
body))
(defun %parse-cache-form (cache-specifier)
(let ((cache-type (car cache-specifier))
(cache-attribs (cdr cache-specifier)))
(assert (member cache-type '(:hash-table :array)))
(let* ((dims-with-* (when (eql cache-type :array) (first cache-attribs)))
(dims (remove '* dims-with-*))
(rank (length dims))
(rest-attribs (ecase cache-type
(:hash-table cache-attribs)
(:array (cdr cache-attribs))))
(key (prog1 (getf rest-attribs :key) (remf rest-attribs :key)))
(trace-p (prog1 (getf rest-attribs :trace) (remf rest-attribs :trace)))
(cache-form (case cache-type
(:hash-table `(make-hash-table ,@rest-attribs))
(:array `(make-array (list ,@dims) ,@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
((make-cache-querier (cache-type name args)
(let ((res (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 dims-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))))))))
(if trace-p
(%enclose-with-trace name args res)
res)))
(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)))))
(values cache cache-form cache-type name-alias
#'make-reset-name
#'make-reset-form
#'make-cache-querier)))))))
(defmacro with-cache ((cache-type &rest cache-attribs) def-form)
"CACHE-TYPE := :HASH-TABLE | :ARRAY.
DEF-FORM := definition form with DEFUN, LABELS, FLET, or SB-INT:NAMED-LET."
(multiple-value-bind (cache-symbol cache-form cache-type name-alias
make-reset-name make-reset-form
make-cache-querier)
(%parse-cache-form (cons cache-type cache-attribs))
(ecase (car def-form)
((defun)
(destructuring-bind (_ name args &body body) def-form
(declare (ignore _))
`(let ((,cache-symbol ,cache-form))
(defun ,(funcall make-reset-name name) ()
,(funcall make-reset-form cache-type))
(defun ,name ,args
,@(%extract-declarations body)
(labels ((,name-alias ,args ,@body))
(declare (inline ,name-alias))
,(funcall make-cache-querier 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-symbol ,cache-form))
(,(car def-form)
((,(funcall make-reset-name name) ()
,(funcall make-reset-form cache-type))
(,name ,args
,@(%extract-declarations body)
(labels ((,name-alias ,args ,@body))
(declare (inline ,name-alias))
,(funcall make-cache-querier cache-type name args)))
,@(cdr definitions))
(declare (ignorable #',(funcall make-reset-name name)))
,@labels-body)))))
((nlet #+sbcl sb-int:named-let)
(destructuring-bind (_ name bindings &body body) def-form
(declare (ignore _))
`(let ((,cache-symbol ,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))
,(funcall make-cache-querier cache-type name args))))))))))
(defmacro with-caches (cache-specs def-form)
"DEF-FORM := definition form by LABELS or FLET.
(with-caches (cache-spec1 cache-spec2)
(labels ((f (x) ...) (g (y) ...))))
is equivalent to the line up of
(with-cache cache-spec1 (labels ((f (x) ...))))
and
(with-cache cache-spec2 (labels ((g (y) ...))))
This macro will be useful to do mutual recursion between memoized local
functions."
(assert (member (car def-form) '(labels flet)))
(let (cache-symbol-list cache-form-list cache-type-list name-alias-list make-reset-name-list make-reset-form-list make-cache-querier-list)
(dolist (cache-spec (reverse cache-specs))
(multiple-value-bind (cache-symbol cache-form cache-type name-alias
make-reset-name make-reset-form make-cache-querier)
(%parse-cache-form cache-spec)
(push cache-symbol cache-symbol-list)
(push cache-form cache-form-list)
(push cache-type cache-type-list)
(push name-alias name-alias-list)
(push make-reset-name make-reset-name-list)
(push make-reset-form make-reset-form-list)
(push make-cache-querier make-cache-querier-list)))
(labels ((def-name (def) (first def))
(def-args (def) (second def))
(def-body (def) (cddr def)))
(destructuring-bind (_ definitions &body labels-body) def-form
(declare (ignore _))
`(let ,(loop for cache-symbol in cache-symbol-list
for cache-form in cache-form-list
collect `(,cache-symbol ,cache-form))
(,(car def-form)
(,@(loop for def in definitions
for cache-type in cache-type-list
for make-reset-name in make-reset-name-list
for make-reset-form in make-reset-form-list
collect `(,(funcall make-reset-name (def-name def)) ()
,(funcall make-reset-form cache-type)))
,@(loop for def in definitions
for cache-type in cache-type-list
for name-alias in name-alias-list
for make-cache-querier in make-cache-querier-list
collect `(,(def-name def) ,(def-args def)
,@(%extract-declarations (def-body def))
(labels ((,name-alias ,(def-args def) ,@(def-body def)))
(declare (inline ,name-alias))
,(funcall make-cache-querier cache-type (def-name def) (def-args def))))))
(declare (ignorable ,@(loop for def in definitions
for make-reset-name in make-reset-name-list
collect `#',(funcall make-reset-name
(def-name def)))))
,@labels-body))))))
(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)))
(labels ((calc-next (x y z)
(cond ((or (= 0 x y) (= 0 y z) (= 0 z x))
(+ x y z))
((= 0 x) (min y z))
((= 0 y) (min z x))
((= 0 z) (min x y))
((= x y z) (+ x y z))
(t (min x y z)))))
(with-cache (:array (101) :element-type 'double-float :initial-element -1d0)
(labels ((recur (u)
(if (= u 1)
0d0
(let ((lfactor 1d0)
(rhs 0d0))
(declare (double-float lfactor rhs))
(dotimes (x (+ u 1))
(loop for y from 0 to (- u x)
for z = (- u x y)
do (let ((next (calc-next x y z)))
(if (= next u)
(decf lfactor (/ (multinomial x y z)
(expt 3d0 u)))
(incf rhs (* (/ (multinomial x y z)
(expt 3d0 u))
(recur next)))))))
(/ (+ 1d0 rhs) lfactor)))))
(println (recur n)))))))
#-swank (main)
Submission Info
Submission Time |
|
Task |
C - ゲーマーじゃんけん |
User |
sansaqua |
Language |
Common Lisp (SBCL 1.1.14) |
Score |
100 |
Code Size |
16348 Byte |
Status |
AC |
Exec Time |
289 ms |
Memory |
37860 KB |
Judge Result
Set Name |
All |
Score / Max Score |
100 / 100 |
Status |
|
Set Name |
Test Cases |
All |
input-002.txt, input-003.txt, input-004.txt, input-005.txt, input-006.txt, input-007.txt, input-008.txt, input-009.txt, input-010.txt, input-011.txt, input-012.txt, input-013.txt, input-014.txt, input-015.txt, input-016.txt, input-017.txt, input-018.txt, input-019.txt, input-020.txt, input-021.txt, input-022.txt, input-023.txt, input-024.txt, input-025.txt, input-026.txt, input-027.txt, input-028.txt, input-029.txt, input-030.txt, input-031.txt, input-032.txt, input-033.txt, input-034.txt, input-035.txt, input-036.txt, input-037.txt, input-038.txt, input-039.txt, input-040.txt, input-041.txt, input-042.txt, input-043.txt, input-044.txt, input-045.txt, input-046.txt, input-047.txt, input-048.txt, input-049.txt, input-050.txt, input-051.txt, input-052.txt, input-053.txt, input-054.txt, input-055.txt, input-056.txt, input-057.txt, input-058.txt, input-059.txt, input-060.txt, input-061.txt, input-062.txt, input-063.txt, input-064.txt, input-065.txt, input-066.txt, input-067.txt, input-068.txt, input-069.txt, input-070.txt, input-071.txt, input-072.txt, input-073.txt, input-074.txt, input-075.txt, input-076.txt, input-077.txt, input-078.txt, input-079.txt, input-080.txt, input-081.txt, input-082.txt, input-083.txt, input-084.txt, input-085.txt, input-086.txt, input-087.txt, input-088.txt, input-089.txt, input-090.txt, input-091.txt, input-092.txt, input-093.txt, input-094.txt, input-095.txt, input-096.txt, input-097.txt, input-098.txt, input-099.txt, input-100.txt |
Case Name |
Status |
Exec Time |
Memory |
input-002.txt |
AC |
289 ms |
37860 KB |
input-003.txt |
AC |
117 ms |
25060 KB |
input-004.txt |
AC |
120 ms |
25056 KB |
input-005.txt |
AC |
116 ms |
25060 KB |
input-006.txt |
AC |
116 ms |
25056 KB |
input-007.txt |
AC |
119 ms |
25060 KB |
input-008.txt |
AC |
118 ms |
25064 KB |
input-009.txt |
AC |
117 ms |
25060 KB |
input-010.txt |
AC |
115 ms |
25060 KB |
input-011.txt |
AC |
116 ms |
25060 KB |
input-012.txt |
AC |
115 ms |
25060 KB |
input-013.txt |
AC |
116 ms |
25064 KB |
input-014.txt |
AC |
115 ms |
25060 KB |
input-015.txt |
AC |
115 ms |
25060 KB |
input-016.txt |
AC |
116 ms |
25064 KB |
input-017.txt |
AC |
117 ms |
25060 KB |
input-018.txt |
AC |
118 ms |
25056 KB |
input-019.txt |
AC |
117 ms |
25056 KB |
input-020.txt |
AC |
119 ms |
25060 KB |
input-021.txt |
AC |
120 ms |
25064 KB |
input-022.txt |
AC |
120 ms |
25064 KB |
input-023.txt |
AC |
115 ms |
25060 KB |
input-024.txt |
AC |
116 ms |
25060 KB |
input-025.txt |
AC |
114 ms |
25064 KB |
input-026.txt |
AC |
114 ms |
25060 KB |
input-027.txt |
AC |
116 ms |
25060 KB |
input-028.txt |
AC |
116 ms |
25060 KB |
input-029.txt |
AC |
115 ms |
25064 KB |
input-030.txt |
AC |
115 ms |
25060 KB |
input-031.txt |
AC |
115 ms |
25060 KB |
input-032.txt |
AC |
115 ms |
25056 KB |
input-033.txt |
AC |
115 ms |
25060 KB |
input-034.txt |
AC |
118 ms |
25320 KB |
input-035.txt |
AC |
115 ms |
25056 KB |
input-036.txt |
AC |
115 ms |
25060 KB |
input-037.txt |
AC |
115 ms |
25060 KB |
input-038.txt |
AC |
115 ms |
25060 KB |
input-039.txt |
AC |
115 ms |
25056 KB |
input-040.txt |
AC |
116 ms |
25060 KB |
input-041.txt |
AC |
115 ms |
25064 KB |
input-042.txt |
AC |
116 ms |
25060 KB |
input-043.txt |
AC |
116 ms |
25060 KB |
input-044.txt |
AC |
116 ms |
25060 KB |
input-045.txt |
AC |
116 ms |
25060 KB |
input-046.txt |
AC |
116 ms |
25064 KB |
input-047.txt |
AC |
116 ms |
25060 KB |
input-048.txt |
AC |
117 ms |
25060 KB |
input-049.txt |
AC |
116 ms |
25060 KB |
input-050.txt |
AC |
116 ms |
25056 KB |
input-051.txt |
AC |
115 ms |
25060 KB |
input-052.txt |
AC |
116 ms |
25064 KB |
input-053.txt |
AC |
117 ms |
25060 KB |
input-054.txt |
AC |
116 ms |
25056 KB |
input-055.txt |
AC |
117 ms |
25060 KB |
input-056.txt |
AC |
116 ms |
25060 KB |
input-057.txt |
AC |
115 ms |
25060 KB |
input-058.txt |
AC |
116 ms |
25064 KB |
input-059.txt |
AC |
116 ms |
25064 KB |
input-060.txt |
AC |
117 ms |
25056 KB |
input-061.txt |
AC |
116 ms |
25060 KB |
input-062.txt |
AC |
118 ms |
25064 KB |
input-063.txt |
AC |
118 ms |
25060 KB |
input-064.txt |
AC |
117 ms |
25056 KB |
input-065.txt |
AC |
115 ms |
25060 KB |
input-066.txt |
AC |
116 ms |
25056 KB |
input-067.txt |
AC |
117 ms |
25060 KB |
input-068.txt |
AC |
118 ms |
25060 KB |
input-069.txt |
AC |
119 ms |
25056 KB |
input-070.txt |
AC |
119 ms |
25064 KB |
input-071.txt |
AC |
120 ms |
25064 KB |
input-072.txt |
AC |
117 ms |
25060 KB |
input-073.txt |
AC |
118 ms |
25060 KB |
input-074.txt |
AC |
118 ms |
25064 KB |
input-075.txt |
AC |
116 ms |
25060 KB |
input-076.txt |
AC |
117 ms |
25060 KB |
input-077.txt |
AC |
117 ms |
25056 KB |
input-078.txt |
AC |
117 ms |
25060 KB |
input-079.txt |
AC |
119 ms |
25060 KB |
input-080.txt |
AC |
118 ms |
25064 KB |
input-081.txt |
AC |
117 ms |
25064 KB |
input-082.txt |
AC |
118 ms |
25056 KB |
input-083.txt |
AC |
118 ms |
25060 KB |
input-084.txt |
AC |
118 ms |
25056 KB |
input-085.txt |
AC |
117 ms |
25056 KB |
input-086.txt |
AC |
118 ms |
25056 KB |
input-087.txt |
AC |
118 ms |
25060 KB |
input-088.txt |
AC |
118 ms |
25056 KB |
input-089.txt |
AC |
118 ms |
25056 KB |
input-090.txt |
AC |
118 ms |
25056 KB |
input-091.txt |
AC |
118 ms |
25064 KB |
input-092.txt |
AC |
119 ms |
25056 KB |
input-093.txt |
AC |
118 ms |
25064 KB |
input-094.txt |
AC |
118 ms |
25064 KB |
input-095.txt |
AC |
119 ms |
25056 KB |
input-096.txt |
AC |
119 ms |
25060 KB |
input-097.txt |
AC |
118 ms |
25060 KB |
input-098.txt |
AC |
118 ms |
25064 KB |
input-099.txt |
AC |
118 ms |
25064 KB |
input-100.txt |
AC |
119 ms |
25056 KB |