Submission #6927125


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 (ql:quickload '(:cl-debug-print :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)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
;;;
;;; 2D Range tree (unfinished)
;;;
;;; build: O(nlog^2(n))
;;; query: O(log^2(n))
;;;
;;; Reference:
;;; https://www.cse.wustl.edu/~taoju/cse546/lectures/Lecture21_rangequery_2d.pdf
;;;

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

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

(declaim (inline ynode-count))
(defun ynode-count (ynode)
  "Returns the number of the elements."
  (if (null ynode)
      0
      (%ynode-count ynode)))

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

;;
;; Merging w.r.t. Y-axis in O(n) time:
;; 1. transform two trees to two pathes (with copying);
;; 2. merge the two pathes into a path (destructively);
;; 3. transform the path to a tree (destructively);
;;

(defun %ynode-to-path (ynode)
  "Returns a path that is equivalent to YNODE but in reverse order."
  (declare #.OPT
           (inline make-ynode))
  (let ((res nil))
    (labels ((recur (node)
               (when node
                 (recur (%ynode-left node))
                 (setq res (make-ynode (%ynode-ykey node) nil res))
                 (recur (%ynode-right node)))))
      (recur ynode)
      res)))

(declaim (inline %ynode-merge-path!))
(defun %ynode-merge-path! (ypath1 ypath2)
  "Destructively merges two pathes in reverse order."
  (let ((res nil))
    (macrolet ((%push (y)
                 `(let ((rest (%ynode-right ,y)))
                    (setf (%ynode-right ,y) res
                          res ,y
                          ,y rest))))
      (loop (unless ypath1
              (loop while ypath2 do (%push ypath2))
              (return))
            (unless ypath2
              (loop while ypath1 do (%push ypath1))
              (return))
            ;; I use only #'< here for abstraction in the future
            (if (< (%ynode-ykey ypath1) (%ynode-ykey ypath2))
                (%push ypath2)
                (%push ypath1)))
      res)))

(defun %path-to-ynode! (ypath length)
  "Destructively transforms a path to a balanced binary tree."
  (declare #.OPT
           ((integer 0 #.most-positive-fixnum) length))
  (let* ((max-depth (- (integer-length length) 1)))
    (macrolet ((%pop ()
                 `(let ((rest (%ynode-right ypath))
                        (first ypath))
                    (setf (%ynode-right first) nil
                          ypath rest)
                    first)))
      (labels ((build (depth)
                 (declare ((integer 0 #.most-positive-fixnum) depth))
                 (when ypath
                   (if (= depth max-depth)
                       (%pop)
                       (let ((left (build (+ 1 depth))))
                         (if (null ypath)
                             left
                             (let* ((node (%pop))
                                    (right (build (+ 1 depth))))
                               (setf (%ynode-left node) left)
                               (setf (%ynode-right node) right)
                               (ynode-update-count node)
                               node)))))))
        (build 0)))))

(declaim (inline ynode-merge))
(defun ynode-merge (ynode1 ynode2)
  "Merges two YNODEs non-destructively."
  (let* ((length (+ (ynode-count ynode1) (ynode-count ynode2))))
    (declare (fixnum length))
    (%path-to-ynode!
     (%ynode-merge-path! (%ynode-to-path ynode1)
                         (%ynode-to-path ynode2))
     length)))

(declaim (inline make-range-tree))
(defun make-range-tree (points &key (xkey #'car) (ykey #'cdr))
  (labels ((build (l r)
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (if (= (- r l) 1)
                 (let ((point (aref points l)))
                   (make-xnode (funcall xkey point)
                               (make-ynode (funcall ykey point) nil nil)
                               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 in the rectangle [x1, y1)*[x2, y2). A part or
all of these coordinates can be NIL: then they are regarded as the negative or
positive infinity."
  (declare #.OPT
           ((or null fixnum) x1 y1 x2 y2))
  (setq x1 (or x1 +neg-inf+)
        y1 (or y1 +neg-inf+)
        x2 (or x2 +pos-inf+)
        y2 (or y2 +pos-inf+))
  (labels ((xrecur (xnode x1 x2)
             (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+))
                    (yrecur (%xnode-ynode xnode) y1 y2))
                   (t
                    (let ((xkey (%xnode-xkey xnode)))
                      (if (<= x1 xkey)
                          (if (< xkey x2)
                              ;; XKEY is in [X1, X2)
                              (if (xleaf-p xnode)
                                  (yrecur (%xnode-ynode xnode) y1 y2)
                                  (+ (xrecur (%xnode-left xnode) x1 +pos-inf+)
                                     (xrecur (%xnode-right xnode) +neg-inf+ x2)))
                              ;; XKEY is in [X2, +inf)
                              (xrecur (%xnode-left xnode) x1 x2))
                          ;; XKEY is in (-inf, X1)
                          (xrecur (%xnode-right xnode) x1 x2))))))
           (yrecur (ynode y1 y2)
             (declare ((or null ynode) ynode)
                      (fixnum y1 y2)
                      #+sbcl (values (integer 0 #.most-positive-fixnum)))
             (cond ((null ynode) 0)
                   ((and (= y1 +neg-inf+) (= y2 +pos-inf+))
                    (%ynode-count ynode))
                   (t
                    (let ((key (%ynode-ykey ynode)))
                      (if (<= y1 key)
                          (if (< key y2)
                              (+ 1
                                 (yrecur (%ynode-left ynode) y1 +pos-inf+)
                                 (yrecur (%ynode-right ynode) +neg-inf+ y2))
                              (yrecur (%ynode-left ynode) y1 y2))
                          (yrecur (%ynode-right ynode) y1 y2)))))))
    ;; (declare (ftype (function * (values (integer 0 #.most-positive-fixnum) &optional)) xrecur yrecur))
    (xrecur range-tree x1 x2)))

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

;; Body
;;;
;;; Arithmetic operations with static modulus
;;;

(defmacro define-mod-operations (&optional (divisor 1000000007))
  `(progn
     (defun mod* (&rest args)
       (reduce (lambda (x y) (mod (* x y) ,divisor)) args))

     (sb-c:define-source-transform mod* (&rest args)
       (if (null args)
           1
           (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args)))

     (defun mod+ (&rest args)
       (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))

     (sb-c:define-source-transform mod+ (&rest args)
       (if (null args)
           0
           (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args)))

     (define-modify-macro incfmod (delta divisor)
       (lambda (x y divisor) (mod (+ x y) divisor)))

     (define-modify-macro decfmod (delta divisor)
       (lambda (x y divisor) (mod (- x y) divisor)))))

(define-mod-operations +mod+)

(defun main ()
  (declare #.OPT
           (inline sort)
           (muffle-conditions style-warning))
  (let* ((n (read))
         (powers (make-array 200001 :element-type 'uint32))
         (points (make-array n :element-type '(cons int32 int32)))
         (res 0))
    (declare (uint32 n)
             (uint62 res)
             ((simple-array (cons int32 int32) (*)) points)
             ((simple-array uint32 (*)) powers))
    ;; construct table of 2^n
    (setf (aref powers 0) 1)
    (loop for i from 1 below (length powers)
          do (setf (aref powers i)
                   (mod* 2 (aref powers (- i 1)))))
    (dotimes (i n)
      (setf (aref points i) (cons (read-fixnum) (read-fixnum))))
    (setf points (sort points (lambda (i j)
                                (< (the int32 (car i)) (the int32 (car j))))))
    (let ((rtree (make-range-tree points)))
      ;; L R U D
      (incfmod res (mod* (- n 4) (- (aref powers n) 1)) +mod+)
      ;; LU LD RU RD
      (dotimes (i n)
        (let* ((point (aref points i))
               (x (car point))
               (y (cdr point))
               (ld (rt-count rtree nil nil x y))
               (lu (rt-count rtree nil (+ y 1) x nil))
               (rd (rt-count rtree (+ x 1) (+ y 1) nil nil))
               (ru (rt-count rtree (+ x 1) nil nil y)))
          (declare (int32 x y))
          (incf res (+ (aref powers ld) (aref powers lu) (aref powers rd) (aref powers ru))))))
    (println (mod res +mod+))))

#-swank (main)

Submission Info

Submission Time
Task F - Enclosed Points
User sansaqua
Language Common Lisp (SBCL 1.1.14)
Score 600
Code Size 12496 Byte
Status AC
Exec Time 1801 ms
Memory 242660 KiB

Judge Result

Set Name Sample All
Score / Max Score 0 / 0 600 / 600
Status
AC × 3
AC × 26
Set Name Test Cases
Sample s1.txt, s2.txt, s3.txt
All 01.txt, 02.txt, 03.txt, 04.txt, 05.txt, 06.txt, 07.txt, 08.txt, 09.txt, 10.txt, 11.txt, 12.txt, 13.txt, 14.txt, 15.txt, 16.txt, 17.txt, 18.txt, 19.txt, 20.txt, 21.txt, 22.txt, 23.txt, s1.txt, s2.txt, s3.txt
Case Name Status Exec Time Memory
01.txt AC 354 ms 48360 KiB
02.txt AC 177 ms 35556 KiB
03.txt AC 177 ms 35556 KiB
04.txt AC 179 ms 35556 KiB
05.txt AC 176 ms 35552 KiB
06.txt AC 176 ms 35556 KiB
07.txt AC 175 ms 35556 KiB
08.txt AC 176 ms 35556 KiB
09.txt AC 179 ms 35556 KiB
10.txt AC 178 ms 35556 KiB
11.txt AC 1801 ms 242660 KiB
12.txt AC 1760 ms 240484 KiB
13.txt AC 1784 ms 240484 KiB
14.txt AC 1721 ms 242532 KiB
15.txt AC 1788 ms 240480 KiB
16.txt AC 1788 ms 240488 KiB
17.txt AC 1786 ms 240480 KiB
18.txt AC 1795 ms 240484 KiB
19.txt AC 1174 ms 240480 KiB
20.txt AC 1207 ms 240484 KiB
21.txt AC 1222 ms 240484 KiB
22.txt AC 1219 ms 240484 KiB
23.txt AC 178 ms 35556 KiB
s1.txt AC 176 ms 35556 KiB
s2.txt AC 177 ms 35424 KiB
s3.txt AC 176 ms 35556 KiB