Submission #6132285

---

Source Code Expand

;; -*- 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 (progn (ql:quickload '(:cl-debug-print :fiveam))
                 (shadow :run)
                 (use-package :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)

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Binary heap
;;;

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

(define-condition heap-full-error (simple-error)
  ((heap :initarg :heap :reader heap-full-error-heap)
   (item :initarg :item :reader heap-full-error-item))
  (:report
   (lambda (condition stream)
     (format stream "Attempted to push item ~W to full heap ~W"
             (heap-full-error-item condition)
             (heap-full-error-heap condition)))))

(defmacro define-binary-heap (name &key (order '#'>) (element-type 'fixnum))
  (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-reinitialize (intern (format nil "~A-REINITIALIZE" string-name)))
         (fname-empty-p (intern (format nil "~A-EMPTY-P" string-name)))
         (fname-count (intern (format nil "~A-COUNT" string-name)))
         (fname-peak (intern (format nil "~A-PEAK" string-name)))
         (fname-make (intern (format nil "MAKE-~A" string-name)))
         (acc-position (intern (format nil "~A-POSITION" string-name)))
         (acc-data (intern (format nil "~A-DATA" string-name))))
    `(progn
       (defstruct (,name
                   (:constructor ,fname-make
                       (size
                        &aux (data ,(if (eql element-type '*)
                                        `(make-array (1+ size))
                                        `(make-array (1+ size) :element-type ',element-type))))))
         (data #() :type (simple-array ,element-type (*)) :read-only t)
         (position 1 :type (integer 1 #.most-positive-fixnum)))

       (declaim (sb-ext:maybe-inline ,fname-push))
       (defun ,fname-push (obj heap)
         "Adds OBJ to the end of HEAP."
         (declare (optimize (speed 3))
                  (type ,name heap))
         (symbol-macrolet ((position (,acc-position heap)))
           (let ((data (,acc-data heap)))
             (declare ((simple-array ,element-type (*)) data))
             (labels ((update (pos)
                        (declare (optimize (speed 3) (safety 0)))
                        (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))
                              (update parent-pos))))))
               (unless (< position (length data))
                 (error 'heap-full-error :heap heap :item obj))
               (setf (aref data position) obj)
               (update position)
               (incf position)
               heap))))
       (declaim (notinline ,fname-push))

       (declaim (sb-ext:maybe-inline ,fname-pop))
       (defun ,fname-pop (heap)
         "Pops an element from the top of HEAP."
         (declare (optimize (speed 3))
                  (type ,name heap))
         (symbol-macrolet ((position (,acc-position heap)))
           (let ((data (,acc-data heap)))
             (declare ((simple-array ,element-type (*)) data))
             (labels ((update (pos)
                        (declare (optimize (speed 3) (safety 0))
                                 ((integer 1 #.most-positive-fixnum) pos))
                        (let* ((child-pos1 (+ pos pos))
                               (child-pos2 (1+ child-pos1)))
                          (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))
                                      (update child-pos1))
                                    (unless (funcall ,order (aref data pos) (aref data child-pos2))
                                      (rotatef (aref data pos) (aref data child-pos2))
                                      (update 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))
                 (update 1))))))

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

       (declaim (inline ,fname-empty-p))
       (defun ,fname-empty-p (heap)
         "Returns true if 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-peak))
       (defun ,fname-peak (heap)
         "Returns the topmost element of HEAP."
         (if (= 1 (,acc-position heap))
             (error 'heap-empty-error :heap heap)
             (aref (,acc-data heap) 1))))))

;; unfinished.

(declaim (inline find-optimum))
(defun find-optimum (sequence predicate &key (start 0) end)
  "Returns an index x that satisfies (NOT (FUNCALL PREDICATE SEQUENCE[y]
SEQUENCE[x])) (i.e. SEQUENCE[x] >= SEQUENCE[y]) for all the indices y and
returns SEQUENCE[x] as the second value."
  (declare ((or null (integer 0 #.most-positive-fixnum)) end)
           ((integer 0 #.most-positive-fixnum) start)
           (function predicate)
           (sequence sequence))
  (etypecase sequence
    (list (error "Not implemented yet."))
    (vector
     (let ((end (or end (length sequence))))
       (unless (<= start end)
         (error "Can't find optimal value in null interval [~A, ~A)" start end))
       (let ((optimum (aref sequence 0))
             (index 0))
         (dotimes (i (length sequence) (values index optimum))
           (unless (funcall predicate optimum (aref sequence i))
             (setq optimum (aref sequence i)
                   index i))))))))

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  (declare #.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 #\-))
                                  (setf 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))))))))

(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

(define-binary-heap heap
  :order #'<
  :element-type (unsigned-byte 32))

(define-binary-heap heapheap
  :order (lambda (h1 h2)
           (let ((min1 (heap-peak h1))
                 (min2 (heap-peak h2)))
             (declare (uint32 min1 min2))
             (< min1 min2)))
  :element-type heap)

(defun cut-seq (as k)
  (declare #.OPT
           ((simple-array uint32 (*)) as)
           (uint32 k))
  (let ((qqueue (make-heapheap (length as)))
        (base (position #xffffffff as :test (complement #'eql))))
    (loop for i from base below (length as)
          do (when (= #xffffffff (aref as i))
               (when (>= (- i base) k)
                 (let ((queue (make-heap (- i base))))
                   (loop for j from base below i
                         do (heap-push (aref as j) queue))
                   (heapheap-push queue qqueue)))
               (setq base (+ i 1))))
    qqueue))

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (k (read))
         (q (read))
         (as (make-array (+ n 1) :element-type 'uint32 :initial-element #xffffffff))
         (res #xffffffff))
    (declare (uint32 res n k q))
    (dotimes (i n) (setf (aref as i) (read-fixnum)))
    (dotimes (_ n)
      (let ((qqueue (cut-seq as k))
            (min #xffffffff)
            (max 0))
        (declare (uint32 min max))
        (dotimes (_ q (setf res (min res (- max min))))
          (when (heapheap-empty-p qqueue)
            (return))
          (let* ((teil (heapheap-pop qqueue))
                 (a (heap-pop teil)))
            (declare (uint32 a))
            (setf min (min a min)
                  max (max a max))
            (when (>= (heap-count teil) k)
              (heapheap-push teil qqueue))))
        (setf (aref as (find-optimum as #'<)) #xffffffff)))
    (println res)))

#-swank(main)

Submission Info

Judge Result