結果
| 問題 | No.142 単なる配列の操作に関する実装問題 |
| ユーザー |
 motoshira
|
| 提出日時 | 2021-03-23 10:28:22 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
TLE
|
| 実行時間 | - |
| コード長 | 15,310 bytes |
| コンパイル時間 | 413 ms |
| コンパイル使用メモリ | 73,008 KB |
| 実行使用メモリ | 114,616 KB |
| 最終ジャッジ日時 | 2024-11-25 02:12:31 |
| 合計ジャッジ時間 | 37,330 ms |
|
ジャッジサーバーID （参考情報） |
judge2 / judge3 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | TLE | - |
| testcase_01 | TLE | - |
| testcase_02 | TLE | - |
| testcase_03 | TLE | - |
| testcase_04 | TLE | - |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 25 NOV 2024 02:11:52 AM): ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.146
ソースコード
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *opt*
#+swank '(optimize (speed 0) (safety 3) (debug 3))
#-swank '(optimize (speed 3) (safety 0) (debug 0)))
#+swank (load "~/Dropbox/Code/atcoder/ac-tools/act.lisp")
#+swank (ql:quickload :prove)
#-swank (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
#-swank (sb-ext:disable-debugger)
(pushnew :inline-generic-funcion *features*))
(defmacro define-int-types (&rest ints)
`(progn
,@(mapcar (lambda (int) `(deftype ,(intern (format nil "UINT~a" int)) () '(unsigned-byte ,int))) ints)
,@(mapcar (lambda (int) `(deftype ,(intern (format nil "INT~a" int)) () '(signed-byte ,int))) ints)))
(define-int-types 2 4 8 16 31 32 60 62 64 120)
(defmacro dbg (&rest forms)
#-swank (declare (ignore forms))
#+swank `(format *error-output* "~a => ~a~&" ',forms `(,,@forms)))
(defmacro do-rep (count &body body) `(loop repeat ,count do ,@body))
(defmacro nlet (name binds &body body)
`(labels ((,name (,@(mapcar #'first binds))
,@body))
(,name ,@(mapcar #'second binds))))
(defmacro dotimes! ((var count &optional (index-origin 0) (unroll 10)) &body body)
#+swank (declare (ignorable unroll))
#+swank `(loop for ,var from ,index-origin below (+ ,count ,index-origin)
do ,@body)
#-swank
(sb-int:with-unique-names (cnt q r)
`(multiple-value-bind (,q ,r) (truncate ,count ,unroll)
(declare (fixnum ,q ,r))
(do ((,cnt 0 (the fixnum (1+ ,cnt))) (,var ,index-origin))
((>= ,cnt ,q) (loop repeat ,r do (progn ,@body (setf (the fixnum ,var) (the fixnum (1+ ,var))))))
(declare (fixnum ,cnt ,var))
,@(loop repeat unroll append `(,@body (setf (the fixnum ,var) (the fixnum (1+ ,var)))))))))
(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
(let ((*read-default-float-format* 'double-float))
(prog1 obj
(princ obj stream)
(terpri))))
(defun read-nums (count &optional (element-type '(simple-array fixnum (*))))
(declare (fixnum count))
(coerce (loop repeat count collect (read)) element-type))
(define-modify-macro maxf (var) max)
(define-modify-macro minf (var) min)
(defconstant +inf+ #.(ash 1 61))
;; bitset
(deftype %uint () '(unsigned-byte 60))
(defmacro define-bitset (&key size)
"Define bitset which can contain integer from 0 to SIZE."
(check-type size fixnum)
(unless (zerop (rem size 60))
(warn "SIZE is preferred to be multiple of 60. BITSET-COUNT may not return accurate value."))
(let ((data-size (ceiling size 60)))
`(progn
(defstruct (bitset (:constructor make-bitset)
(:copier nil))
(data (make-array ,data-size :element-type '%uint
:initial-element 0)
:type (simple-array %uint (,data-size))))
(defun mask->bitset (mask)
(declare ((integer 0) mask))
(let ((res (make-bitset))
(i 0))
(declare (bitset res)
(%uint i))
(loop while (plusp mask)
do (when (logbitp 0 mask)
(bitset-add! res i))
(setf mask (ash mask -1)
i (1+ i)))
res))
(defun bitset-reset! (bitset)
(declare (bitset bitset))
(fill (bitset-data bitset) 0))
(defun bitset-fill! (bitset &optional (begin 0) (end ,data-size))
(declare (bitset bitset)
(%uint begin end))
;; 平方分割っぽく左右から寄せる O(data-size)
(let ((l begin)
(r end))
(declare (%uint l r))
(loop while (and (< l r)
(not (zerop (rem l 60))))
do (bitset-add! bitset l)
(incf l))
(loop while (and (< l r)
(not (zerop (rem r 60))))
do (decf r)
(bitset-add! bitset r))
(assert (or (not (< l r))
(and (zerop (rem l 60))
(zerop (rem r 60)))))
(fill (bitset-data bitset)
#.(1- (ash 1 60))
:start (floor l 60)
:end (floor r 60))))
(defun bitset-ref (bitset idx)
(declare (bitset bitset)
(%uint idx))
(logand 1
(ash (aref (bitset-data bitset)
(floor idx 60))
(- (rem idx 60)))))
(defun bitset-add! (bitset idx)
(declare (bitset bitset)
(%uint idx))
(setf (ldb (byte 1 (rem idx 60))
(aref (bitset-data bitset)
(floor idx 60)))
1)
#+swank (bitset->list bitset)
)
(defun bitset-rem! (bitset idx)
(declare (bitset bitset)
(%uint idx))
(setf (ldb (byte 1 (rem idx 60))
(aref (bitset-data bitset)
(floor idx 60)))
0)
#+swank (bitset->list bitset)
)
(defun bitset-flip! (bitset idx)
(declare (bitset bitset)
(%uint idx))
(setf (ldb (byte 1 (rem idx 60))
(aref (bitset-data bitset)
(floor idx 60)))
(logxor 1
(ldb (byte 1 (rem idx 60))
(aref (bitset-data bitset)
(floor idx 60)))))
#+swank (bitset->list bitset)
)
(defun bitset->list (bitset)
(loop for i of-type %uint from 0
for mask of-type %uint across (bitset-data bitset)
append (loop for b of-type (integer 0 60) below 60
when (logbitp b mask)
collect (+ (* i 60)
b))))
(defun bitset-unite (bs1 bs2)
(declare (bitset bs1 bs2))
(let ((tmp (make-bitset)))
(declare (bitset tmp))
(loop for i of-type %uint from 0
for mask1 of-type %uint across (bitset-data bs1)
for mask2 of-type %uint across (bitset-data bs2)
do (setf (aref (bitset-data tmp)
i)
(logior mask1
mask2)))
tmp))
(defun bitset-intersect (bs1 bs2)
(declare (bitset bs1 bs2))
(let ((tmp (make-bitset)))
(declare (bitset tmp))
(loop for i of-type %uint from 0
for mask1 of-type %uint across (bitset-data bs1)
for mask2 of-type %uint across (bitset-data bs2)
do (setf (aref (bitset-data tmp)
i)
(logand mask1
mask2)))
tmp))
(defun bitset-xor (bs1 bs2)
(declare (bitset bs1 bs2))
(let ((tmp (make-bitset)))
(declare (bitset tmp))
(loop for i of-type %uint from 0
for mask1 of-type %uint across (bitset-data bs1)
for mask2 of-type %uint across (bitset-data bs2)
do (setf (aref (bitset-data tmp)
i)
(logxor mask1
mask2)))
tmp))
(defun copy-bitset (bitset)
(declare (bitset bitset))
(make-bitset :data (copy-seq (bitset-data bitset))))
(defun bitset-count (bitset)
(loop for mask of-type %uint across (bitset-data bitset)
sum (logcount mask)))
(defun bitset-ash (bitset count)
(declare (bitset bitset)
(fixnum count))
(let* ((new-bs (make-bitset))
(sgn (if (zerop count)
0
(floor count (abs count))))
(idx-delta (* sgn
(floor (abs count)
60)))
(ash-delta (* sgn
(rem (abs count)
60))))
(declare (bitset new-bs)
(fixnum sgn idx-delta ash-delta))
(loop for i of-type %uint from 0 below ,data-size
for idx of-type fixnum
= (+ i idx-delta)
when (<= 0 idx (the %uint (1- ,data-size)))
do (let ((mask (aref (bitset-data bitset) i)))
(declare (%uint mask))
(setf (aref (bitset-data new-bs) idx)
(the %uint
(logand #.(1- (ash 1 60))
(logior (aref (bitset-data new-bs) idx)
(ash mask ash-delta)))))
(when (plusp idx)
(setf (aref (bitset-data new-bs) (1- idx))
(the %uint
(logand #.(1- (ash 1 60))
(logior (aref (bitset-data new-bs) (1- idx))
(ash mask (+ ash-delta 60)))))))
(when (< idx (1- ,data-size))
(setf (aref (bitset-data new-bs) (1+ idx))
(the %uint
(logand #.(1- (ash 1 60))
(logior (aref (bitset-data new-bs) (1+ idx))
(ash mask (- ash-delta 60)))))))))
new-bs)))))
(define-bitset :size #.(* 60 50000))
;;
;; BOF
;;
(declaim (ftype (function (sequence) simple-base-string) unwrap))
(defun unwrap (sequence)
;; e.g. (unwrap (list 1 2 3 4 5)) => "1 2 3 4 5"
(let ((*standard-output* (make-string-output-stream :element-type 'base-char)))
(let ((init nil))
(declare (boolean init))
(map nil
(lambda (x)
(when init
(princ #\space))
(setq init t)
(princ x))
sequence))
(coerce (get-output-stream-string *standard-output*) 'simple-base-string)))
(defmacro with-buffered-stdout (&body body)
;; Quoted from: https://competitive12.blogspot.com/2020/03/common-lisp.html
(let ((out (gensym)))
`(let ((,out (make-string-output-stream :element-type 'base-char)))
(let ((*standard-output* ,out))
,@body)
(write-string (get-output-stream-string ,out)))))
(declaim (inline read-fixnum read-nums println))
(defun read-fixnum (&optional (in *standard-input*))
;; Ref: https://competitive12.blogspot.com/2020/03/common-lisp.html
;; partially modified
(declare (inline read-byte))
(flet ((%read-byte ()
(the fixnum #+swank (char-code (read-char in nil #\Nul))
#-swank (read-byte in nil #.(char-code #\Nul))))
(%byte->num (b)
(the fixnum (- b #.(char-code #\0))))
(%digit-p (byte)
(declare (fixnum byte))
(<= #.(char-code #\0) byte #.(char-code #\9))))
(declare (inline %read-byte %byte->num %digit-p))
(let ((minus nil)
(res 0))
(declare (boolean minus) (fixnum res))
(loop for byte of-type fixnum = (%read-byte)
do (cond
((%digit-p byte)
(setf res (%byte->num byte))
(return))
((= byte #.(char-code #\Nul))
(error "EOF"))
((= byte #.(char-code #\-))
(setf minus t))))
(loop for byte of-type fixnum = (%read-byte)
do (cond
((%digit-p byte)
(setf res (the fixnum (+ (* res 10) (%byte->num byte)))))
(t (return))))
(the fixnum (if minus (- res) res)))))
(defun set! (arr count)
(dotimes (i count)
(setf (aref arr i)
(read-fixnum))))
(defun read-base-char (&optional (in *standard-input*) (eof #\Newline))
(declare (inline read-byte)
#-swank (sb-kernel:ansi-stream in)
(base-char eof))
#+swank (coerce (read-char in nil eof) 'base-char)
#-swank
(the base-char (code-char (the (integer 0 127) (read-byte in nil (char-code eof))))))
(defmacro read-line! (simple-base-string &optional (in *standard-input*) (term #\Newline))
"Read characters and DESTRUCTIVELY fill SIMPLE-BASE-STRING with them."
(let ((n (gensym))
(c (gensym))
(i (gensym)))
`(locally (declare (inline read-base-char))
(let ((,n (length ,simple-base-string)))
(declare (fixnum ,n))
(loop for ,c of-type base-char = (read-base-char ,in #\Newline)
with ,i of-type fixnum = 0
until (char= ,c ,term)
do (unless (< ,i ,n)
(error "Reached the end of ~a." ',simple-base-string))
(setf (schar ,simple-base-string ,i)
,c)
(incf ,i))))))
(defun split (string &optional (separator #\space))
(declare (base-string string)
(base-char separator))
(let ((pos (position separator string)))
(if pos
(cons (subseq string 0 pos)
(split (subseq string (1+ pos))
separator))
(list string))))
;;
;; EOF
;;
;;;
;;; Body
;;;
(defvar *bs*)
(defvar *bs-tmp*)
(defun main ()
(declare #.*opt*)
(let* ((n (read))
(s (read))
(x (read))
(y (read))
(z (read))
(q (read))
(as (make-array n :element-type 'uint60))
(*bs* (make-bitset)))
(declare (uint60 n s x y z q)
((simple-array uint60 (*)) as)
(bitset *bs*))
(loop for i of-type uint60 below n
do (setf (aref as i)
(if (zerop i)
s
(the uint60
(rem (+ (* x (aref as (the uint60 (1- i))))
y)
z))))
if (oddp (aref as i))
do (bitset-add! *bs* i))
(dbg (bitset->list *bs*))
(do-rep q
(let* ((l-from (1- (read-fixnum)))
(r-from (read-fixnum))
(l-to (1- (read-fixnum)))
(r-to (read-fixnum))
(*bs-tmp* (make-bitset)))
(declare (fixnum l-from r-from l-to r-to)
(bitset *bs-tmp*)
(ignorable r-from))
(bitset-fill! *bs-tmp* l-to r-to)
(setf *bs* (bitset-xor
*bs*
(bitset-intersect
*bs-tmp*
(bitset-ash *bs* (- l-to l-from)))))))
(with-buffered-stdout
(dotimes (i n)
(princ (if (= 1 (bitset-ref *bs* i))
#\O
#\E)))
(fresh-line))))
#-swank
(progn
(setf (sb-alien:extern-alien "thread_control_stack_size" sb-kernel::os-vm-size-t)
(* 256 1024 1024))
(sb-thread:join-thread (sb-thread:make-thread #'main)))