Submission #4791272


Source Code Expand

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0)))
  #+swank (progn (ql:quickload '(:cl-debug-print :fiveam))
                 (shadow :run)
                 (use-package :fiveam)))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

;; BEGIN_INSERTED_CONTENTS

;; (with-memoizing (:hash-table :test #'equal :key #'cons)
;;   (defun ...))
;; (with-memoizing (:array (10 10 * 10) :initial-element -1 :element-type 'fixnum)
;;   (defun ...))
(defmacro with-memoizing (cache-attribs def-form)
  (let* ((cache-attribs (if (atom cache-attribs) (list cache-attribs) cache-attribs))
         (cache-type (first cache-attribs))
         (dimensions-with-* (when (eql cache-type :array) (second cache-attribs)))
         (dimensions (remove '* dimensions-with-*))
         (rank (length dimensions))
         (rest-attribs (ecase cache-type
                         (:hash-table (cdr cache-attribs))
                         (:array (cddr cache-attribs))))
         (key (prog1 (getf rest-attribs :key) (remf rest-attribs :key)))
         (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))
          (value (gensym))
	  (present-p (gensym))
          (name-alias (gensym))
	  (args-lst (gensym))
          (indices (loop repeat rank collect (gensym))))
      (labels ((make-cache-check-form (cache-type 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 args))))))
          ((nlet)
           (destructuring-bind (_ name bindings &body body) def-form
             (declare (ignore _))
             `(let ((,cache ,cache-form))
                (nlet ,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 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 args)))
                    ,@(cdr definitions))
                   (declare (ignorable #',(make-reset-name name)))
                   ,@labels-body))))))))))

(defmacro nlet (name args &body body)
  (labels ((ensure-list (x) (if (listp x) x (list x))))
    (let ((args (mapcar #'ensure-list args)))
      `(labels ((,name ,(mapcar #'car args) ,@body))
         (,name ,@(mapcar #'cadr args))))))

(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)

(defmacro println (obj &optional (stream '*standard-output*))
  `(let ((*read-default-float-format* 'double-float))
     (prog1 (princ ,obj ,stream) (terpri ,stream))))

(defconstant +mod+ 1000000007)

;; Body

;; Let f(x, y, z) be the number of the prohibited numbers whose most significant digit is y at the position x and the possible digits are limited (z = 1) or not limited (z = 0).
;; f(x, y, 0) = f(x-1, 0, 0) + ... + f(x-1, 9, 0) if (y = 0, 1, 2, 3, 5, 6, 7, 8)
;;              10^x if (y = 4, 9)
;; f(x, y, 1) = f(x-1, 0, 0) + ... + f(x-1, k-1, 0) + f(x-1, k, 1) where k is the given digit.
;;            = ((given number) mod 10^x)+1 (if y = 4, 9)
;; f(0, y, 0) = 0 (y = 0, 1, 2, 3, 5, 6, 7, 8)
;;            = 1 (y = 4, 9)
;; f(0, y, 1) = 0 (y in {0, 1, 2, 3, 5, 6, 7, 8} and y <= k)
;;            = 1 (y in {4, 9} or y > k)

(defun count-prohibited (max)
  (let ((digits (make-array 20 :element-type 'uint4 :initial-element 0)))
    (loop for i from 0 below 20
          for num = max then (floor num 10)
          do (setf (aref digits i) (mod num 10)))
    (with-memoizing (:array (21 10 2)
                     :element-type 'fixnum
                     :initial-element -1)
      (nlet recur ((x 20) (y 0) (z 1))
        (declare #.OPT
                 ((integer 0 20) x)
                 ((integer 0 9) y)
                 (bit z))
        (if (zerop x)
            (if (and (or (= y 4) (= y 9))
                     (not (and (= z 1) (> y (aref digits 0)))))
                1
                0)
            (if (zerop z)
                (if (or (= y 4) (= y 9))
                    (expt 10 x)
                    (loop for d to 9
                          sum (recur (- x 1) d 0) of-type uint62))
                (if (or (= y 4) (= y 9))
                    (+ 1 (mod max (expt 10 x)))
                    (loop for d below (aref digits (- x 1))
                          sum (recur (- x 1) d 0) into res of-type uint62
                          finally (return (+ res (recur (- x 1) (aref digits (- x 1)) 1)))))))))))
(defun main ()
  (let* ((a (read))
         (b (read)))
    (println (- (count-prohibited b)
                (count-prohibited (- a 1))))))

#-swank(main)

Submission Info

Submission Time
Task D - 禁止された数字
User sansaqua
Language Common Lisp (SBCL 1.1.14)
Score 100
Code Size 8876 Byte
Status AC
Exec Time 252 ms
Memory 28900 KB

Judge Result

Set Name Sample Subtask1 Subtask2
Score / Max Score 0 / 0 30 / 30 70 / 70
Status
AC × 4
AC × 16
AC × 39
Set Name Test Cases
Sample subtask0_sample01.txt, subtask0_sample02.txt, subtask0_sample03.txt, subtask0_sample04.txt
Subtask1 subtask1_01.txt, subtask1_02.txt, subtask1_03.txt, subtask1_04.txt, subtask1_05.txt, subtask1_06.txt, subtask1_07.txt, subtask1_08.txt, subtask1_09.txt, subtask1_10.txt, subtask1_11.txt, subtask1_12.txt, subtask1_13.txt, subtask0_sample01.txt, subtask0_sample02.txt, subtask0_sample03.txt
Subtask2 subtask0_sample01.txt, subtask0_sample02.txt, subtask0_sample03.txt, subtask0_sample04.txt, subtask1_01.txt, subtask1_02.txt, subtask1_03.txt, subtask1_04.txt, subtask1_05.txt, subtask1_06.txt, subtask1_07.txt, subtask1_08.txt, subtask1_09.txt, subtask1_10.txt, subtask1_11.txt, subtask1_12.txt, subtask1_13.txt, subtask2_01.txt, subtask2_02.txt, subtask2_03.txt, subtask2_04.txt, subtask2_05.txt, subtask2_06.txt, subtask2_07.txt, subtask2_08.txt, subtask2_09.txt, subtask2_10.txt, subtask2_11.txt, subtask2_12.txt, subtask2_13.txt, subtask2_14.txt, subtask2_15.txt, subtask2_16.txt, subtask2_17.txt, subtask2_18.txt, subtask2_19.txt, subtask2_20.txt, subtask2_21.txt, subtask2_22.txt
Case Name Status Exec Time Memory
subtask0_sample01.txt AC 252 ms 28900 KB
subtask0_sample02.txt AC 77 ms 16868 KB
subtask0_sample03.txt AC 76 ms 16868 KB
subtask0_sample04.txt AC 76 ms 16868 KB
subtask1_01.txt AC 76 ms 16868 KB
subtask1_02.txt AC 76 ms 16864 KB
subtask1_03.txt AC 76 ms 16868 KB
subtask1_04.txt AC 76 ms 16872 KB
subtask1_05.txt AC 76 ms 16868 KB
subtask1_06.txt AC 76 ms 16864 KB
subtask1_07.txt AC 76 ms 16868 KB
subtask1_08.txt AC 76 ms 16868 KB
subtask1_09.txt AC 76 ms 16868 KB
subtask1_10.txt AC 76 ms 16872 KB
subtask1_11.txt AC 77 ms 16864 KB
subtask1_12.txt AC 76 ms 16864 KB
subtask1_13.txt AC 76 ms 16868 KB
subtask2_01.txt AC 76 ms 16868 KB
subtask2_02.txt AC 76 ms 16872 KB
subtask2_03.txt AC 76 ms 16872 KB
subtask2_04.txt AC 76 ms 16864 KB
subtask2_05.txt AC 77 ms 16868 KB
subtask2_06.txt AC 76 ms 16868 KB
subtask2_07.txt AC 77 ms 16872 KB
subtask2_08.txt AC 77 ms 16864 KB
subtask2_09.txt AC 76 ms 16872 KB
subtask2_10.txt AC 78 ms 16864 KB
subtask2_11.txt AC 76 ms 16868 KB
subtask2_12.txt AC 76 ms 16868 KB
subtask2_13.txt AC 76 ms 16872 KB
subtask2_14.txt AC 76 ms 16872 KB
subtask2_15.txt AC 76 ms 16868 KB
subtask2_16.txt AC 76 ms 16868 KB
subtask2_17.txt AC 76 ms 16864 KB
subtask2_18.txt AC 76 ms 16868 KB
subtask2_19.txt AC 76 ms 16872 KB
subtask2_20.txt AC 76 ms 16864 KB
subtask2_21.txt AC 76 ms 16864 KB
subtask2_22.txt AC 76 ms 16868 KB