#505399 (Common Lisp) No.674 n連勤

提出ソース

結果

問題	No.674 n連勤
ユーザー	sansaqua
提出日時	2020-07-02 10:38:26
言語	Common Lisp (sbcl 2.3.8)
結果	AC
実行時間	67 ms / 2,000 ms
コード長	14,925 bytes
コンパイル時間	1,014 ms
コンパイル使用メモリ	56,388 KB
実行使用メモリ	33,760 KB
最終ジャッジ日時	2023-10-13 00:20:56
合計ジャッジ時間	2,621 ms
ジャッジサーバーID （参考情報）	judge13 / judge11

このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示

入力	結果	実行時間実行使用メモリ
testcase_00	AC	12 ms 28,456 KB
testcase_01	AC	10 ms 25,332 KB
testcase_02	AC	11 ms 27,348 KB
testcase_03	AC	11 ms 25,292 KB
testcase_04	AC	10 ms 25,316 KB
testcase_05	AC	11 ms 25,328 KB
testcase_06	AC	11 ms 28,612 KB
testcase_07	AC	10 ms 25,380 KB
testcase_08	AC	11 ms 27,448 KB
testcase_09	AC	10 ms 25,300 KB
testcase_10	AC	11 ms 27,340 KB
testcase_11	AC	13 ms 29,268 KB
testcase_12	AC	14 ms 25,500 KB
testcase_13	AC	39 ms 29,856 KB
testcase_14	AC	40 ms 29,864 KB
testcase_15	AC	33 ms 31,976 KB
testcase_16	AC	66 ms 29,868 KB
testcase_17	AC	67 ms 29,904 KB
testcase_18	AC	56 ms 27,852 KB
testcase_19	AC	41 ms 33,760 KB

権限があれば一括ダウンロードができます

コンパイルメッセージ

; compiling file "/home/judge/data/code/Main.lisp" (written 13 OCT 2023 12:20:53 AM):
; processing (SB-INT:DEFCONSTANT-EQX OPT ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DISABLE-DEBUGGER)
; processing (DEFSTRUCT (INTERVAL-SET # ...) ...)
; processing (DECLAIM (INLINE ISET-VALUE))
; processing (DEFUN ISET-VALUE ...)
; processing (DECLAIM (INLINE FORCE-UP))
; processing (DEFUN FORCE-UP ...)
; processing (DECLAIM (INLINE ISET-MAP))
; processing (DEFUN ISET-MAP ...)
; processing (DEFMETHOD PRINT-OBJECT ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %ISET-CONCAT ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %ISET-SPLIT ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %ISET-INSERT ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN %ISET-INSERT
;     (- RKEY LKEY)
; 
; note: doing signed word to integer coercion (cost 20), for:
;       the first result of inline (signed-byte 64) arithmetic

; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %ISET-LEFTMOST-KEY ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN %ISET-RIGHTMOST-KEY ...)
; processing (DEFUN ISET-INSERT ...)
; processing (DEFMACRO ISET-PUSH ...)
; processing (DEFMACRO ISET-PUSH-POINT ...)
; processing (DEFUN ISET-DELETE ...)
; processing (DEFMACRO ISET-POP ...)
; processing (DEFMACRO ISET-POP-POINT ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN ISET-FIND ...)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (IN-PACKAGE :CL-USER)
; processing (DEFMACRO DBG ...)
; processing (DEFMACRO DEFINE-INT-TYPES ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFUN MAIN ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAIN
;     (LET* ((D (READ-FIXNUM)) (Q (READ-FIXNUM)) ISET)
;       (WRITE-STRING
;        (WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT* NIL :

ソースコード

raw source code

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

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Ordered set of half-open intervals
;;;

(defstruct (interval-set (:constructor %make-interval-set
                             (lkey rkey value lnode rnode
                              &aux (priority (random most-positive-fixnum))))
                         (:conc-name %iset-))
  "This structure maintains an ordered set of half-open intervals with a
balanced binary search tree (treap). Every fundamental operation takes expected
O(log(n)) time."
  (lkey 0 :type fixnum)
  (rkey 0 :type fixnum)
  (value 0 :type fixnum)
  (priority 0 :type fixnum)
  (lnode nil :type (or null interval-set))
  (rnode nil :type (or null interval-set)))

(declaim (inline iset-value))
(defun iset-value (iset)
  (if iset (%iset-value iset) 0))

(declaim (inline force-up))
(defun force-up (iset)
  (when iset
    (setf (%iset-value iset)
          (max (iset-value (%iset-lnode iset))
               (- (%iset-rkey iset) (%iset-lkey iset))
               (iset-value (%iset-rnode iset))))))

(declaim (inline iset-map))
(defun iset-map (function iset)
  "Applies function to each interval [L, R) in ISET in ascending order."
  (labels ((recur (node)
             (when node
               (recur (%iset-lnode node))
               (funcall function (%iset-lkey node) (%iset-rkey node))
               (recur (%iset-rnode node)))))
    (recur iset)))

(defmethod print-object ((object interval-set) stream)
  (print-unreadable-object (object stream :type t)
    (let ((init t))
      (iset-map (lambda (l r)
                  (if init
                      (setq init nil)
                      (write-char #\  stream))
                  (format stream "[~A ~A)" l r))
                object))))

(declaim (ftype (function * (values (or null interval-set) &optional)) %iset-concat))
(defun %iset-concat (left right)
  (declare (optimize (speed 3)))
  (cond ((null left) right)
        ((null right) left)
        ((> (%iset-priority left) (%iset-priority right))
         (setf (%iset-rnode left)
               (%iset-concat (%iset-rnode left) right))
         (force-up left)
         left)
        (t
         (setf (%iset-lnode right)
               (%iset-concat left (%iset-lnode right)))
         (force-up right)
         right)))

(declaim (ftype (function * (values (or null interval-set)
                                    (or null interval-set)
                                    &optional))
                %iset-split))
(defun %iset-split (iset lkey)
  (declare (optimize (speed 3))
           (fixnum lkey))
  (labels ((recur (node)
             (cond ((null node) (values nil nil))
                   ((< (%iset-lkey node) lkey)
                    (multiple-value-bind (lnode rnode)
                        (recur (%iset-rnode node))
                      (setf (%iset-rnode node) lnode)
                      (force-up node)
                      (values node rnode)))
                   (t
                    (multiple-value-bind (lnode rnode)
                        (recur (%iset-lnode node))
                      (setf (%iset-lnode node) rnode)
                      (force-up node)
                      (values lnode node))))))
    (recur iset)))

(declaim (ftype (function * (values (or null interval-set) &optional)) %iset-insert))
(defun %iset-insert (iset lkey rkey)
  (declare (optimize (speed 3))
           (fixnum lkey rkey))
  (let ((new-node (%make-interval-set lkey rkey (- rkey lkey) nil nil)))
    (labels ((recur (node)
               (cond ((null node) new-node)
                     ((> (%iset-priority new-node) (%iset-priority node))
                      (setf (values (%iset-lnode new-node) (%iset-rnode new-node))
                            (%iset-split node (%iset-lkey new-node)))
                      (force-up new-node)
                      new-node)
                     (t
                      (if (< (%iset-lkey new-node) (%iset-lkey node))
                          (setf (%iset-lnode node) (recur (%iset-lnode node)))
                          (setf (%iset-rnode node) (recur (%iset-rnode node))))
                      (force-up node)
                      node))))
      (recur iset))))

(declaim (ftype (function * (values fixnum &optional)) %iset-leftmost-key))
(defun %iset-leftmost-key (iset)
  (declare (optimize (speed 3)))
  (if (%iset-lnode iset)
      (%iset-leftmost-key (%iset-lnode iset))
      (%iset-lkey iset)))

(declaim (ftype (function * (values fixnum &optional)) %iset-rightmost-key))
(defun %iset-rightmost-key (iset)
  (declare (optimize (speed 3)))
  (if (%iset-rnode iset)
      (%iset-rightmost-key (%iset-rnode iset))
      (%iset-rkey iset)))

(defun iset-insert (iset lkey rkey)
  "Adds an interval [LKEY, RKEY) to ISET."
  (declare (optimize (speed 3))
           (fixnum lkey rkey))
  (assert (<= lkey rkey))
  (labels ((lsplit (node)
             (cond ((null node) (values nil nil))
                   ((< (%iset-rkey node) lkey)
                    (multiple-value-bind (lnode rnode)
                        (lsplit (%iset-rnode node))
                      (setf (%iset-rnode node) lnode)
                      (force-up node)
                      (values node rnode)))
                   (t
                    (multiple-value-bind (lnode rnode)
                        (lsplit (%iset-lnode node))
                      (setf (%iset-lnode node) rnode)
                      (force-up node)
                      (values lnode node)))))
           (rsplit (node)
             (cond ((null node) (values nil nil))
                   ((< rkey (%iset-lkey node))
                    (multiple-value-bind (lnode rnode)
                        (rsplit (%iset-lnode node))
                      (setf (%iset-lnode node) rnode)
                      (force-up node)
                      (values lnode node)))
                   (t
                    (multiple-value-bind (lnode rnode)
                        (rsplit (%iset-rnode node))
                      (setf (%iset-rnode node) lnode)
                      (force-up node)
                      (values node rnode))))))
    (if (= lkey rkey)
        iset
        (multiple-value-bind (left tmp) (lsplit iset)
          (multiple-value-bind (mid right) (rsplit tmp)
            (let ((base (%iset-concat left right)))
              (let ((new-lkey (if mid (min (%iset-leftmost-key mid) lkey) lkey))
                    (new-rkey (if mid (max (%iset-rightmost-key mid) rkey) rkey)))
                (declare (fixnum new-lkey new-rkey))
                (%iset-insert base new-lkey new-rkey))))))))

(defmacro iset-push (iset lkey rkey)
  "PUSH-style macro for ISET-INSERT."
  `(setf ,iset (iset-insert ,iset ,lkey ,rkey)))

(defmacro iset-push-point (iset key)
  (let ((tmp (gensym)))
    `(let ((,tmp ,key))
       (setf ,iset (iset-insert ,iset ,tmp (+ ,tmp 1))))))

(defun iset-delete (iset lkey rkey)
  "Removes an interval [LKEY, RKEY) from ISET."
  (declare (optimize (speed 3))
           (fixnum lkey rkey))
  (assert (<= lkey rkey))
  (if (= lkey rkey)
      iset
      (labels ((lsplit (node)
                 (cond ((null node) (values nil nil))
                       ((< (%iset-rkey node) lkey)
                        (multiple-value-bind (lnode rnode)
                            (lsplit (%iset-rnode node))
                          (setf (%iset-rnode node) lnode)
                          (force-up node)
                          (values node rnode)))
                       (t
                        (multiple-value-bind (lnode rnode)
                            (lsplit (%iset-lnode node))
                          (setf (%iset-lnode node) rnode)
                          (force-up node)
                          (values lnode node)))))
               (rsplit (node)
                 (cond ((null node) (values nil nil))
                       ((< rkey (%iset-lkey node))
                        (multiple-value-bind (lnode rnode)
                            (rsplit (%iset-lnode node))
                          (setf (%iset-lnode node) rnode)
                          (force-up node)
                          (values lnode node)))
                       (t
                        (multiple-value-bind (lnode rnode)
                            (rsplit (%iset-rnode node))
                          (setf (%iset-rnode node) lnode)
                          (force-up node)
                          (values node rnode))))))
        (multiple-value-bind (left tmp) (lsplit iset)
          (multiple-value-bind (mid right) (rsplit tmp)
            (let ((base (%iset-concat left right))
                  (new-lkey (if mid (min (%iset-leftmost-key mid) lkey) lkey))
                  (new-rkey (if mid (max (%iset-rightmost-key mid) rkey) rkey)))
              (iset-insert (iset-insert base new-lkey lkey)
                           rkey new-rkey)))))))

(defmacro iset-pop (iset lkey rkey)
  "POP-style macro for ISET-INSERT."
  `(setf ,iset (iset-delete ,iset ,lkey ,rkey)))

(defmacro iset-pop-point (iset key)
  (let ((tmp (gensym)))
    `(let ((,tmp ,key))
       (setf ,iset (iset-delete ,iset ,tmp (+ ,tmp 1))))))

(declaim (ftype (function * (values (or null fixnum) (or null fixnum) &optional))
                iset-find))
(defun iset-find (iset key)
  "Returns the half-open interval that contains KEY if it exists, otherwise
returns (VALUES NIL NIL)."
  (declare (optimize (speed 3))
           (fixnum key))
  (labels ((recur (node)
             (cond ((null node) (values nil nil))
                   ((< key (%iset-lkey node))
                    (recur (%iset-lnode node)))
                   ((< key (%iset-rkey node))
                    (values (%iset-lkey node) (%iset-rkey node)))
                   (t (recur (%iset-rnode node))))))
    (recur iset)))

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

(in-package :cl-user)

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

(defun main ()
  (let* ((d (read-fixnum))
         (q (read-fixnum))
         iset)
    (write-string
     (with-output-to-string (*standard-output* nil :element-type 'base-char)
       (dotimes (_ q)
         (let ((a (- (read-fixnum) 1))
               (b (read-fixnum)))
           (iset-push iset a b)
           (println (iset-value iset))))))))

#-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 "10 3
0 1
6 8
2 7
"
    "2
3
9
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "10 4
3 7
3 5
1 1
4 9
"
    "5
5
5
7
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "1000000000000000000 2
0 999999999999999999
0 999999999999999999
"
    "1000000000000000000
1000000000000000000
")))

yukicoder

結果

テストケース

コンパイルメッセージ

ソースコード