(in-package :cl-user)
(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)) `(values ,(read s nil nil t)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(macrolet ((def-int (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (defs (&rest bits) `(progn ,@(mapcar (lambda (b) `(def-int ,b)) bits))))
  (defs 2 4 7 8 15 16 31 32 62 63 64))

(defconstant +mod+ 1000000007)

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

;; BEGIN_INSERTED_CONTENTS
;;;
;;; 2D range tree with fractional cascading
;;;
;;; build: O(nlog(n))
;;; query: O(log(n))
;;;
;;; Reference:
;;; Mark de Berg et al., Computational Geometry: Algorithms and Applications, 3rd Edition
;;;

(defpackage :cp/range-tree-fc
  (:use :cl)
  (:export #:make-range-tree #:rt-count #:rt-query #:rt-map))
(in-package :cp/range-tree-fc)

;; TODO: introduce abelian group

(defstruct (ynode (:constructor make-ynode (xkeys ykeys lpointers rpointers values cumuls))
                  (:conc-name %ynode-)
                  (:copier nil))
  (xkeys nil :type (simple-array fixnum (*)))
  (ykeys nil :type (simple-array fixnum (*)))
  (lpointers nil :type (or null (simple-array (integer 0 #.most-positive-fixnum) (*))))
  (rpointers nil :type (or null (simple-array (integer 0 #.most-positive-fixnum) (*))))
  (values nil :type (simple-array fixnum (*)))
  (cumuls nil :type (or null (simple-array fixnum (*)))))

(defstruct (xnode (:constructor make-xnode (xkey ynode left right))
                  (:conc-name %xnode-)
                  (:copier nil))
  (xkey 0 :type fixnum)
  (ynode nil :type ynode)
  (left nil :type (or null xnode))
  (right nil :type (or null xnode)))

(defun %ynode-merge (ynode1 ynode2)
  "Merges two YNODEs non-destructively in O(n)."
  (declare (optimize (speed 3)))
  (let* ((xkeys1 (%ynode-xkeys ynode1))
         (ykeys1 (%ynode-ykeys ynode1))
         (xkeys2 (%ynode-xkeys ynode2))
         (ykeys2 (%ynode-ykeys ynode2))
         (values1 (%ynode-values ynode1))
         (values2 (%ynode-values ynode2))
         (len1 (length xkeys1))
         (len2 (length xkeys2))
         (new-len (+ len1 len2))
         (new-xkeys (make-array new-len :element-type 'fixnum))
         (new-ykeys (make-array new-len :element-type 'fixnum))
         (new-values (make-array new-len :element-type 'fixnum))
         (new-cumuls (make-array (+ new-len 1) :element-type 'fixnum :initial-element 0))
         (lpointers (make-array (+ 1 new-len)
                                :element-type '(integer 0 #.most-positive-fixnum)))
         (rpointers (make-array (+ 1 new-len)
                                :element-type '(integer 0 #.most-positive-fixnum)))
         
         (new-pos 0)
         (pos1 0)
         (pos2 0))
    (declare ((integer 0 #.most-positive-fixnum) len1 len2 new-len new-pos pos1 pos2))
    ;; merge two vectors
    (loop
      (when (= pos1 len1)
        (loop
          for i from pos2 below len2
          do (setf (aref new-xkeys new-pos) (aref xkeys2 i)
                   (aref new-ykeys new-pos) (aref ykeys2 i)
                   (aref new-values new-pos) (aref values2 i)
                   (aref lpointers new-pos) pos1
                   (aref rpointers new-pos) i)
             (incf new-pos))
        (return))
      (when (= pos2 len2)
        (loop
          for i from pos1 below len1
          do (setf (aref new-xkeys new-pos) (aref xkeys1 i)
                   (aref new-ykeys new-pos) (aref ykeys1 i)
                   (aref new-values new-pos) (aref values1 i)
                   (aref lpointers new-pos) i
                   (aref rpointers new-pos) pos2)
             (incf new-pos))
        (return))
      (if (or (< (aref ykeys1 pos1) (aref ykeys2 pos2))
              (and (= (aref ykeys1 pos1) (aref ykeys2 pos2))
                   (< (aref xkeys1 pos1) (aref xkeys2 pos2))))
          (setf (aref new-xkeys new-pos) (aref xkeys1 pos1)
                (aref new-ykeys new-pos) (aref ykeys1 pos1)
                (aref new-values new-pos) (aref values1 pos1)
                (aref lpointers new-pos) pos1
                (aref rpointers new-pos) pos2
                pos1 (+ pos1 1))
          (setf (aref new-xkeys new-pos) (aref xkeys2 pos2)
                (aref new-ykeys new-pos) (aref ykeys2 pos2)
                (aref new-values new-pos) (aref values2 pos2)
                (aref lpointers new-pos) pos1
                (aref rpointers new-pos) pos2
                pos2 (+ pos2 1)))
      (incf new-pos))
    (dotimes (i new-len)
      (setf (aref new-cumuls (+ i 1))
            (+ (aref new-cumuls i) (aref new-values i))))
    (setf (aref lpointers new-len) len1
          (aref rpointers new-len) len2)
    (make-ynode new-xkeys new-ykeys lpointers rpointers new-values new-cumuls)))

(declaim (inline make-range-tree))
(defun make-range-tree (points &key (xkey #'car) (ykey #'cdr) value-key)
  "points := vector of points

Makes a range tree from the points. These points must be sorted
w.r.t. lexicographical order and must not contain duplicate points. (Duplicate
coordinates are allowed.) E.g. (-1, 3), (-1, 4), (-1, 7) (0, 1) (0, 3) (2,
-1) (2, 1))."
  (declare (vector points))
  (when (zerop (length points))
    (return-from make-range-tree nil))
  (let ((pointers-for-leaf
          (make-array 2
                      :element-type '(integer 0 #.most-positive-fixnum)
                      :initial-element 0)))
    (labels
        ((build (l r)
           (declare ((integer 0 #.most-positive-fixnum) l r))
           (if (= (- r l) 1)
               (let* ((point (aref points l))
                      (x (funcall xkey point))
                      (y (funcall ykey point))
                      (value (if value-key (funcall value-key point) 0))
                      (xkeys (make-array 1 :element-type 'fixnum :initial-element x))
                      (ykeys (make-array 1 :element-type 'fixnum :initial-element y))
                      (values (make-array 1 :element-type 'fixnum :initial-element value))
                      (cumuls (make-array 2 :element-type 'fixnum :initial-element 0)))
                 (setf (aref cumuls 1) value)
                 (make-xnode x (make-ynode xkeys ykeys
                                           pointers-for-leaf
                                           pointers-for-leaf
                                           values cumuls)
                             nil nil))
               (let* ((mid (ash (+ l r) -1))
                      (left (build l mid))
                      (right (build mid r)))
                 (make-xnode (funcall xkey (aref points mid))
                             (%ynode-merge (%xnode-ynode left)
                                           (%xnode-ynode right))
                             left right)))))
      (build 0 (length points)))))

(defconstant +neg-inf+ most-negative-fixnum)
(defconstant +pos-inf+ most-positive-fixnum)

(declaim (inline xleaf-p))
(defun xleaf-p (xnode)
  (and (null (%xnode-left xnode)) (null (%xnode-right xnode))))

(defun rt-count (range-tree x1 y1 x2 y2)
  "Returns the number of the nodes within the rectangle [x1, x2)*[y1, y2). A
part or all of these coordinates can be NIL; then they are regarded as the
negative or positive infinity."
  (declare (optimize (speed 3))
           ((or null fixnum) x1 y1 x2 y2))
  (setq x1 (or x1 +neg-inf+)
        x2 (or x2 +pos-inf+)
        y1 (or y1 +neg-inf+)
        y2 (or y2 +pos-inf+))
  (unless range-tree
    (return-from rt-count 0))
  (let* ((ynode (%xnode-ynode range-tree))
         (xkeys (%ynode-xkeys ynode))
         (ykeys (%ynode-ykeys ynode)))
    (labels ((bisect-left (y)
               (declare (fixnum y))
               (let ((left 0)
                     (ok (length xkeys)))
                 (declare ((integer 0 #.most-positive-fixnum) left ok))
                 (loop
                   (let ((mid (ash (+ left ok) -1)))
                     (if (= mid left)
                         (if (< (aref ykeys left) y)
                             (return ok)
                             (return left))
                         (if (< (aref ykeys mid) y)
                             (setq left mid)
                             (setq ok mid)))))))
             (recur (xnode x1 x2 start end)
               (declare ((or null xnode) xnode)
                        (fixnum x1 x2)
                        ;; KLUDGE: declaring ftype is not sufficient for the
                        ;; optimization on SBCL 1.1.14.
                        #+sbcl (values (integer 0 #.most-positive-fixnum)))
               (cond ((null xnode) 0)
                     ((and (= x1 +neg-inf+) (= x2 +pos-inf+))
                      (- end start))
                     (t
                      (let* ((xkey (%xnode-xkey xnode))
                             (ynode (%xnode-ynode xnode))
                             (lpointers (%ynode-lpointers ynode))
                             (rpointers (%ynode-rpointers ynode)))
                        (if (<= x1 xkey)
                            (if (< xkey x2)
                                ;; XKEY is in [X1, X2)
                                (if (xleaf-p xnode)
                                    (- end start)
                                    (+ (recur (%xnode-left xnode)
                                              x1 +pos-inf+
                                              (aref lpointers start)
                                              (aref lpointers end))
                                       (recur (%xnode-right xnode)
                                              +neg-inf+ x2
                                              (aref rpointers start)
                                              (aref rpointers end))))
                                ;; XKEY is in [X2, +inf)
                                (recur (%xnode-left xnode)
                                       x1 x2
                                       (aref lpointers start)
                                       (aref lpointers end)))
                            ;; XKEY is in (-inf, X1)
                            (recur (%xnode-right xnode)
                                   x1 x2
                                   (aref rpointers start)
                                   (aref rpointers end))))))))
      (let ((start (bisect-left y1))
            (end (bisect-left y2)))
        (recur range-tree x1 x2 start end)))))

(defun rt-query (range-tree x1 y1 x2 y2)
  "Returns the sum of the values within the rectangle [x1, x2)*[y1, y2). A
part or all of these coordinates can be NIL; then they are regarded as the
negative or positive infinity."
  (declare (optimize (speed 3))
           ((or null fixnum) x1 y1 x2 y2))
  (setq x1 (or x1 +neg-inf+)
        x2 (or x2 +pos-inf+)
        y1 (or y1 +neg-inf+)
        y2 (or y2 +pos-inf+))
  (unless range-tree
    (return-from rt-query 0))
  (let* ((ynode (%xnode-ynode range-tree))
         (xkeys (%ynode-xkeys ynode))
         (ykeys (%ynode-ykeys ynode)))
    (labels ((bisect-left (y)
               (declare (fixnum y))
               (let ((left 0)
                     (ok (length xkeys)))
                 (declare ((integer 0 #.most-positive-fixnum) left ok))
                 (loop
                   (let ((mid (ash (+ left ok) -1)))
                     (if (= mid left)
                         (if (< (aref ykeys left) y)
                             (return ok)
                             (return left))
                         (if (< (aref ykeys mid) y)
                             (setq left mid)
                             (setq ok mid)))))))
             (recur (xnode x1 x2 start end)
               (declare ((or null xnode) xnode)
                        (fixnum x1 x2)
                        ;; KLUDGE: declaring ftype is not sufficient for the
                        ;; optimization on SBCL 1.1.14.
                        #+sbcl (values fixnum))
               (if (null xnode)
                   0
                   (let* ((xkey (%xnode-xkey xnode))
                          (ynode (%xnode-ynode xnode))
                          (cumuls (%ynode-cumuls ynode))
                          (lpointers (%ynode-lpointers ynode))
                          (rpointers (%ynode-rpointers ynode)))
                     (if (and (= x1 +neg-inf+) (= x2 +pos-inf+))
                         (- (aref cumuls end) (aref cumuls start))
                         (if (<= x1 xkey)
                             (if (< xkey x2)
                                 ;; XKEY is in [X1, X2)
                                 (if (xleaf-p xnode)
                                     (- (aref cumuls end) (aref cumuls start))
                                     (+ (recur (%xnode-left xnode)
                                               x1 +pos-inf+
                                               (aref lpointers start)
                                               (aref lpointers end))
                                        (recur (%xnode-right xnode)
                                               +neg-inf+ x2
                                               (aref rpointers start)
                                               (aref rpointers end))))
                                 ;; XKEY is in [X2, +inf)
                                 (recur (%xnode-left xnode)
                                        x1 x2
                                        (aref lpointers start)
                                        (aref lpointers end)))
                             ;; XKEY is in (-inf, X1)
                             (recur (%xnode-right xnode)
                                    x1 x2
                                    (aref rpointers start)
                                    (aref rpointers end))))))))
      (let ((start (bisect-left y1))
            (end (bisect-left y2)))
        (recur range-tree x1 x2 start end)))))

;; not tested
(defun rt-map (function range-tree x1 y1 x2 y2)
  "Applies FUNCTION to all the points within the rectangle [x1, x2)*[y1, y2)."
  (declare (optimize (speed 3))
           ((or null fixnum) x1 y1 x2 y2)
           (function function))
  (setq x1 (or x1 +neg-inf+)
        x2 (or x2 +pos-inf+)
        y1 (or y1 +neg-inf+)
        y2 (or y2 +pos-inf+))
  (when range-tree
    (let* ((ynode (%xnode-ynode range-tree))
           (xkeys (%ynode-xkeys ynode))
           (ykeys (%ynode-ykeys ynode)))
      (labels ((bisect-left (y)
                 (declare (fixnum y))
                 (let ((left 0)
                       (ok (length xkeys)))
                   (declare ((integer 0 #.most-positive-fixnum) left ok))
                   (loop
                     (let ((mid (ash (+ left ok) -1)))
                       (if (= mid left)
                           (if (< (aref ykeys left) y)
                               (return ok)
                               (return left))
                           (if (< (aref ykeys mid) y)
                               (setq left mid)
                               (setq ok mid)))))))
               (recur (xnode x1 x2 start end)
                 (declare ((or null xnode) xnode)
                          (fixnum x1 x2))
                 (cond ((null xnode))
                       ((and (= x1 +neg-inf+) (= x2 +pos-inf+))
                        (loop with ynode = (%xnode-ynode xnode)
                              with xkeys = (%ynode-xkeys ynode)
                              with ykeys = (%ynode-ykeys ynode)
                              for i from start below end
                              for x = (aref xkeys i)
                              for y = (aref ykeys i)
                              do (funcall function x y)))
                       (t
                        (let* ((xkey (%xnode-xkey xnode))
                               (ynode (%xnode-ynode xnode))
                               (lpointers (%ynode-lpointers ynode))
                               (rpointers (%ynode-rpointers ynode)))
                          (if (<= x1 xkey)
                              (if (< xkey x2)
                                  ;; XKEY is in [X1, X2)
                                  (if (xleaf-p xnode)
                                      (loop with ynode = (%xnode-ynode xnode)
                                            with xkeys = (%ynode-xkeys ynode)
                                            with ykeys = (%ynode-ykeys ynode)
                                            for i from start below end
                                            for x = (aref xkeys i)
                                            for y = (aref ykeys i)
                                            do (funcall function x y))
                                      (progn
                                        (recur (%xnode-left xnode)
                                               x1 +pos-inf+
                                               (aref lpointers start)
                                               (aref lpointers end))
                                        (recur (%xnode-right xnode)
                                               +neg-inf+ x2
                                               (aref rpointers start)
                                               (aref rpointers end))))
                                  ;; XKEY is in [X2, +inf)
                                  (recur (%xnode-left xnode)
                                         x1 x2
                                         (aref lpointers start)
                                         (aref lpointers end)))
                              ;; XKEY is in (-inf, X1)
                              (recur (%xnode-right xnode)
                                     x1 x2
                                     (aref rpointers start)
                                     (aref rpointers end))))))))
        (let ((start (bisect-left y1))
              (end (bisect-left y2)))
          (recur range-tree x1 x2 start end))))))

(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/bisect
  (:use :cl)
  (:export #:bisect-left #:bisect-right))
(in-package :cp/bisect)

(declaim (inline bisect-left))
(defun bisect-left (target value &key (start 0) end (order #'<) (key #'identity))
  "TARGET := vector | function (taking an integer argument)
ORDER := strict order

Analogue of lower_bound() of C++ or bisect_left() of Python: Returns the
smallest index (or input) i that fulfills TARGET[i] >= VALUE, where '>=' is the
complement of ORDER. In other words, this function returns the leftmost index at
which VALUE can be inserted with keeping the order. Therefore, TARGET must be
monotonically non-decreasing with respect to ORDER.

- This function returns END if VALUE exceeds TARGET[END-1]. 
- The range [START, END) is half-open.
- END must be explicitly specified if TARGET is function.
- KEY is applied to each element of TARGET before comparison."
  (declare (function key order)
           (integer start)
           ((or null integer) end))
  (macrolet
      ((frob (accessor &optional declaration)
         `(labels
              ((%bisect-left (ng ok)
                 ;; TARGET[OK] >= VALUE always holds (assuming
                 ;; TARGET[END] = +infinity)
                 ,@(when declaration (list declaration))
                 (if (<= (- ok ng) 1)
                     ok
                     (let ((mid (ash (+ ng ok) -1)))
                       (if (funcall order (funcall key (,accessor target mid)) value)
                           (%bisect-left mid ok)
                           (%bisect-left ng mid))))))
            (assert (<= start end))
            (%bisect-left (- start 1) end))))
    (etypecase target
      (vector
       (let ((end (or end (length target))))
         (frob aref (declare ((integer -1 (#.most-positive-fixnum)) ng ok)))))
      (function
       (assert end () "Requires END argument if TARGET is a function.")
       (frob funcall)))))

(declaim (inline bisect-right))
(defun bisect-right (target value &key (start 0) end (order #'<) (key #'identity))
  "TARGET := vector | function (taking an integer argument)
ORDER := strict order

Analogue of upper_bound() of C++ or bisect_right() of Python: Returns the
smallest index (or input) i that fulfills TARGET[i] > VALUE. In other words,
this function returns the rightmost index at which VALUE can be inserted with
keeping the order. Therefore, TARGET must be monotonically non-decreasing with
respect to ORDER.

- This function returns END if VALUE >= TARGET[END-1].
- The range [START, END) is half-open.
- END must be explicitly specified if TARGET is function.
- KEY is applied to each element of TARGET before comparison."
  (declare (function key order)
           (integer start)
           ((or null integer) end))
  (macrolet
      ((frob (accessor &optional declaration)
         `(labels
              ((%bisect-right (ng ok)
                 ;; TARGET[OK] > VALUE always holds (assuming
                 ;; TARGET[END] = +infinity)
                 ,@(when declaration (list declaration))
                 (if (<= (- ok ng) 1)
                     ok
                     (let ((mid (ash (+ ng ok) -1)))
                       (if (funcall order value (funcall key (,accessor target mid)))
                           (%bisect-right ng mid)
                           (%bisect-right mid ok))))))
            (assert (<= start end))
            (%bisect-right (- start 1) end))))
    (etypecase target
      (vector
       (let ((end (or end (length target))))
         (frob aref (declare ((integer -1 (#.array-total-size-limit)) ng ok)))))
      (function
       (assert end () "Requires END argument if TARGET is a function.")
       (frob funcall)))))

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

;; TODO: abstraction

(defpackage :cp/ref-able-treap
  (:use :cl)
  (:export #:treap #:treap-count #:treap-find #:treap-position #:treap-bisect-left
           #:treap-split #:treap-insert #:treap-push #:treap-pop #:make-treap
           #:treap-delete #:treap-merge #:treap-map #:invalid-treap-index-error
           #:treap-ref #:treap-first #:treap-last #:treap-unite #:treap-reverse))
(in-package :cp/ref-able-treap)

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

(declaim (inline treap-count))
(defun treap-count (treap)
  "Returns the size of the (nullable) TREAP."
  (declare ((or null treap) treap))
  (if (null treap)
      0
      (%treap-count treap)))

(declaim (inline update-count))
(defun update-count (treap)
  (declare (treap treap))
  (setf (%treap-count treap)
        (+ 1
           (treap-count (%treap-left treap))
           (treap-count (%treap-right treap)))))

(declaim (inline treap-find))
(defun treap-find (key treap &key (order #'<))
  "Returns KEY if TREAP contains it, otherwise NIL.

An element in TREAP is considered to be equal to KEY iff (and (not (funcall
order key <element>)) (not (funcall order <element> key))) is true."
  (declare ((or null treap) treap))
  (labels ((recur (treap)
             (cond ((null treap) nil)
                   ((funcall order key (%treap-key treap))
                    (recur (%treap-left treap)))
                   ((funcall order (%treap-key treap) key)
                    (recur (%treap-right treap)))
                   (t key))))
    (recur treap)))

(declaim (inline treap-position))
(defun treap-position (key treap &key (order #'<))
  "Returns the index if TREAP contains KEY, otherwise NIL.

An element in TREAP is considered to be equal to KEY iff (and (not (funcall
order key <element>)) (not (funcall order <element> key))) is true."
  (declare ((or null treap) treap))
  (labels ((recur (count treap)
             (declare ((integer 0 #.most-positive-fixnum) count))
             (cond ((null treap) nil)
                   ((funcall order (%treap-key treap) key)
                    (recur count (%treap-right treap)))
                   ((funcall order key (%treap-key treap))
                    (let ((left-count (- count (treap-count (%treap-right treap)) 1)))
                      (recur left-count (%treap-left treap))))
                   (t (- count (treap-count (%treap-right treap)) 1)))))
    (recur (treap-count treap) treap)))

(declaim (inline treap-bisect-left)
         (ftype (function * (values (integer 0 #.most-positive-fixnum) t &optional)) treap-bisect-left))
(defun treap-bisect-left (value treap &key (order #'<))
  "Returns two values: the smallest index and the corresponding key that
satisfies TREAP[index] >= VALUE. Returns the size of TREAP and VALUE instead if
TREAP[size-1] < VALUE."
  (labels ((recur (count treap)
             (declare ((integer 0 #.most-positive-fixnum) count))
             (cond ((null treap) (values nil nil))
                   ((funcall order (%treap-key treap) value)
                    (recur count (%treap-right treap)))
                   (t (let ((left-count (- count (treap-count (%treap-right treap)) 1)))
                        (multiple-value-bind (idx key)
                            (recur left-count (%treap-left treap))
                          (if idx
                              (values idx key)
                              (values left-count (%treap-key treap)))))))))
    (declare (ftype (function * (values t t &optional)) recur))
    (multiple-value-bind (idx key)
        (recur (treap-count treap) treap)
      (if idx
          (values idx key)
          (values (treap-count treap) value)))))

(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 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)
                      (update-count treap)
                      (values treap right)))
                   (t
                    (multiple-value-bind (left right) (recur (%treap-left treap))
                      (setf (%treap-left treap) right)
                      (update-count treap)
                      (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))
                      (update-count node)
                      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))))
                      (update-count treap)
                      treap))))
      (recur treap))))

(defmacro treap-push (key treap order)
  "Pushes KEY to TREAP."
  `(setf ,treap (treap-insert ,key ,treap :order ,order)))

(defmacro treap-pop (key treap order)
  "Deletes KEY from TREAP."
  `(setf ,treap (treap-delete ,key ,treap :order ,order)))

;; NOTE: 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)))

;; Reference: https://cp-algorithms.com/data_structures/treap.html
(declaim (inline make-treap))
(defun make-treap (sorted-vector)
  "Makes a treap from the given SORTED-VECTOR in O(n) time. Note that this
function doesn't check if the SORTED-VECTOR is actually sorted w.r.t. your
intended order. The consequence is undefined when a non-sorted vector is
given."
  (declare (vector sorted-vector))
  (labels ((heapify (top)
             (when top
               (let ((prioritized-node top))
                 (when (and (%treap-left top)
                            (> (%treap-priority (%treap-left top))
                               (%treap-priority prioritized-node)))
                   (setq prioritized-node (%treap-left top)))
                 (when (and (%treap-right top)
                            (> (%treap-priority (%treap-right top))
                               (%treap-priority prioritized-node)))
                   (setq prioritized-node (%treap-right top)))
                 (unless (eql prioritized-node top)
                   (rotatef (%treap-priority prioritized-node)
                            (%treap-priority top))
                   (heapify prioritized-node)))))
           (build (l r)
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (if (= l r)
                 nil
                 (let* ((mid (ash (+ l r) -1))
                        (node (%make-treap (aref sorted-vector mid)
                                           (random most-positive-fixnum))))
                   (setf (%treap-left node) (build l mid))
                   (setf (%treap-right node) (build (+ mid 1) r))
                   (heapify node)
                   (update-count node)
                   node))))
    (build 0 (length sorted-vector))))

(declaim (ftype (function * (values (or null treap) &optional)) treap-merge))
(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 (optimize (speed 3))
           ((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))
         (update-count left)
         left)
        (t
         (setf (%treap-left right)
               (treap-merge left (%treap-left right)))
         (update-count right)
         right)))

(declaim (inline treap-delete))
(defun treap-delete (key treap &key (order #'<))
  "Destructively deletes 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)))
                    (update-count treap)
                    treap)
                   ((funcall order (%treap-key treap) key)
                    (setf (%treap-right treap) (recur (%treap-right treap)))
                    (update-count 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))))

(define-condition invalid-treap-index-error (type-error)
  ((treap :initarg :treap :reader invalid-treap-index-error-treap)
   (index :initarg :index :reader invalid-treap-index-error-index))
  (:report
   (lambda (condition stream)
     (format stream "Invalid index ~W for treap ~W."
             (invalid-treap-index-error-index condition)
             (invalid-treap-index-error-treap condition)))))

(defun treap-ref (treap index)
  "Returns the INDEX-th element of TREAP."
  (declare (optimize (speed 3))
           ((or null treap) treap)
           ((integer 0 #.most-positive-fixnum) index))
  (when (>= index (treap-count treap))
    (error 'invalid-treap-index-error :treap treap :index index))
  (labels ((%ref (treap index)
             (declare (optimize (speed 3) (safety 0))
                      ((integer 0 #.most-positive-fixnum) index))
             (let ((left-count (treap-count (%treap-left treap))))
               (cond ((< index left-count)
                      (%ref (%treap-left treap) index))
                     ((> index left-count)
                      (%ref (%treap-right treap) (- index left-count 1)))
                     (t (%treap-key treap))))))
    (%ref treap index)))

(defun treap-first (treap)
  (declare (optimize (speed 3))
           (treap treap))
  (if (%treap-left treap)
      (treap-first (%treap-left treap))
      (%treap-key treap)))

(defun treap-last (treap)
  (declare (optimize (speed 3))
           (treap treap))
  (if (%treap-right treap)
      (treap-last (%treap-right treap))
      (%treap-key treap)))

(declaim (inline treap-unite))
(defun treap-unite (treap1 treap2 &key (order #'<))
  "Merges two treaps with keeping the order."
  (labels
      ((recur (l r)
         (cond ((null l) r)
               ((null r) l)
               (t (when (< (%treap-priority l) (%treap-priority r))
                    (rotatef l r))
                  (multiple-value-bind (lchild rchild)
                      ;; FIXME: To omit duplicate keys, this TREAP-SPLIT should
                      ;; be replaced by something like TREAP-EXCLUSIVE-SPLIT.
                      (treap-split (%treap-key l) r :order order)
                    (setf (%treap-left l) (recur (%treap-left l) lchild)
                          (%treap-right l) (recur (%treap-right l) rchild))
                    (update-count l)
                    l)))))
    (recur treap1 treap2)))

(declaim (inline treap-reverse))
(defun treap-reverse (treap)
  "Destructively reverses the order of the whole treap."
  (labels ((recur (treap)
             (when treap
               (let ((left (recur (%treap-left treap)))
                     (right (recur (%treap-right treap))))
                 (setf (%treap-left treap) right
                       (%treap-right treap) left)
                 treap))))
    (recur treap)))

;;;
;;; Disjoint set (union by size & path compression)
;;;

(defpackage :cp/disjoint-set
  (:use :cl)
  (:export #:disjoint-set #:make-disjoint-set #:ds-data
           #:ds-root #:ds-unite! #:ds-connected-p #:ds-size))
(in-package :cp/disjoint-set)

(defstruct (disjoint-set
            (:constructor make-disjoint-set
                (size &aux (data (make-array size :element-type 'fixnum :initial-element -1))))
            (:conc-name ds-)
            (:predicate nil)
            (:copier nil))
  (data nil :type (simple-array fixnum (*))))

(declaim (inline ds-root))
(defun ds-root (disjoint-set x)
  "Returns the root of X."
  (declare ((mod #.array-total-size-limit) x))
  (let ((data (ds-data disjoint-set)))
    (labels ((recur (x)
               (if (< (aref data x) 0)
                   x
                   (setf (aref data x)
                         (recur (aref data x))))))
      (recur x))))

(declaim (inline ds-unite!))
(defun ds-unite! (disjoint-set x1 x2)
  "Destructively unites X1 and X2 and returns true iff X1 and X2 become
connected for the first time."
  (let ((root1 (ds-root disjoint-set x1))
        (root2 (ds-root disjoint-set x2)))
    (unless (= root1 root2)
      (let ((data (ds-data disjoint-set)))
        ;; NOTE: If you want X1 to always be root, just delete this form. (Time
        ;; complexity becomes worse, however.)
        (when (> (aref data root1) (aref data root2))
          (rotatef root1 root2))
        (incf (aref data root1) (aref data root2))
        (setf (aref data root2) root1)))))

(declaim (inline ds-connected-p))
(defun ds-connected-p (disjoint-set x1 x2)
  "Returns true iff X1 and X2 have the same root."
  (= (ds-root disjoint-set x1) (ds-root disjoint-set x2)))

(declaim (inline ds-size))
(defun ds-size (disjoint-set x)
  "Returns the size of the connected component to which X belongs."
  (- (aref (ds-data disjoint-set)
           (ds-root disjoint-set x))))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/disjoint-set :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/ref-able-treap :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/bisect :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/range-tree-fc :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (let* ((n (read))
         (xs (make-array n :element-type 'uint31 :initial-element 0))
         (ys (make-array n :element-type 'uint31 :initial-element 0))
         (points (make-array n :element-type 'list :initial-element nil))
         (points-xsorted (make-array n :element-type 'list :initial-element nil))
         (points-ysorted (make-array n :element-type 'list :initial-element nil))
         (dset (make-disjoint-set n)))
    (dotimes (i n)
      (let ((x (- (read-fixnum) 1))
            (y (- (read-fixnum) 1)))
        (setf (aref points i) (cons x y)
              (aref points-xsorted i) (list x y i)
              (aref points-ysorted i) (list x y i)
              (aref xs i) x
              (aref ys i) y)))
    (setq points-xsorted (sort points-xsorted #'< :key #'first))
    (setq points-ysorted (sort points-ysorted #'< :key #'second))
    (let (treap)
      (loop for x1 from 0 below n
            for (_ y1 i1) = (aref points-xsorted x1)
            do (when (> x1 0)
                 (let ((index (treap-bisect-left y1 treap)))
                   (when (> index 0)
                     (let* ((y2 (treap-ref treap (- index 1)))
                            (i2 (third (aref points-ysorted y2))))
                       (ds-unite! dset i1 i2)))))
               (treap-push y1 treap #'<)))
    (let (treap)
      (loop for x1 from (- n 1) downto 0
            for (_ y1 i1) = (aref points-xsorted x1)
            do (when (< x1 (- n 1))
                 (let ((index (treap-bisect-left y1 treap)))
                   (when (< index (treap-count treap))
                     (let* ((y2 (treap-ref treap index))
                            (i2 (third (aref points-ysorted y2))))
                       (ds-unite! dset i1 i2)))))
               (treap-push y1 treap #'<)))
    (let (treap)
      (loop for y1 from 0 below n
            for (x1 _ i1) = (aref points-ysorted y1)
            do (when (> y1 0)
                 (let ((index (treap-bisect-left x1 treap)))
                   (when (> index 0)
                     (let* ((x2 (treap-ref treap (- index 1)))
                            (i2 (third (aref points-xsorted x2))))
                       (ds-unite! dset i1 i2)))))
               (treap-push x1 treap #'<)))
    (let (treap)
      (loop for y1 from (- n 1) downto 0
            for (x1 _ i1) = (aref points-ysorted y1)
            do (when (< y1 (- n 1))
                 (let ((index (treap-bisect-left x1 treap)))
                   (when (< index (treap-count treap))
                     (let* ((x2 (treap-ref treap index))
                            (i2 (third (aref points-xsorted x2))))
                       (ds-unite! dset i1 i2)))))
               (treap-push x1 treap #'<)))
    (write-string
     (with-output-to-string (*standard-output* nil :element-type 'base-char)
       (dotimes (i n)
         (println (ds-size dset i)))))))

#-swank (main)

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

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)
    #+os-unix (run-program "xsel" '("-b" "-o") :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* (or out (make-string-output-stream)))
         (res (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))))))
    (if out res (get-output-stream-string *standard-output*))))

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

#-swank
(eval-when (:compile-toplevel)
  (when (and (boundp 'sb-c::*compiler-warning-count*)
             (> sb-c::*compiler-warning-count* 0))
    (sb-ext:quit :unix-status 1)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (5am:is
   (equal "1
1
2
2
"
          (run "4
1 4
2 3
3 1
4 2
" nil)))
  (5am:is
   (equal "3
3
1
1
2
3
2
"
          (run "7
6 4
4 3
3 5
7 1
2 7
5 2
1 6
" nil))))


Measured memory_bytes: 101588