提出 #10329281

---

ソースコード 拡げる

(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
           ;; enclose the form with VALUES to avoid being captured by LOOP macro
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy

(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)

;; BEGIN_INSERTED_CONTENTS
;; This is a decimal reader specialized for the inputs that can be handled
;; within the range of FIXNUM. The implementation is based on
;; SB-IMPL::MAKE-FLOAT.
(defun read-simple-float (&optional (in *standard-input*))
  "Reads a fixed point float in the format of *READ-DEFAULT-FLOAT-FORMAT*.

NOTE: two numbers before and after the decimal point must be within (INTEGER 0
#.MOST-POSITIVE-FIXNUM)."
  (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* ((byte 0)
           (minus nil)
           (number (loop
                     (setq byte (%read-byte))
                     (cond ((<= 48 byte 57)
                            (return (- byte 48)))
                           ((zerop byte) ; #\Nul
                            (error "Read EOF or #\Nul."))
                           ((= byte #.(char-code #\-))
                            (setq minus t)))))
           (divisor 1))
      (declare ((integer 0 #.most-positive-fixnum) number))
      (loop
        (setq byte (%read-byte))
        (if (<= 48 byte 57)
            (setq number (+ (- byte 48) (* 10 (the (integer 0 #.(floor most-positive-fixnum 10)) number))))
            (return)))
      (when (= byte #.(char-code #\.))
        (loop
          (setq byte (%read-byte))
          (if (<= 48 byte 57)
              (setq number (+ (- byte 48) (* 10 (the (integer 0 #.(floor most-positive-fixnum 10)) number)))
                    divisor (* 10 (the (integer 0 #.(floor most-positive-fixnum 10)) divisor)))
              (return))))
      (let ((num (coerce (/ number divisor) *read-default-float-format*)))
        (if minus (- num) num)))))

;; Treap accessible by index (O(log(n))).
;; Virtually it works like std::set of C++ or TreeSet of Java. 

;; Note:
;; - You shouldn't insert duplicate keys into a treap unless you know what you
;; are doing.
;; - You cannot rely on the side effect when you call any destructive operations
;; on a treap. Always use the returned value.
;; - An empty treap is NIL.

(defstruct (treap (:constructor %make-treap (key priority &key left right))
                  (:copier nil)
                  (:conc-name %treap-))
  (key 0 :type fixnum)
  (priority 0 :type (integer 0 #.most-positive-fixnum))
  (left nil :type (or null treap))
  (right nil :type (or null treap)))

(declaim (inline treap-bisect-left)
         (ftype (function * (values (or null fixnum) &optional)) treap-bisect-left))
(defun treap-bisect-left (value treap &key (order #'<))
  "Returns the smallest index and the corresponding key that satisfies
TREAP[index] >= VALUE. Returns the size of TREAP and VALUE if TREAP[size-1] <
VALUE."
  (labels ((recur (treap)
             (cond ((null treap) nil)
                   ((funcall order (%treap-key treap) value)
                    (recur (%treap-right treap)))
                   (t (or (recur (%treap-left treap))
                          (%treap-key treap))))))
    (recur treap)))

(declaim (inline treap-split)
         (ftype (function * (values (or null treap) (or null treap) &optional)) treap-split))
(defun treap-split (key treap &key (order #'<))
  "Destructively splits the TREAP with reference to KEY and returns two treaps,
the smaller sub-treap (< KEY) and the larger one (>= KEY)."
  (declare ((or null treap) treap))
  (labels ((recur (treap)
             (cond ((null treap)
                    (values nil nil))
                   ((funcall order (%treap-key treap) key)
                    (multiple-value-bind (left right) (recur (%treap-right treap))
                      (setf (%treap-right treap) left)
                      (values treap right)))
                   (t
                    (multiple-value-bind (left right) (recur (%treap-left treap))
                      (setf (%treap-left treap) right)
                      (values left treap))))))
    (recur treap)))

(declaim (inline treap-insert))
(defun treap-insert (key treap &key (order #'<))
  "Destructively inserts KEY into TREAP and returns the resultant treap."
  (declare ((or null treap) treap))
  (let ((node (%make-treap key (random most-positive-fixnum))))
    (labels ((recur (treap)
               (declare (treap node))
               (cond ((null treap) node)
                     ((> (%treap-priority node) (%treap-priority treap))
                      (setf (values (%treap-left node) (%treap-right node))
                            (treap-split (%treap-key node) treap :order order))
                      node)
                     (t
                      (if (funcall order (%treap-key node) (%treap-key treap))
                          (setf (%treap-left treap)
                                (recur (%treap-left treap)))
                          (setf (%treap-right treap)
                                (recur (%treap-right treap))))
                      treap))))
      (recur treap))))

(defmacro treap-push (obj treap)
  "Pushes OBJ to TREAP."
  `(setf ,treap (treap-insert ,obj ,treap)))

(defmacro treap-pop (obj treap)
  "Pops OBJ from TREAP"
  `(setf ,treap (treap-delete ,obj ,treap)))

;; It takes O(nlog(n)).
(defun treap (order &rest keys)
  (loop with res = nil
        for key in keys
        do (setf res (treap-insert key res :order order))
        finally (return res)))

(defun treap-merge (left right)
  "Destructively concatenates two treaps. Assumes that all keys of LEFT are
smaller (or larger, depending on the order) than those of RIGHT.

Note that this `merge' is different from CL:MERGE and rather close to
CL:CONCATENATE. (TREAP-UNITE is the analogue of the former.)"
  (declare #.OPT
           ((or null treap) left right))
  (cond ((null left) right)
        ((null right) left)
        ((> (%treap-priority left) (%treap-priority right))
         (setf (%treap-right left)
               (treap-merge (%treap-right left) right))
         left)
        (t
         (setf (%treap-left right)
               (treap-merge left (%treap-left right)))
         right)))

(declaim (inline treap-delete))
(defun treap-delete (key treap &key (order #'<))
  "Destructively deletes the KEY in TREAP and returns the resultant treap."
  (declare ((or null treap) treap))
  (labels ((recur (treap)
             (cond ((null treap) nil)
                   ((funcall order key (%treap-key treap))
                    (setf (%treap-left treap) (recur (%treap-left treap)))
                    treap)
                   ((funcall order (%treap-key treap) key)
                    (setf (%treap-right treap) (recur (%treap-right treap)))
                    treap)
                   (t
                    (treap-merge (%treap-left treap) (%treap-right treap))))))
    (declare (ftype (function * (values (or null treap) &optional)) recur))
    (recur treap)))

(declaim (inline treap-map))
(defun treap-map (function treap)
  "Successively applies FUNCTION to TREAP[0], ..., TREAP[SIZE-1]. FUNCTION must
take one argument."
  (declare (function function))
  (labels ((recur (treap)
             (when treap
               (recur (%treap-left treap))
               (funcall function (%treap-key treap))
               (recur (%treap-right treap)))))
    (recur treap)))

(defmethod print-object ((object treap) stream)
  (print-unreadable-object (object stream :type t)
    (let ((init t))
      (treap-map (lambda (key)
                   (if init
                       (setq init nil)
                       (write-char #\  stream))
                   (write key :stream stream))
                 object))))

(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)))

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

(defun main ()
  (declare #.OPT
           (inline sort))
  (let* ((*read-default-float-format* 'double-float)
         (n (read))
         (r (round (* 1000 (the double-float (read-simple-float)))))
         (2r (* 2 r))
         ;; (x y . :add | :delete)
         (queries (make-array (* 2 n) :element-type 'list)))
    (declare (int32 n r 2r))
    (dotimes (i n)
      (let ((x (round (* 1000 (the double-float (read-simple-float)))))
            (y (round (* 1000 (the double-float (read-simple-float))))))
        (declare (int32 x y))
        (setf (aref queries i) (list* x y :add)
              (aref queries (+ i n)) (list* x (+ y 2r) :delete))))
    (setq queries (sort queries (lambda (p1 p2)
                                  (< (the fixnum (second p1))
                                     (the fixnum (second p2))))))
    (let ((treap nil)
          (size 0)
          (res 0))
      (declare (uint32 res size))
      (loop for (x y . op) of-type (int32 int32 . symbol) across queries
            when (eql op :add)
            do (let ((key (treap-bisect-left (- x 2r) treap)))
                 (when (or (null key)
                           (<= (+ x 2r) key))
                   (incf res))
                 (treap-push x treap)
                 (incf size))
            else
            do (treap-pop x treap)
               (decf size))
      (println res))))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun io-equal (in-string out-string &key (function #'main) (test #'equal))
  "Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true if
the string output to *STANDARD-OUTPUT* is equal to OUT-STRING."
  (labels ((ensure-last-lf (s)
             (if (eql (uiop:last-char s) #\Linefeed)
                 s
                 (uiop:strcat s uiop:+lf+))))
    (funcall test
             (ensure-last-lf out-string)
             (with-output-to-string (out)
               (let ((*standard-output* out))
                 (with-input-from-string (*standard-input* (ensure-last-lf in-string))
                   (funcall function)))))))

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)))

#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))

#+swank
(defun run (&optional thing (out *standard-output*))
  "THING := null | string | symbol | pathname

null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
  (let ((*standard-output* out))
    (etypecase thing
      (null
       (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
         (main)))
      (string
       (with-input-from-string (*standard-input* (delete #\Return thing))
         (main)))
      (symbol (5am:run! thing))
      (pathname
       (with-open-file (*standard-input* thing)
         (main))))))

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

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "5 3.000
1.000 0.000
0.000 0.000
-1.000 0.000
10.000 0.000
-10.000 0.000
"
    "3
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "12 1.234
0.500 0.000
-0.500 0.000
0.000 0.000
0.000 -0.500
55.500 55.000
-55.500 55.000
55.000 55.000
55.000 -55.500
99.500 99.000
-99.500 99.000
99.000 99.000
99.000 -99.500
"
    "7
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "5 99.999
0.000 0.000
49.999 0.001
0.000 0.000
-49.999 -0.001
0.000 0.000
"
    "1
")))

提出情報

ジャッジ結果