結果

問題 No.1036 Make One With GCD 2
ユーザー sansaquasansaqua
提出日時 2021-03-24 00:39:55
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 562 ms / 2,000 ms
コード長 9,525 bytes
コンパイル時間 583 ms
コンパイル使用メモリ 48,896 KB
実行使用メモリ 51,456 KB
最終ジャッジ日時 2024-09-16 14:35:20
合計ジャッジ時間 14,193 ms
ジャッジサーバーID
(参考情報)
judge3 / judge5
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 327 ms
51,328 KB
testcase_01 AC 256 ms
51,456 KB
testcase_02 AC 236 ms
51,328 KB
testcase_03 AC 20 ms
25,344 KB
testcase_04 AC 26 ms
26,624 KB
testcase_05 AC 11 ms
23,936 KB
testcase_06 AC 11 ms
23,808 KB
testcase_07 AC 80 ms
30,592 KB
testcase_08 AC 67 ms
29,440 KB
testcase_09 AC 318 ms
50,688 KB
testcase_10 AC 298 ms
48,640 KB
testcase_11 AC 323 ms
51,328 KB
testcase_12 AC 299 ms
49,024 KB
testcase_13 AC 553 ms
50,048 KB
testcase_14 AC 562 ms
50,304 KB
testcase_15 AC 525 ms
48,512 KB
testcase_16 AC 531 ms
48,768 KB
testcase_17 AC 548 ms
49,664 KB
testcase_18 AC 11 ms
24,192 KB
testcase_19 AC 11 ms
24,192 KB
testcase_20 AC 11 ms
24,192 KB
testcase_21 AC 11 ms
24,192 KB
testcase_22 AC 517 ms
48,256 KB
testcase_23 AC 385 ms
41,856 KB
testcase_24 AC 542 ms
49,536 KB
testcase_25 AC 493 ms
47,104 KB
testcase_26 AC 509 ms
48,000 KB
testcase_27 AC 11 ms
24,064 KB
testcase_28 AC 11 ms
23,808 KB
testcase_29 AC 11 ms
23,936 KB
testcase_30 AC 10 ms
23,808 KB
testcase_31 AC 10 ms
23,936 KB
testcase_32 AC 11 ms
23,936 KB
testcase_33 AC 11 ms
23,936 KB
testcase_34 AC 11 ms
23,680 KB
testcase_35 AC 10 ms
24,064 KB
testcase_36 AC 10 ms
23,936 KB
testcase_37 AC 11 ms
23,808 KB
testcase_38 AC 227 ms
51,200 KB
testcase_39 AC 354 ms
51,328 KB
testcase_40 AC 385 ms
41,856 KB
testcase_41 AC 471 ms
51,328 KB
testcase_42 AC 470 ms
51,328 KB
testcase_43 AC 441 ms
51,456 KB
testcase_44 AC 458 ms
51,328 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 16 SEP 2024 02:35:05 PM):

; 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 */UNSIGNED=>INTEGER (cost 10)
;       unable to do inline fixnum arithmetic (cost 2) because:
;       The result is a (VALUES (MOD 21267647932558653957237540927630737410)
;                               &OPTIONAL), not a (VALUES FIXNUM &OPTIONAL).
;       unable to do inline (signed-byte 64) arithmetic (cost 4) because:
;       The result is a (VALUES (MOD 21267647932558653957237540927630737410)
;                               &OPTIONAL), not a (VALUES (SIGNED-BYTE 64)
;                                                         &OPTIONAL).
; 
; compilation unit finished
;   printed 1 note


; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.142

ソースコード

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 (optimize (speed 3)))
  (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 (when (= r n)
                (return))
              (when (= (fast-gcd (swag-fold swag #'fast-gcd 0)
                                 (aref as r))
                       1)
                (return))
              (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