(in-package :cl-user) (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *opt* #+swank '(optimize (speed 3) (safety 2)) #-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 (%uint 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) (declare (bitset bitset)) (fill (bitset-data bitset) #.(1- (ash 1 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 #1=(ldb (byte 1 (rem idx 60)) (aref (bitset-data bitset) (floor idx 60))) (logxor #1# 1)) #+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 #2=(aref (bitset-data new-bs) idx) (the %uint (logand #.(1- (ash 1 60)) (logior #2# (ash mask ash-delta))))) (when (plusp idx) (setf #3=(aref (bitset-data new-bs) (1- idx)) (the %uint (logand #.(1- (ash 1 60)) (logior #3# (ash mask (+ ash-delta 60))))))) (when (< idx (1- ,data-size)) (setf #4= (aref (bitset-data new-bs) (1+ idx)) (the %uint (logand #.(1- (ash 1 60)) (logior #4# (ash mask (- ash-delta 60))))))))) new-bs))))) (define-bitset :size #.(* 60 10000)) ;; ;; 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 ;;; (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)) (do-rep q (let* ((l-from (1- (read-fixnum))) (r-from (read-fixnum)) (l-to (1- (read-fixnum))) (r-to (read-fixnum))) (declare (fixnum l-from r-from l-to r-to) (ignorable r-from)) (setf bs (bitset-xor bs (bitset-intersect (mask->bitset (the fixnum (- (ash 1 r-to) (ash 1 l-to)))) (bitset-ash bs (the fixnum (- l-to l-from)))))))) (dotimes (i n) (princ (if (= 1 (bitset-ref bs i)) #\O #\E))) (fresh-line))) #-swank (main)