提出 #7947960

---

ソースコード 拡げる

;; -*- coding: utf-8 -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil nil t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
(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
;;;

(defstruct (sliding-window (:constructor make-sliding-window
                               (size &aux
                                     (times (make-array size :element-type 'fixnum))
                                     (values (make-array size :element-type 'fixnum))))
                           (:conc-name %swindow-)
                           (:copier nil))
  (front-pos 0 :type (integer 0 #.most-positive-fixnum))
  (end-pos -1 :type (integer -1 #.most-positive-fixnum))
  (times nil :type (simple-array fixnum (*)))
  (values nil :type (simple-array fixnum (*))))

(defun %swindow-push-back (time value sw)
  (let ((new-end-pos (+ 1 (%swindow-end-pos sw))))
    (setf (aref (%swindow-times sw) new-end-pos) time
          (aref (%swindow-values sw) new-end-pos) value
          (%swindow-end-pos sw) new-end-pos)))

(defun %swindow-pop-back (sw)
  (decf (%swindow-end-pos sw)))

(defun %swindow-pop-front (sw)
  (incf (%swindow-front-pos sw)))

(declaim (inline swindow-extend))
(defun swindow-extend (time value sw order)
  "ORDER := #'< => minimum
ORDER := #'> => maximum"
  (let ((values (%swindow-values sw)))
    (loop while (and (<= (%swindow-front-pos sw) (%swindow-end-pos sw))
                     (not (funcall order
                                   (aref values (%swindow-end-pos sw))
                                   value)))
          do (%swindow-pop-back sw))
    (%swindow-push-back time value sw)))

(declaim (inline swindow-shrink))
(defun swindow-shrink (time sw)
  (let ((times (%swindow-times sw)))
    (loop while (and (<= (%swindow-front-pos sw) (%swindow-end-pos sw))
                     (< (aref times (%swindow-front-pos sw)) time))
          do (%swindow-pop-front sw))))

(declaim (inline swindow-empty-p))
(defun swindow-empty-p (sw)
  (> (%swindow-front-pos sw) (%swindow-end-pos sw)))

(declaim (inline swindow-get-opt))
(defun swindow-get-opt (sw)
  (let ((front-pos (%swindow-front-pos sw)))
    (aref (%swindow-values sw) front-pos)))

(declaim (inline %median3))
(defun %median3 (x y z order)
  (if (funcall order x y)
      (if (funcall order y z)
          y
          (if (funcall order z x)
              x
              z))
      (if (funcall order z y)
          y
          (if (funcall order x z)
              x
              z))))

(declaim (inline quicksort2))
(defun quicksort2 (vector order)
  (declare ((simple-array fixnum (*)) vector))
  (labels
      ((recur (left right)
         (when (< left right)
           (let* ((l left)
                  (r right)
                  (pivot (%median3 (aref vector l)
                                   (aref vector (ash (ash (+ l r) -2) 1))
                                   (aref vector r)
                                   order)))
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (loop (loop while (funcall order (aref vector l) pivot)
                         do (incf l 2))
                   (loop while (funcall order pivot (aref vector r))
                         do (decf r 2))
                   (when (>= l r)
                     (return))
                   (rotatef (aref vector l) (aref vector r))
                   (rotatef (aref vector (+ l 1)) (aref vector (+ r 1)))
                   (incf l 2)
                   (decf r 2))
             (recur left (- l 2))
             (recur (+ r 2) right)))))
    (recur 0 (- (length vector) 2))
    vector))

;; 市場価値の和をxA, xB、貴重度の和をyA, yBとするとき、xAとxBの差を一定以内に収
;; めつつ、yAとyBの差をできるだけ大きくする問題になる。財宝をS1とS2にわける。S1
;; のとある財宝の取り方の市場価値の差がΔx、貴重度の差がΔyであるとする。S2のす
;; べての財宝の取り方を市場価値の差の昇順でソートしておくとする。この時、市場価
;; 値の差が[-D-Δx, D-Δx]に入っているような（S2からの）取り方について、貴重度の
;; 最大値がわかればよい。

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (d (read))
         (size1 (ceiling n 2))
         (size2 (- n size1))
         (xs1 (make-array size1 :element-type 'uint62))
         (ys1 (make-array size1 :element-type 'uint62))
         (xs2 (make-array size2 :element-type 'uint62))
         (ys2 (make-array size2 :element-type 'uint62)))
    (declare ((integer 1 30) n)
             (uint62 d))
    (dotimes (i size1)
      (setf (aref xs1 i) (read)
            (aref ys1 i) (read)))
    (dotimes (i size2)
      (setf (aref xs2 i) (read)
            (aref ys2 i) (read)))
    (let ((xydeltas1 (make-array (ash (expt 3 size1) 1)
                                 :element-type 'fixnum))
          (xydeltas2 (make-array (ash (expt 3 size2) 1)
                                 :element-type 'fixnum)))
      (declare ((simple-array fixnum (*)) xydeltas1 xydeltas2))
      (let ((pointer 0))
        (declare (uint31 pointer))
        (sb-int:named-let recur ((pos 0) (xdelta 0) (ydelta 0))
          (declare (fixnum pos xdelta ydelta))
          (if (= pos size1)
              (setf (aref xydeltas1 pointer) xdelta
                    (aref xydeltas1 (+ 1 pointer)) ydelta
                    pointer (+ 2 pointer))
              (progn (recur (+ pos 1)
                            (+ xdelta (aref xs1 pos))
                            (+ ydelta (aref ys1 pos)))
                     (recur (+ pos 1) xdelta ydelta)
                     (recur (+ pos 1)
                            (- xdelta (aref xs1 pos))
                            (- ydelta (aref ys1 pos)))))))
      (let ((pointer 0))
        (declare (uint31 pointer))
        (sb-int:named-let recur ((pos 0) (xdelta 0) (ydelta 0))
          (declare (fixnum pos xdelta ydelta))
          (if (= pos size2)
              (setf (aref xydeltas2 pointer) xdelta
                    (aref xydeltas2 (+ 1 pointer)) ydelta
                    pointer (+ 2 pointer))
              (progn (recur (+ pos 1)
                            (- xdelta (aref xs2 pos))
                            (- ydelta (aref ys2 pos)))
                     (recur (+ pos 1) xdelta ydelta)
                     (recur (+ pos 1)
                            (+ xdelta (aref xs2 pos))
                            (+ ydelta (aref ys2 pos)))))))
      (setf xydeltas1 (quicksort2 xydeltas1 #'>)
            xydeltas2 (quicksort2 xydeltas2 #'<))
      (let ((sw (make-sliding-window (expt 3 size2)))
            (res 0)
            (pos 0)
            (len (* 2 (expt 3 size2))))
        (declare (uint62 res pos len))
        ;; [-D-Δx, D-Δx]
        (loop for idx below (* 2 (expt 3 size1)) by 2
              for xdelta1 = (aref xydeltas1 idx)
              for ydelta1 = (aref xydeltas1 (+ idx 1))
              for sup of-type fixnum = (- d xdelta1)
              for inf of-type fixnum = (- (- d) xdelta1)
              do (loop
                   (when (= pos len)
                     (return))
                   (let* ((xdelta2 (aref xydeltas2 pos))
                          (ydelta2 (aref xydeltas2 (+ pos 1))))
                     (declare (fixnum xdelta2 ydelta2))
                     (when (> xdelta2 sup)
                       (return))
                     (swindow-extend xdelta2 ydelta2 sw #'>)
                     (incf pos 2)))
                 (swindow-shrink inf sw)
                 (unless (swindow-empty-p sw)
                   (let ((max (swindow-get-opt sw)))
                     (setq res (max res (+ ydelta1 max))))))
        (println res)))))

#-swank (main)

提出情報

ジャッジ結果