提出 #24569786

---

ソースコード 拡げる

(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*))
  (setq *random-state* (make-random-state t)))
#-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
(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"
  (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/binary-heap
  (:use :cl)
  (:export #:define-binary-heap #:heap-empty-error #:heap-empty-error-heap)
  (:documentation "Provides binary heap."))
(in-package :cp/binary-heap)

(define-condition heap-empty-error (error)
  ((heap :initarg :heap :reader heap-empty-error-heap))
  (:report
   (lambda (condition stream)
     (format stream "Attempted to get an element from empty heap ~W"
             (heap-empty-error-heap condition)))))

(defmacro define-binary-heap (name &key order (element-type 'fixnum))
  "Defines a binary heap specialized for the given order and the element
type. This macro defines a structure of the given NAME and relevant functions:
MAKE-<NAME>, <NAME>-PUSH, <NAME>-POP, <NAME>-CLEAR, <NAME>-EMPTY-P,
<NAME>-COUNT, <NAME>-PEEK, and <NAME>-MAP.

If ORDER is not given, heap for dynamic order is defined instead, and the
constructor takes an order function as an argument. Note that it will be
slightly slower than a static order, as it cannot be inlined."
  (check-type name symbol)
  (let* ((string-name (string name))
         (fname-push (intern (format nil "~A-PUSH" string-name)))
         (fname-pop (intern (format nil "~A-POP" string-name)))
         (fname-clear (intern (format nil "~A-CLEAR" string-name)))
         (fname-empty-p (intern (format nil "~A-EMPTY-P" string-name)))
         (fname-count (intern (format nil "~A-COUNT" string-name)))
         (fname-peek (intern (format nil "~A-PEEK" string-name)))
         (fname-make (intern (format nil "MAKE-~A" string-name)))
         (fname-map (intern (format nil "~A-MAP" string-name)))
         (acc-position (intern (format nil "~A-POSITION" string-name)))
         (acc-data (intern (format nil "~A-DATA" string-name)))
         (acc-order (intern (format nil "~A-ORDER" string-name)))
         (dynamic-order (null order))
         (order (or order 'order)))
    `(progn
       (defstruct (,name
                   (:constructor ,fname-make
                       (size
                        ,@(when dynamic-order '(order))
                        &aux
                        (data
                         (locally
                             (declare #+sbcl (sb-ext:muffle-conditions style-warning))
                           (make-array (1+ size) :element-type ',element-type))))))
         (data nil :type (simple-array ,element-type (*)))
         (position 1 :type (integer 1 #.array-dimension-limit))
         ,@(when dynamic-order
             `((order nil :type function))))

       (declaim #+sbcl (sb-ext:maybe-inline ,fname-push))
       (defun ,fname-push (obj heap)
         "Inserts OBJ to HEAP."
         (declare (optimize (speed 3))
                  (type ,name heap))
         (symbol-macrolet ((position (,acc-position heap)))
           (when (>= position (length (,acc-data heap)))
             (setf (,acc-data heap)
                   (adjust-array (,acc-data heap)
                                 (min (- array-dimension-limit 1)
                                      (* position 2)))))
           (let ((data (,acc-data heap))
                 ,@(when dynamic-order `((order (,acc-order heap)))))
             (declare ((simple-array ,element-type (*)) data))
             (labels ((heapify (pos)
                        (declare (optimize (speed 3) (safety 0))
                                 ((mod #.array-dimension-limit) pos))
                        (unless (= pos 1)
                          (let ((parent-pos (ash pos -1)))
                            (when (funcall ,order (aref data pos) (aref data parent-pos))
                              (rotatef (aref data pos) (aref data parent-pos))
                              (heapify parent-pos))))))
               (setf (aref data position) obj)
               (heapify position)
               (incf position)
               heap))))

       (declaim #+sbcl (sb-ext:maybe-inline ,fname-pop))
       (defun ,fname-pop (heap)
         "Removes and returns the element at the top of HEAP. Signals
HEAP-EMPTY-ERROR if HEAP is empty."
         (declare (optimize (speed 3))
                  (type ,name heap))
         (symbol-macrolet ((position (,acc-position heap)))
           (let ((data (,acc-data heap))
                 ,@(when dynamic-order `((order (,acc-order heap)))))
             (declare ((simple-array ,element-type (*)) data))
             (labels
                 ((heapify (pos)
                    (declare (optimize (speed 3) (safety 0))
                             ((mod #.array-dimension-limit) pos))
                    (let* ((child-pos1 (+ pos pos))
                           (child-pos2 (1+ child-pos1)))
                      (declare ((mod #.array-dimension-limit) child-pos1 child-pos2))
                      (when (<= child-pos1 position)
                        (if (<= child-pos2 position)
                            (if (funcall ,order (aref data child-pos1) (aref data child-pos2))
                                (unless (funcall ,order (aref data pos) (aref data child-pos1))
                                  (rotatef (aref data pos) (aref data child-pos1))
                                  (heapify child-pos1))
                                (unless (funcall ,order (aref data pos) (aref data child-pos2))
                                  (rotatef (aref data pos) (aref data child-pos2))
                                  (heapify child-pos2)))
                            (unless (funcall ,order (aref data pos) (aref data child-pos1))
                              (rotatef (aref data pos) (aref data child-pos1))))))))
               (when (= position 1)
                 (error 'heap-empty-error :heap heap))
               (prog1 (aref data 1)
                 (decf position)
                 (setf (aref data 1) (aref data position))
                 (heapify 1))))))

       (declaim (inline ,fname-clear))
       (defun ,fname-clear (heap)
         "Makes HEAP empty."
         (setf (,acc-position heap) 1)
         heap)

       (declaim (inline ,fname-empty-p))
       (defun ,fname-empty-p (heap)
         "Returns true iff HEAP is empty."
         (= 1 (,acc-position heap)))

       (declaim (inline ,fname-count))
       (defun ,fname-count (heap)
         "Returns the current number of the elements in HEAP."
         (- (,acc-position heap) 1))

       (declaim (inline ,fname-peek))
       (defun ,fname-peek (heap)
         "Returns the topmost element of HEAP. Signals HEAP-EMPTY-ERROR if HEAP
is empty."
         (if (= 1 (,acc-position heap))
             (error 'heap-empty-error :heap heap)
             (aref (,acc-data heap) 1)))

       (declaim (inline ,fname-map))
       (defun ,fname-map (function heap)
         "Applies FUNCTION to all the elements in HEAP. Note that the order in
which the elements in HEAP are passed to FUNCTION is not defined."
         (let ((data (,acc-data heap)))
           (loop for i from 1 below (,acc-position heap)
                 do (funcall function (aref data i))))))))

#+(or)
(define-binary-heap heap
  :order #'>
  :element-type fixnum)

(defpackage :cp/slope-trick
  (:use :cl :cp/binary-heap)
  (:export #:make-slope-trick #:strick-add+ #:strick-add- #:strick-add #:strick-shift
           #:strick-min #:strick-argmin #:strick-left-cum #:strick-right-cum #:strick-merge
           #:strick-calc)
  (:documentation
   "Reference:
https://maspypy.com/slope-trick-1-%e8%a7%a3%e8%aa%ac%e7%b7%a8"))
(in-package :cp/slope-trick)

;; TODO: add test

(define-binary-heap heap<
  :order #'<
  :element-type fixnum)

(define-binary-heap heap>
  :order #'>
  :element-type fixnum)

(defstruct (slope-trick (:constructor make-slope-trick
                            (lsize
                             &optional (rsize lsize) 
                             &aux (lheap (make-heap> lsize))
                                  (rheap (make-heap< rsize))))
                        (:conc-name %strick-)
                        (:copier nil)
                        (:predicate nil))
  (min 0 :type fixnum)
  (lheap nil :type heap>)
  (rheap nil :type heap<)
  ;; pop: +offset; push: -offset
  (loffset 0 :type fixnum)
  (roffset 0 :type fixnum))

(declaim (inline strick-min))
(defun strick-min (slope-trick)
  (%strick-min slope-trick))
(declaim (inline  (setf strick-min)))
(defun (setf strick-min) (new-value slope-trick)
  (setf (%strick-min slope-trick) new-value))

(declaim (ftype (function * (values (or null fixnum) (or null fixnum) &optional))
                strick-argmin))
(defun strick-argmin (slope-trick)
  "Returns two values: the left end and the right end of the closed interval on
which f takes the minimum. Positive and negative infinities are represented by
NIL."
  (let ((lheap (%strick-lheap slope-trick))
        (rheap (%strick-rheap slope-trick))
        (loffset (%strick-loffset slope-trick))
        (roffset (%strick-roffset slope-trick)))
    (values (unless (heap>-empty-p lheap)
              (+ loffset (heap>-peek lheap)))
            (unless (heap<-empty-p rheap)
              (+ roffset (heap<-peek rheap))))))

(defun strick-add+ (slope-trick a)
  "Adds x |-> max(0, x-a) to f."
  (declare (optimize (speed 3))
           (fixnum a))
  (symbol-macrolet ((min (%strick-min slope-trick))
                    (lheap (%strick-lheap slope-trick))
                    (rheap (%strick-rheap slope-trick))
                    (loffset (%strick-loffset slope-trick))
                    (roffset (%strick-roffset slope-trick)))
    (unless (heap>-empty-p lheap)
      (incf min (max 0 (the fixnum (- (the fixnum (+ (heap>-peek lheap) loffset)) a)))))
    (heap>-push (the fixnum (- a loffset)) lheap)
    (heap<-push (the fixnum (- (the fixnum (+ loffset (heap>-pop lheap))) roffset)) rheap)
    slope-trick))

(defun strick-add- (slope-trick a)
  "Adds x |-> max(0, a-x) to f."
  (declare (optimize (speed 3))
           (fixnum a))
  (symbol-macrolet ((min (%strick-min slope-trick))
                    (lheap (%strick-lheap slope-trick))
                    (rheap (%strick-rheap slope-trick))
                    (loffset (%strick-loffset slope-trick))
                    (roffset (%strick-roffset slope-trick)))
    (unless (heap<-empty-p rheap)
      (incf min (max 0 (the fixnum (- a (the fixnum (+ (heap<-peek rheap) roffset)))))))
    (heap<-push (the fixnum (- a roffset)) rheap)
    (heap>-push (the fixnum (- (the fixnum (+ roffset (heap<-pop rheap))) loffset)) lheap)
    slope-trick))

(defun strick-add (slope-trick a)
  "Adds x |-> abs(x-a) to f."
  (declare (fixnum a))
  (strick-add+ slope-trick a)
  (strick-add- slope-trick a))

(defun strick-left-cum (slope-trick)
  "Replaces f to g such that g(x) := min_{t <= x} f(t)."
  (heap<-clear (%strick-rheap slope-trick))
  (setf (%strick-roffset slope-trick) 0)
  slope-trick)

(defun strick-right-cum (slope-trick)
  "Replaces f to g such that g(x) := min_{x <= t} f(t)"
  (heap>-clear (%strick-lheap slope-trick))
  (setf (%strick-loffset slope-trick) 0)
  slope-trick)

(defun strick-shift (slope-trick ldelta &optional rdelta)
  "Replaces f to g such that g(x) := min_{x-r <= t <= x-l}f(x)."
  (declare (optimize (speed 3))
           (fixnum ldelta)
           ((or null fixnum) rdelta))
  (let ((rdelta (or rdelta ldelta)))
    (assert (<= ldelta rdelta))
    (incf (%strick-loffset slope-trick) ldelta)
    (incf (%strick-roffset slope-trick) rdelta)
    slope-trick))

(declaim (ftype (function * (values (mod #.array-dimension-limit) &optional))
                strick-size))
(defun strick-size (slope-trick)
  (+ (heap>-count (%strick-lheap slope-trick))
     (heap<-count (%strick-rheap slope-trick))))

(defun strick-merge (slope-trick1 slope-trick2)
  "Merges to SLOPE-TRICKs. You cannot use a side effect. Use a returned
value."
  (declare (optimize (speed 3)))
  (when (< (strick-size slope-trick1) (strick-size slope-trick2))
    (rotatef slope-trick1 slope-trick2))
  (let ((loffset2 (%strick-loffset slope-trick2)))
    (heap>-map (lambda (a)
                 (strick-add- slope-trick1 (the fixnum (+ a loffset2))))
               (%strick-lheap slope-trick2)))
  (let ((roffset2 (%strick-roffset slope-trick2)))
    (heap<-map (lambda (a)
                 (strick-add+ slope-trick1 (the fixnum (+ a roffset2))))
               (%strick-rheap slope-trick2)))
  (incf (%strick-min slope-trick1) (%strick-min slope-trick2))
  slope-trick1)

(defun strick-calc (slope-trick x)
  (declare (optimize (speed 3))
           (fixnum x))
  (multiple-value-bind (l r) (strick-argmin slope-trick)
    (let ((res (strick-min slope-trick))
          (slope 0)
          (lheap (%strick-lheap slope-trick))
          (loffset (%strick-loffset slope-trick))
          (rheap (%strick-rheap slope-trick))
          (roffset (%strick-roffset slope-trick)))
      (declare (fixnum slope))
      (cond ((<= l x r) res)
            ((< r x)
             (let ((prev r))
               (declare (fixnum prev))
               (loop (when (heap<-empty-p rheap)
                       (return))
                     (let ((a (+ roffset (heap<-pop rheap))))
                       (declare (fixnum a))
                       (when (< x a)
                         (return))
                       (incf res (* slope (- a prev)))
                       (setq prev a)
                       (incf slope)))
               (incf res (* slope (- x prev)))))
            ((< x l)
             (let ((prev l))
               (declare (fixnum prev))
               (loop (when (heap>-empty-p lheap)
                       (return))
                     (let ((a (+ loffset (heap>-pop lheap))))
                       (declare (fixnum a))
                       (when (< a x)
                         (return))
                       (incf res (* slope (- prev a)))
                       (setq prev a)
                       (decf slope)))
               (incf res (* slope (- prev x))))))
      res)))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/slope-trick :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/read-fixnum :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun solve (as bs coef)
  (declare (optimize (speed 3))
           ((simple-array uint62 (*)) as bs)
           (uint31 coef))
  (let* ((n (length as))
         (dp (make-slope-trick (* 2 n))))
    (dotimes (_ coef)
      (strick-add+ dp (- (aref as 0) (aref bs 0))))
    (strick-add dp 0)
    (loop for i from 1 below (- n 1)
          for a = (aref as i)
          for b = (aref bs i)
          do (strick-shift dp (- a b))
             (strick-right-cum dp)
             (strick-add dp 0))
    (strick-calc dp (max (- (aref bs (- n 1)) (aref as (- n 1)))
                         (strick-argmin dp)))))

(defun test (n sample)
  (dotimes (_ sample)
    (let ((as (make-array n :element-type 'uint62 :initial-element 0))
          (bs (make-array n :element-type 'uint62 :initial-element 0)))
      (dotimes (i n)
        (setf (aref as i) (+ 1 (random 20))))
      (dotimes (i n)
        (setf (aref bs i) (+ 1 (random 20))))
      (when (< (reduce #'+ as) (reduce #'+ bs))
        (rotatef as bs))
      (unless (= (solve as bs (- n 1)) (solve as bs (* 2 n)))
        (return-from test (values as bs))))))

(defun main ()
  (let* ((n (read))
         (as (make-array n :element-type 'uint62 :initial-element 0))
         (bs (make-array n :element-type 'uint62 :initial-element 0)))
    (dotimes (i n)
      (setf (aref as i) (read-fixnum)))
    (dotimes (i n)
      (setf (aref bs i) (read-fixnum)))
    (println (solve as bs (- n 1)))))

#-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://atcoder.jp/contests/kupc2016/tasks/kupc2016_h"))

#+swank
(defun gen-dat ()
  (uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
    (let* ((n 2000)
           (as (make-array n :element-type 'uint62 :initial-element 0))
           (bs (make-array n :element-type 'uint62 :initial-element 0)))
      (format out "~D~%" n)
      (dotimes (i n)
        (setf (aref as i) (+ 1 (random 100000)))
        (setf (aref bs i) (+ 1 (random 100000))))
      (when (> (reduce #'+ as) (reduce #'+ bs))
        (rotatef as bs))
      (dotimes (i n)
        (println (aref as i) out))
      (dotimes (i n)
        (println (aref bs i) 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 "2
"
          (run "2
1 5
3 1
" nil)))
  (5am:is
   (equal "6
"
          (run "5
1 2 3 4 5
3 3 1 1 1
" nil)))
  (5am:is
   (equal "48
"
          (run "27
46 3 4 2 10 2 5 2 6 7 20 13 9 49 3 8 4 3 19 9 3 5 4 13 9 5 7
10 2 5 6 2 6 3 2 2 5 3 11 13 2 2 7 7 3 9 5 13 4 17 2 2 2 4
" nil)))
  (5am:is
   (equal "6302172
"
          (run "18
3878348 423911 8031742 1035156 24256 10344593 19379 3867285 4481365 1475384 1959412 1383457 164869 4633165 6674637 9732852 10459147 2810788
1236501 770807 4003004 131688 1965412 266841 3980782 565060 816313 192940 541896 250801 217586 3806049 1220252 1161079 31168 2008961
" nil)))
  (5am:is
   (equal "1234567890
"
          (run "2
1 99999999999
1234567891 1
" nil))))

提出情報

コンパイルエラー

; file: /imojudge/sandbox/Main.lisp
; in: DEFUN STRICK-CALC
;     (* CP/SLOPE-TRICK::SLOPE (- CP/SLOPE-TRICK::PREV CP/SLOPE-TRICK::X))
; 
; note: forced to do GENERIC-* (cost 30)
;       unable to do inline fixnum arithmetic (cost 2) because:
;       The second argument is a (INTEGER -9223372036854775806
;                                 9223372036854775807), not a FIXNUM.
;       The result is a (VALUES
;                        (INTEGER -42535295865117307928310139910543638528
;                         42535295865117307923698453892116250624)
;                        &OPTIONAL), not a (VALUES FIXNUM &REST T).
;       unable to do inline (signed-byte 64) arithmetic (cost 4) because:
;       The result is a (VALUES
;                        (INTEGER -42535295865117307928310139910543638528
;                         42535295865117307923698453892116250624)
;                        &OPTIONAL), not a (VALUES (SIGNED-BYTE 64) &REST T).
;       etc.

;     (INCF CP/SLOPE-TRICK::RES
;           (* CP/SLOPE-TRICK::SLOPE (- CP/SLOPE-TRICK::PREV CP/SLOPE-TRICK::X)))
; --> SETQ THE 
; ==>
;   (+ (* CP/SLOPE-TRICK::SLOPE (- CP/SLOPE-TRICK::PREV CP/SLOPE-TRICK::X))
;      CP/SLOPE-TRICK::RES)
; 
; note: forced to do GENERIC-+ (cost 10)
;       unable to do inline fixnum arithmetic (cost 2) because:
;       The first argument is a (INTEGER -42535295865117307928310139910543638528
;                                42535295865117307923698453892116250624), not a FIXNUM.
;       The second argument is a NUMBER, not a FIXNUM.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
;       unable to do inline (signed-byte 64) arithmetic (cost 4) because:
;       The first argument is a (INTEGER -42535295865117307928310139910543638528
;                                42535295865117307923698453892116250624), not a (SIGNED-BYTE
;                                                                                64).
;       The second argument is a NUMBER, not a (SIGNED-BYTE 64).
;       The result is a (VALUES NUMBER &...

ジャッジ結果