提出 #6320820

---

ソースコード 拡げる

;; -*- 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
;;;
;;; Extended Eratosthenes' sieve (osa_k's method)
;;;
;;; build: O(n)
;;; With this sieve each prime factorization can be executed in O(log(n)), which
;;; is faster than the well known one in O(N/log(n) + log(n)).
;;; Reference: http://www.osak.jp/diary/diary_201310.html#20131017
;;;

(defun make-minfactor-table (sup)
  "Returns a vector of length SUP, whose (0-based) i-th value is the minimal
prime factor of i. (Corner case: 0th value is 0 and 1st value is 1.)"
  (declare #.OPT)
  (check-type sup (integer 2 (#.array-total-size-limit)))
  (let ((table (make-array sup :element-type '(unsigned-byte 32))))
    ;; initialize
    (dotimes (i sup) (setf (aref table i) i))
    ;; p = 2
    (loop for even-num from 4 below sup by 2
          do (setf (aref table even-num) 2))
    ;; p >= 3
    (loop for p from 3 to (+ 1 (isqrt (- sup 1))) by 2
          when (= p (aref table p))
          do (loop for composite from (* p p) below sup by p
                   when (= (aref table composite) composite)
                   do (setf (aref table composite) p)))
    table))

(defun factorize (x minfactor-table)
  "Returns the associative list of prime factors of X, which is composed
of (<prime> . <exponent>). E.g. (factorize 100 <minfactor-table>) => '((2
. 2) (5 . 5)). The returned list is in ascending order
w.r.t. prime. Note: (FACTORIZE 0 TABLE) |-> NIL.

MINFACTOR-TABLE := vector (MINFACTOR-TABLE[k] is the minimal prime factor of k)"
  (declare #.OPT
           (fixnum x)
           ((simple-array (unsigned-byte 32) (*)) minfactor-table))
  (setq x (abs x))
  (when (<= x 1) (return-from factorize nil))
  (assert (< x (length minfactor-table)))
  (loop until (= x 1)
        for prime of-type (integer 0 #.most-positive-fixnum) = (aref minfactor-table x)
        collect (loop for exponent of-type (integer 0 #.most-positive-fixnum) from 0
                      do (multiple-value-bind (quot rem) (floor x prime)
                           (if (zerop rem)
                               (setf x quot)
                               (loop-finish)))
                      finally (return (cons prime exponent)))))

(defconstant +binom-size+ 1600000)
(defconstant +binom-mod+ #.(+ (expt 10 9) 7))

(declaim ((simple-array (unsigned-byte 32) (*)) *inv*))
(defparameter *inv* (make-array +binom-size+ :element-type '(unsigned-byte 32)))

(defun initialize-binom ()
  (declare #.OPT)
  (setf (aref *inv* 1) 1)
  (loop for i from 2 below +binom-size+
        do (setf (aref *inv* i)
                 (- +binom-mod+
                    (rem (* (aref *inv* (rem +binom-mod+ i))
                            (floor +binom-mod+ i))
                         +binom-mod+)))))

(initialize-binom)

(defmacro with-output-buffer (&body body)
  "Buffers all outputs to *STANDARD-OUTPUT* in BODY and flushes them to
*STANDARD-OUTPUT* after BODY has been done (without error). Note that only
BASE-CHAR is allowed."
  (let ((out (gensym)))
    `(let ((,out (make-string-output-stream :element-type 'base-char)))
       (let ((*standard-output* ,out))
         ,@body)
       (write-string (get-output-stream-string ,out)))))

(declaim (ftype (function * (values fixnum &optional)) read-fixnum+))
(defun read-fixnum+ (&optional (in *standard-input*))
  (declare #.OPT
           #-swank (sb-kernel:ansi-stream in))
  (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* ((result (loop (let ((byte (%read-byte)))
                           (cond ((<= 48 byte 57)
                                  (return (- byte 48)))
                                 ((zerop byte) ; #\Nul
                                  (error "Read EOF or #\Nul.")))))))
      (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 result)))))))

(defstruct (mo (:constructor %make-mo
                   (lefts rights order width))
               (:conc-name %mo-)
               (:copier nil)
               (:predicate nil))
  (lefts nil :type (simple-array (unsigned-byte 32) (*)))
  (rights nil :type (simple-array (unsigned-byte 32) (*)))
  (order nil :type (simple-array (unsigned-byte 32) (*)))
  (width 0 :type (integer 0 #.most-positive-fixnum))
  (index 0 :type (integer 0 #.most-positive-fixnum))
  (posl 0 :type fixnum)
  (posr 0 :type fixnum)
  (old-posl 0 :type fixnum)
  (old-posr 0 :type fixnum))

(defun make-mo (total-width lefts rights)
  "TOTAL-WIDTH is the width of the interval on which the queries exist. (NOT the
number of queries.)"
  (declare #.OPT
           ((simple-array (unsigned-byte 32) (*)) lefts rights)
           ((integer 0 #.most-positive-fixnum) total-width)
           (inline sort))
  (let* ((q (length lefts))
         (order (make-array q :element-type '(unsigned-byte 32)))
         (width (floor total-width (isqrt q))))
    (declare ((integer 0 #.most-positive-fixnum) width))
    (assert (= q (length rights)))
    (dotimes (i q) (setf (aref order i) i))
    (setf order (sort order
                      (lambda (x y)
                        (if (= (floor (aref lefts x) width)
                               (floor (aref lefts y) width))
                            ;; Even-number [Odd-number] block is in ascending
                            ;; [descending] order w.r.t. the right boundary.
                            (if (evenp (floor (aref lefts x) width))
                                (< (aref rights x) (aref rights y))
                                (> (aref rights x) (aref rights y)))
                            (< (aref lefts x) (aref lefts y))))))
    (%make-mo lefts rights order width)))

(declaim (inline mo-get-current))
(defun mo-get-current (mo)
  "Returns the original index of the current query."
  (aref (%mo-order mo) (%mo-index mo)))

(declaim (inline mo-process))
(defun mo-process (mo extend shrink)
  "Processes the next query."
  (declare (function extend shrink))
  (let* ((ord (mo-get-current mo))
         (left (aref (%mo-lefts mo) ord))
         (right (aref (%mo-rights mo) ord))
         (posl (%mo-posl mo))
         (posr (%mo-posr mo)))
    (declare ((integer 0 #.most-positive-fixnum) posl posr))
    (setf (%mo-old-posl mo) posl
          (%mo-old-posr mo) posr)
    (loop while (< left posl)
          do (decf posl)
             (funcall extend posl))
    (loop while (< posr right)
          do (funcall extend posr)
             (incf posr))
    (loop while (< posl left)
          do (funcall shrink posl)
             (incf posl))
    (loop while (< right posr)
          do (decf posr)
             (funcall shrink posr))
    (setf (%mo-posl mo) posl
          (%mo-posr mo) posr)
    (incf (%mo-index mo))))

(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

;; TODO: Is it better to use DEFTRANSFORM to optimize these functions when they
;; are passed to an inlined function?
;; TODO: define WITH-MOD-OPERATIONS to make them dynamic (though we cannot add
;; compiler-macro nor transformer in this case...)
(defmacro define-mod-operations (&optional (divisor 1000000007))
  `(progn
     (defun mod* (&rest args)
       (reduce (lambda (x y) (mod (* x y) ,divisor)) args))

     (define-compiler-macro mod* (&rest args)
       (if (null args)
           1
           (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args)))

     (defun mod+ (&rest args)
       (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))

     (define-compiler-macro mod+ (&rest args)
       (if (null args)
           0
           (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args)))

     (define-modify-macro incfmod (delta divisor)
       (lambda (x y divisor) (mod (+ x y) divisor)))

     (define-modify-macro decfmod (delta divisor)
       (lambda (x y divisor) (mod (- x y) divisor)))))

(define-mod-operations)

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (q (read))
         (minfactors (make-minfactor-table 100001))
         (xs (make-array n :element-type 'list :initial-element nil))
         (ls (make-array q :element-type 'uint32))
         (rs (make-array q :element-type 'uint32))
         (res (make-array q :element-type 'uint32)))
    (declare (uint32 n)
             ((simple-array uint32 (*)) minfactors))
    (dotimes (i n)
      (setf (aref xs i) (factorize (read-fixnum+) minfactors)))
    (dotimes (i q)
      (setf (aref ls i) (- (read-fixnum+) 1))
      (setf (aref rs i) (read-fixnum+)))
    (let ((value 1)
          (table (make-array 100001 :element-type 'uint32 :initial-element 1))
          (mo (make-mo n ls rs)))
      (declare (uint32 value))
      (dotimes (_ q)
        (let ((pos (mo-get-current mo)))
          (mo-process mo
                      (lambda (idx)
                        (let ((factors (aref xs idx)))
                          (dolist (node factors)
                            (let* ((prime (car node))
                                   (delta (cdr node))
                                   (old-count (aref table prime))
                                   (new-count (+ old-count delta)))
                              (declare (uint32 prime delta old-count new-count))
                              (setq value (mod* value new-count (aref *inv* old-count)))
                              (setf (aref table prime) new-count)))))
                      (lambda (idx)
                        (let ((factors (aref xs idx)))
                          (dolist (node factors)
                            (let* ((prime (car node))
                                   (delta (cdr node))
                                   (old-count (aref table prime))
                                   (new-count (- old-count delta)))
                              (declare (uint32 prime delta old-count new-count))
                              (setq value (mod* value new-count (aref *inv* old-count)))
                              (setf (aref table prime) new-count))))))
          (setf (aref res pos) value)))
      (with-output-buffer (dotimes (i q) (println (aref res i)))))))

#-swank(main)

提出情報

ジャッジ結果