結果

問題 No.1036 Make One With GCD 2
ユーザー sansaquasansaqua
提出日時 2021-03-24 00:41:13
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 522 ms / 2,000 ms
コード長 9,483 bytes
コンパイル時間 1,467 ms
コンパイル使用メモリ 49,960 KB
実行使用メモリ 57,900 KB
最終ジャッジ日時 2023-10-14 20:44:39
合計ジャッジ時間 13,286 ms
ジャッジサーバーID
(参考情報)
judge12 / judge15
このコードへのチャレンジ(β)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 292 ms
56,136 KB
testcase_01 AC 245 ms
53,988 KB
testcase_02 AC 200 ms
57,852 KB
testcase_03 AC 19 ms
27,428 KB
testcase_04 AC 25 ms
29,400 KB
testcase_05 AC 11 ms
26,848 KB
testcase_06 AC 11 ms
26,760 KB
testcase_07 AC 72 ms
31,560 KB
testcase_08 AC 61 ms
31,484 KB
testcase_09 AC 292 ms
51,972 KB
testcase_10 AC 271 ms
49,932 KB
testcase_11 AC 297 ms
57,812 KB
testcase_12 AC 273 ms
49,904 KB
testcase_13 AC 516 ms
51,984 KB
testcase_14 AC 522 ms
52,048 KB
testcase_15 AC 489 ms
53,760 KB
testcase_16 AC 493 ms
50,000 KB
testcase_17 AC 510 ms
57,852 KB
testcase_18 AC 10 ms
24,824 KB
testcase_19 AC 10 ms
24,876 KB
testcase_20 AC 11 ms
24,880 KB
testcase_21 AC 12 ms
28,620 KB
testcase_22 AC 482 ms
49,984 KB
testcase_23 AC 356 ms
43,744 KB
testcase_24 AC 505 ms
55,728 KB
testcase_25 AC 460 ms
49,996 KB
testcase_26 AC 478 ms
51,924 KB
testcase_27 AC 11 ms
27,808 KB
testcase_28 AC 10 ms
24,716 KB
testcase_29 AC 10 ms
24,696 KB
testcase_30 AC 10 ms
24,740 KB
testcase_31 AC 11 ms
26,776 KB
testcase_32 AC 10 ms
28,640 KB
testcase_33 AC 10 ms
26,856 KB
testcase_34 AC 12 ms
28,696 KB
testcase_35 AC 11 ms
27,788 KB
testcase_36 AC 10 ms
24,708 KB
testcase_37 AC 11 ms
26,820 KB
testcase_38 AC 192 ms
54,056 KB
testcase_39 AC 318 ms
54,104 KB
testcase_40 AC 360 ms
43,820 KB
testcase_41 AC 437 ms
54,076 KB
testcase_42 AC 438 ms
57,900 KB
testcase_43 AC 408 ms
54,024 KB
testcase_44 AC 423 ms
54,044 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 14 OCT 2023 08:44:24 PM):
; processing (IN-PACKAGE :CL-USER)
; processing (DEFPARAMETER *OPT* ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DOLIST (F #) ...)
; processing (SETQ *RANDOM-STATE* ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFMACRO DBG ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFPACKAGE :CP/SWAG ...)
; processing (IN-PACKAGE :CP/SWAG)
; processing (DEFINE-CONDITION SWAG-EMPTY-ERROR ...)
; processing (DEFSTRUCT (SWAG # ...) ...)
; processing (DECLAIM (INLINE SWAG-PUSH))
; processing (DEFUN SWAG-PUSH ...)
; processing (DECLAIM (INLINE SWAG-POP))
; processing (DEFUN SWAG-POP ...)
; processing (DECLAIM (INLINE SWAG-FOLD))
; processing (DEFUN SWAG-FOLD ...)
; processing (DEFPACKAGE :CP/READ-FIXNUM ...)
; processing (IN-PACKAGE :CP/READ-FIXNUM)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (DEFPACKAGE :CP/TZCOUNT ...)
; processing (IN-PACKAGE :CP/TZCOUNT)
; processing (DECLAIM (INLINE TZCOUNT))
; processing (DEFUN TZCOUNT ...)
; processing (DEFPACKAGE :CP/FAST-GCD ...)
; processing (IN-PACKAGE :CP/FAST-GCD)
; processing (DECLAIM (INLINE %FAST-GCD ...))
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %FAST-GCD ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN FAST-GCD ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN FAST-LCM ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN FAST-LCM
;     (* (TRUNCATE MAX (CP/FAST-GCD:%FAST-GCD CP/FAST-GCD::U CP/FAST-GCD::V)) MIN)
; 
; note: forced to do GENERIC-* (cost 30)
;       unable to do inline fixnum arithmetic (cost 2) because:
;       The result is a (VALUES (MOD 21267647932558653957237540927630737410)
;                               &OPTIONAL), not a (VALUES FIXNUM &REST T).
;       unable to do inline (signed-byte 64) arithmetic (cost 4) because:
;    

ソースコード

diff #

(in-package :cl-user)
(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 :cp/util) :silent t)
  #+swank (use-package :cp/util :cl-user)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))
  #+sbcl (dolist (f '(:popcnt :sse4)) (pushnew f sb-c:*backend-subfeatures*))
  #+sbcl (setq *random-state* (seed-random-state (nth-value 1 (get-time-of-day)))))
#-swank (eval-when (:compile-toplevel)
          (setq *break-on-signals* '(and warning (not style-warning))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(macrolet ((def (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(def ,b)) bits))))
  (define-int-types 2 4 7 8 15 16 31 32 62 63 64))

(defconstant +mod+ 1000000007)

(defmacro dbg (&rest forms)
  (declare (ignorable forms))
  #+swank (if (= (length forms) 1)
              `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
              `(format *error-output* "~A => ~A~%" ',forms `(,,@forms))))

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format*
          (if (typep obj 'double-float) 'double-float *read-default-float-format*)))
    (prog1 (princ obj stream) (terpri stream))))

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Sliding window aggregation over semigroup
;;;

(defpackage :cp/swag
  (:use :cl)
  (:export #:swag-empty-error #:make-swag #:swag #:swag-push #:swag-pop #:swag-fold))
(in-package :cp/swag)

(define-condition swag-empty-error (error)
  ((swag :initarg :swag :reader swag-empty-error-swag))
  (:report
   (lambda (condition stream)
     (format stream "Attempted to pop empty swag ~W"
             (swag-empty-error-swag condition)))))

(defstruct (swag (:constructor make-swag ())
                 (:conc-name %swag-)
                 (:copier nil)
                 (:predicate nil))
  ;; FRONT and BACK stores a stack of cons cells: (object . cumulative sum)
  (front nil :type list)
  (back nil :type list))

(declaim (inline swag-push))
(defun swag-push (swag obj operation)
  "Adds OBJ to the end of SWAG."
  (push (cons obj (if (%swag-front swag)
                      (funcall operation (cdar (%swag-front swag)) obj)
                      obj))
        (%swag-front swag)))

(declaim (inline swag-pop))
(defun swag-pop (swag operation)
  "Removes the first element of SWAG."
  (unless (%swag-back swag)
    (unless (%swag-front swag)
      (error 'swag-empty-error))
    (loop for node in (%swag-front swag)
          for value = (if (%swag-back swag)
                          (funcall operation (car node) (cdar (%swag-back swag)))
                          (car node))
          do (push (rplacd node value) (%swag-back swag)))
    (setf (%swag-front swag) nil))
  (pop (%swag-back swag)))

(declaim (inline swag-fold))
(defun swag-fold (swag operation &optional identity)
  "Folds the existing object by OPERATION, which must comprise a
semiring. Returns IDENTITY when an empty SWAG is folded."
  (if (%swag-back swag)
      (if (%swag-front swag)
          (funcall operation
                   (cdar (%swag-back swag))
                   (cdar (%swag-front swag)))
          (cdar (%swag-back swag)))
      (if (%swag-front swag)
          (cdar (%swag-front swag))
          identity)))


(defpackage :cp/read-fixnum
  (:use :cl)
  (:export #:read-fixnum))
(in-package :cp/read-fixnum)

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.cl-user::*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 #\-))
                                  (setq 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))))))))

(defpackage :cp/tzcount
  (:use :cl)
  (:export #:tzcount))
(in-package :cp/tzcount)

(declaim (inline tzcount))
(defun tzcount (x)
  "Returns the number of trailing zero bits. Note that (TZCOUNT 0) = -1."
  (- (integer-length (logand x (- x))) 1))

;;;
;;; GCD and LCM
;;; Reference:
;;; https://lemire.me/blog/2013/12/26/fastest-way-to-compute-the-greatest-common-divisor/
;;;

(defpackage :cp/fast-gcd
  (:use :cl :cp/tzcount)
  (:export #:fast-gcd #:fast-lcm #:%fast-gcd))
(in-package :cp/fast-gcd)

(declaim (inline %fast-gcd fast-gcd fast-lcm))

(declaim (ftype (function * (values (integer 1 #.most-positive-fixnum) &optional)) %fast-gcd))
(defun %fast-gcd (u v)
  (declare ((integer 0 #.most-positive-fixnum) u v))
  (let ((shift (tzcount (logior u v))))
    (declare (optimize (safety 0)))
    (setq u (ash u (- (tzcount u))))
    (loop (setq v (ash v (- (tzcount v))))
          (when (> u v)
            (rotatef u v))
          (decf v u)
          (when (zerop v)
            (return (the (integer 1 #.most-positive-fixnum)
                         (ash u shift)))))))

(declaim (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) fast-gcd))
(defun fast-gcd (u v)
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) u v))
  (cond ((zerop u) v)
        ((zerop v) u)
        (t (%fast-gcd u v))))

(declaim (ftype (function * (values (integer 0) &optional)) fast-lcm))
(defun fast-lcm (u v)
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) u v))
  (if (or (zerop u) (zerop v))
      0
      (multiple-value-bind (max min)
          (if (> u v)
              (values u v)
              (values v u))
        (* (truncate max (%fast-gcd u v)) min))))

(defpackage :cp/modify-macro
  (:use :cl)
  (:export #:minf #:maxf #:mulf #:divf #:iorf #:xorf #:andf))
(in-package :cp/modify-macro)

(macrolet ((def (name fname)
             `(define-modify-macro ,name (new-value) ,fname)))
  (def minf min)
  (def maxf max)
  (def mulf *)
  (def divf /)
  (def iorf logior)
  (def xorf logxor)
  (def andf logand))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/modify-macro :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/fast-gcd :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/read-fixnum :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/swag :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (declare #.*opt*)
  (let* ((n (read))
         (as (make-array n :element-type 'uint62 :initial-element 0))
         (res 0)
         (swag (make-swag)))
    (declare (uint31 n)
             (uint62 res))
    (dotimes (i n)
      (setf (aref as i) (read-fixnum)))
    (let ((r 0))
      (declare (uint31 r))
      (dotimes (l n)
        (maxf r l)
        (loop until (or (= r n)
                        (= (fast-gcd (swag-fold swag #'fast-gcd 0)
                                     (aref as r))
                           1))
              do (swag-push swag (aref as r) #'fast-gcd)
                 (incf r))
        (incf res (- r l))
        (when (> r l)
          (swag-pop swag #'fast-gcd))))
    (println (- (ash (* n (+ n 1)) -1)
                res))))

#-swank (main)

;;;
;;; Test
;;;

#+swank
(progn
  (defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname))
  (setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*))
  (uiop:chdir *default-pathname-defaults*)
  (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*))
  (defparameter *problem-url* "https://yukicoder.me/problems/4072"))

#+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)))

#+(and sbcl (not swank))
(eval-when (:compile-toplevel)
  (when sb-c::*undefined-warnings*
    (error "undefined warnings: ~{~A~^ ~}" sb-c::*undefined-warnings*)))

;; To run: (5am:run! :sample)
#+swank
(5am:test :sample
  (5am:is
   (equal "4
"
          (run "3
1 2 3
" nil)))
  (5am:is
   (equal "10
"
          (run "4
1 1 1 1
" nil)))
  (5am:is
   (equal "0
"
          (run "4
2 4 8 16
" nil)))
  (5am:is
   (equal "28
"
          (run "10
801754 703742 332182 68016 914814 8470 937255 293192 313080 501971
" nil))))
0