結果
| 問題 |
No.1268 Fruit Rush 2
|
| ユーザー |
 motoshira
|
| 提出日時 | 2020-10-23 22:20:51 |
| 言語 | Common Lisp (sbcl 2.5.0) |
| 結果 |
WA
|
| 実行時間 | - |
| コード長 | 21,132 bytes |
| コンパイル時間 | 1,393 ms |
| コンパイル使用メモリ | 74,368 KB |
| 実行使用メモリ | 28,800 KB |
| 最終ジャッジ日時 | 2024-07-21 10:59:19 |
| 合計ジャッジ時間 | 5,417 ms |
|
ジャッジサーバーID （参考情報） |
judge1 / judge2 |
（要ログイン）
| ファイルパターン | 結果 |
|---|---|
| sample | AC * 2 WA * 1 |
| other | AC * 13 WA * 14 RE * 6 |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 21 JUL 2024 10:59:13 AM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN LST->INT ; (THE FIXNUM (SUB LIST)) ; ; note: Type assertion too complex to check: ; FIXNUM. ; It allows an unknown number of values, consider using ; (VALUES FIXNUM &OPTIONAL). ; in: DEFUN DISJOIN ; (OR (LAMBDA (FN) (APPLY FN ARGS)) FUNCTIONS) ; --> IF ; ==> ; FUNCTIONS ; ; note: deleting unreachable code ; in: DEFUN MOD+ ; (DEFUN MOD+ (&REST ARGS) ; (DECLARE (INLINE MODINT)) ; (IF (NULL ARGS) ; 0 ; (MODINT (REDUCE #'+ ARGS)))) ; ==> ; (SB-IMPL::%DEFUN 'MOD+ ; (SB-INT:NAMED-LAMBDA MOD+ ; (&REST ARGS) ; (DECLARE (SB-C::TOP-LEVEL-FORM)) ; (DECLARE (INLINE MODINT)) ; (BLOCK MOD+ ; (IF (NULL ARGS) ; 0 ; (MODINT #))))) ; ; caught STYLE-WARNING: ; Call to COMMON-LISP-USER::MODINT could not be inlined because its source code ; was not saved. A global INLINE or SB-EXT:MAYBE-INLINE proclamation must be in ; effect to save function definitions for inlining. ; in: DEFUN MOD-INV ; (DEFUN MOD-INV (A &OPTIONAL (M +MOD+)) ; (DECLARE (INTEGER A M)) ; (LET ((B M) (U 1) (V 0)) ; (LOOP UNTIL (ZEROP B) ; DO (LET (#) ; (DECF A #) ; (ROTATEF A B) ; (DECF U #) ; (ROTATEF U V)) ; FINALLY (LOOP WHILE (MINUSP U) ; DO (INCF U M)) (RETURN (MOD U M))))) ; --> SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA ; ==> ; #'(SB-INT:NAMED-LAMBDA MOD-INV ; (A &OPTIONAL (M +MOD+)) ; (DECLARE (SB-C::TOP-LEVEL-FORM)) ; (DECLARE (INTEGER A M)) ; (BLOCK MOD-INV ; (LET ((B M) (U 1) (V 0)) ; (LOOP UNTIL (ZEROP B) ; DO
ソースコード
#|
------------------------------------
Utils
------------------------------------
|#
;;; Most of these utils are quoted from https://competitive12.blogspot.com/2020/03/common-lisp.html. Thank you!
(in-package :cl-user)
(defconstant +mod+ 1000000007)
;(defconstant +mod+ 998244353)
;;;----------------init----------------
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter OPT
#+swank '(optimize (speed 3) (safety 2))
#-swank '(optimize (speed 3) (safety 0) (debug 0)))
#+swank (progn (ql:quickload '(:cl-debug-print :fiveam :sb-sprof) :silent t)
(shadow :run))
#-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)
#-swank
(unless (member :child-sbcl *features*)
(quit
:unix-status
(process-exit-code
(run-program *runtime-pathname*
`("--control-stack-size" "128MB"
"--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options"
"--eval" "(push :child-sbcl *features*)"
"--script" ,(namestring *load-pathname*))
:output t :error t :input t))))
;;;----------------aliases----------------
(defun set-aliases (forms)
(mapc (lambda (form)
(setf (rest form)
(first form)))
forms))
(defun set-aliases-for-function (forms)
(mapc (lambda (form)
(setf (symbol-function (rest form))
(symbol-function (first form))))
forms))
(set-aliases-for-function
'((digit-char-p . char->int)
(remove-if-not . filter)
(aref . ar)))
(defmacro ^ (args &body body)
`(lambda ,args
(progn
,@body)))
(defmacro with-gensyms ((&rest args) &body body)
`(let (,@(mapcar (lambda (arg)
(list arg `(gensym)))
args))
,@body))
;;;----------------int-types----------------
(defmacro define-int-types (&rest bits)
`(progn
,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~a" b)) () '(signed-byte ,b))) bits)
,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~a" b)) () '(unsigned-byte ,b))) bits)))
(define-int-types 2 4 8 16 32 64)
;;;----------------stream----------------
(defmacro buffered-read-line (&optional (buffer-size 30) (in '*standard-input*) (term-char #\Space))
(let ((buffer (gensym))
(character (gensym))
(idx (gensym)))
`(let* ((,buffer (load-time-value (make-string ,buffer-size :element-type 'base-char))))
(declare (simple-base-string ,buffer)
(inline read-byte))
(loop for ,character of-type base-char =
,(if (member :swank *features*)
`(read-char ,in nil #\Newline) ; on SLIME
`(code-char (read-byte ,in nil #.(char-code #\Newline))))
for ,idx from 0
until (char= ,character #\Newline)
do (setf (schar ,buffer ,idx) ,character)
finally (when (< ,idx ,buffer-size)
(setf (schar ,buffer ,idx) ,term-char))
(return (values ,buffer ,idx))))))
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
(declare (inline read-byte)
#-swank (sb-kernel:ansi-stream in))
(macrolet ((%read-byte ()
`(the (unsigned-byte 8)
#+swank (char-code (read-char in nil #\Nul))
#-swank (read-byte in nil 0))))
(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) (the (integer 0 #.(floor most-positive-fixnum 10)) (* result 10))))
(return (if minus (- result) result))))))))
(defun read-bignum (&optional (in *standard-input*))
(declare (inline read-byte)
#-swank (sb-kernel:ansi-stream in))
(macrolet ((%read-byte ()
`(the (unsigned-byte 8)
#+swank (char-code (read-char in nil #\Nul))
#-swank (read-byte in nil 0))))
(let* ((minusp 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 minusp t))))))
(mid-result 0)
(index-mod18 0))
(declare (fixnum mid-result)
((integer 0 19) index-mod18)
(integer result))
(loop
(when (= index-mod18 18)
(setq result (+ mid-result (* result #.(expt 10 18))))
(setq mid-result 0)
(setq index-mod18 0))
(let ((byte (%read-byte)))
(unless (<= 48 byte 57) (return))
(setq mid-result (+ (- byte 48) (* 10 (the (mod #.(expt 10 17)) mid-result))))
(incf index-mod18)))
(setq result (+ mid-result (* result (expt 10 index-mod18))))
(if minusp (- result) result))))
(defun exp-double->fixed-double-str (double-float-num)
(format nil "~,10f" double-float-num))
(defun println (object &optional (stream *standard-output*))
(when (typep object 'double-float) (setf object (exp-double->fixed-double-str object)))
(write object :stream stream :escape nil :readably nil)
(terpri))
(defun read-numbers-to-list (size)
(loop repeat size collect (read-fixnum)))
(defun read-numbers-to-array (size)
(let ((arr (make-array size
:element-type 'fixnum
:adjustable nil)))
(declare ((array fixnum 1) arr))
(loop for i of-type fixnum below size do
(setf (aref arr i) (read-fixnum))
finally
(return arr))))
(defparameter *mark->int-alist*
'((#\. . 0)
(#\# . 1)
(#\S . 2)
(#\G . 3)))
(declaim (inline mark->int int->mark))
(defun mark->int (mark)
(rest (assoc mark *mark->int-alist*
:test #'char-equal)))
(defun int->mark (int)
(first (rassoc int *mark->int-alist*
:test #'=)))
(defun read-characters-to-board (row-size column-size)
(let ((board (make-array `(,row-size ,column-size)
:element-type '(unsigned-byte 4)
:adjustable nil)))
(dotimes (r row-size board)
(let ((tmp (read-line)))
(dotimes (c column-size)
(let ((val (mark->int (char tmp c))))
(declare ((or (unsigned-byte 4) null) val))
(if val
(setf (aref board r c) val)
(error "Character ~a not found in the alist." (char tmp c)))))))))
(defmethod princ-for-each-line ((sequence list))
(format t "~{~a~&~}" sequence))
(defmethod princ-for-each-line ((sequence vector))
(loop for i below (length sequence) do
(princ (aref sequence i))
(fresh-line)))
(declaim (inline unwrap))
(defun unwrap (list)
(the string
(format nil "~{~a~^ ~}" list)))
(defmacro with-buffered-stdout (&body body)
(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)))))
;;;----------------others----------------
(defmacro defnt (function-spec (&rest arg-specs) &body body)
"Quoted from: https://masatoi.github.io/2017/11/21/typed-defun."
`(progn
(declaim (ftype (function ,(mapcar #'cadr arg-specs) ,(cadr function-spec)) ,(car function-spec)))
(defun ,(car function-spec) ,(mapcar #'car arg-specs)
(declare (optimize (speed 3) (safety 0) (debug 0))
,@(mapcar (lambda (arg arg-type)
(list 'type arg-type arg))
(mapcar #'car arg-specs)
(mapcar #'cadr arg-specs)))
,@body)))
(defmacro tlet (bindings &body body)
"Quoted from: https://masatoi.github.io/2017/11/21/typed-defun."
`(let (,@(mapcar (lambda (binding)
(subseq binding 0 2))
bindings))
(declare ,@(mapcar (lambda (binding)
(list 'type (caddr binding) (car binding)))
bindings))
,@body))
(defmacro tlet* (bindings &body body)
"Inspired by: https://masatoi.github.io/2017/11/21/typed-defun."
`(let* (,@(mapcar (lambda (binding)
(subseq binding 0 2))
bindings))
(declare ,@(mapcar (lambda (binding)
(list 'type (caddr binding) (car binding)))
bindings))
,@body))
(defmacro ntlet (function-spec args-spec &body body)
"\"ntlet\" is abbrev. of named-typed-let. Inspired by: https://masatoi.github.io/2017/11/21/typed-defun."
`(declare (ftype (function (,@ (mapcar #'third args-spec)) ,(second function-spec)) ,(first function-spec)))
`(labels ((,(first function-spec) (,@(mapcar #'first args-spec))
(declare ,@(mapcar (lambda (arg-spec)
(list (third arg-spec)
(first arg-spec)))
args-spec))
,@body))
(,(first function-spec) ,@(mapcar #'second args-spec))))
(defmacro tlambda ((&rest args-spec) &body body)
`(lambda (,@(mapcar #'first args-spec))
(declare ,@(mapcar (lambda (arg-spec)
(list (second arg-spec)
(first arg-spec)))
args-spec))
,@body))
(defmacro aif (test-form then-form &optional else-form)
`(let ((it ,test-form))
(if it
,then-form
,else-form)))
(defmacro awhen (test &body body)
`(let ((it ,test))
(when it
,@body)))
(defmacro aunless (test &body body)
`(let ((it ,test))
(unless it
,@body)))
(defmacro safe-sort (list &key (test '<) (key #'identity))
`(progn
(declaim (inline sort sb-impl::stable-sort-list))
(sort (copy-seq ,list) ,test :key ,key)))
(define-modify-macro maxf (var) max)
(define-modify-macro minf (var) min)
(define-modify-macro modf () (lambda (place)
(mod place +mod+)))
(declaim (inline << >>))
(defun << (int count)
(ash int count))
(defun >> (int count)
(ash int (- count)))
(declaim (inline iota))
(defun iota (count &optional (start 0) (step 1))
(loop for i from 0 below count collect (+ start (* i step))))
(declaim (inline int->lst))
(defun int->lst (integer)
(declare ((integer 0) integer))
(labels ((sub (int &optional (acc nil))
(declare ((integer 0) int)
(list acc))
(if (zerop int)
acc
(sub (floor int 10) (cons (rem int 10) acc)))))
(sub integer)))
(declaim (inline lst->int))
(defun lst->int (list)
(declare (list list))
(labels ((sub (xs &optional (acc 0))
(declare (ftype (function (list &optional (integer 0)) (integer 0)) sub))
(declare (list xs)
((integer 0) acc))
(if (null xs)
acc
(sub (rest xs) (+ (* acc 10)
(rem (first xs) 10))))))
(the fixnum
(sub list))))
(defun int->str (integer)
(format nil "~a" integer))
(defun str->int (str)
(parse-integer str))
(declaim (inline next-char prev-char))
(defun next-char (character)
(if (char-equal character #\z)
#\a
(code-char (1+ (char-code character)))))
(defun prev-char (character)
(if (char-equal character #\a)
#\z
(code-char (1- (char-code character)))))
(declaim (inline prime-factorize-to-list))
(defun prime-factorize-to-list (integer)
(declare ((integer 0) integer))
(the list
(if (<= integer 1)
nil
(loop
while (<= (* f f) integer)
with acc list = nil
with f integer = 2
do
(if (zerop (rem integer f))
(progn
(push f acc)
(setq integer (floor integer f)))
(incf f))
finally
(when (/= integer 1)
(push integer acc))
(return (reverse acc))))))
(declaim (inline prime-p))
(defun prime-p (integer)
(declare ((integer 1) integer))
(if (= integer 1)
nil
(loop
with f = 2
while (<= (* f f) integer)
do
(when (zerop (rem integer f))
(return nil))
(incf f)
finally
(return t))))
(declaim (inline count-subsequence))
(defun count-subsequence (mainstr substr)
(let ((main-len (length mainstr))
(sub-len (length substr)))
(count-if (lambda (i)
(every (lambda (j)
(char-equal (char mainstr (+ i j))
(char substr j)))
(iota sub-len)))
(iota (1+ (- main-len sub-len))))))
(defun memoize (fn)
(let ((memo (make-hash-table)))
(lambda (&rest args)
(multiple-value-bind (val win) (gethash args memo)
(if win
val
(setf (gethash args memo)
(apply fn args)))))))
(defmacro -> (obj &rest forms)
(labels ((sub (obj forms)
(if (null forms)
obj
(let ((form (first forms)))
(cond
((atom form)
(sub `(,form ,obj)
(rest forms)))
((null (cdr form))
(sub `(,(first form) ,obj)
(rest forms)))
((find :@ form)
(sub (substitute obj :@ form)
(rest forms)))
(t (sub`(,(first form) ,obj ,@(rest form))
(rest forms))))))))
(sub obj forms)))
(defmacro while (test &body body)
`(loop
while ,test
do
(progn
,@body)))
(defmacro until (test &body body)
`(loop
until ,test
do
(progn
,@body)))
(defmacro repeat (times &body body)
`(loop
repeat ,times
do
(progn
,@body)))
(defmacro href (hash-table key &optional (default nil))
`(gethash ,key ,hash-table ,default))
(defun zip (&rest lists)
(apply 'mapcar 'list lists))
(defun compose (fn &rest functions)
(reduce (lambda (f g)
(lambda (&rest args)
(funcall f (apply g args))))
functions
:initial-value fn))
(defun conjoin (&rest functions)
(lambda (&rest args)
(every (lambda (fn)
(apply fn args))
functions)))
(defun disjoin (&rest functions)
(lambda (&rest args)
(or (lambda (fn)
(apply fn args))
functions)))
(defun split-string-into-list (string &optional (separator #\space))
(remove separator
(concatenate 'list string)
:test #'char-equal))
(defmethod positions (item (sequence list) &key (test 'eql))
(labels ((sub (item xs pos acc)
(cond
((null xs) (reverse acc))
((funcall test
(first xs)
item)
(sub item
(rest xs)
(1+ pos)
(cons pos
acc)))
(t
(sub item
(rest xs)
(1+ pos)
acc)))))
(sub item sequence 0 nil)))
(defun divisor-enumerate (k)
(if (= k 1)
(list 1)
(labels ((sub (k d acc)
(cond
((> (* d d)
k)
(sort acc #'<))
((zerop (rem k d))
(sub k
(1+ d)
(if (= (* d d)
k)
(cons d acc)
(cons d
(cons (floor k d)
acc)))))
(t
(sub k
(1+ d)
acc)))))
(sub k 1 nil))))
;;;----------------debug----------------
#+swank
(defun get-clipboard ()
(with-output-to-string (out)
(sb-ext:run-program "/usr/bin/bash" '("-c" "parcellite" "-p") :output out :search t)))
#+swank
(defun remove-first-line (string)
(let ((first-n (position #\Newline string)))
(when (null first-n)
(error "No Newline in the string."))
(subseq string (1+ first-n))))
#+swank
(defun run (&key (take-time nil) (fn 'main) (out *standard-output*))
(let ((*standard-output* out))
(with-input-from-string (*standard-input* (delete #\Return (remove-first-line (get-clipboard))))
(if take-time
(time
(progn
(sb-sprof:start-profiling)
(funcall fn)
(sb-sprof:stop-profiling)
(sb-sprof:report)))
(funcall fn)))))
#|
------------------------------------
Body
------------------------------------
|#
(in-package :cl-user)
;;; start inserted contents
(declaim (ftype (function (finxum &optional fixnum) fixnum) modint))
(defun modint (x &optional (m +mod+))
(declare (integer x))
(cond
((and (>= x 0) (< x m)) x)
((minusp x) (modint (+ x m)))
(t (mod x m))))
(declaim (ftype (function (&rest fixnum) fixnum) mod+))
(defun mod+ (&rest args)
(declare (inline modint))
(if (null args)
0
(modint (reduce #'+ args))))
(declaim (ftype (function (&rest fixnum) fixnum) mod-))
(defun mod- (&rest args)
(declare (inline modint))
(if (null args)
0
(modint (reduce #'- args))))
(declaim (ftype (function (&rest fixnum) fixnum) mod*))
(defun mod* (&rest args)
(declare (inline modint))
(if (null args)
0
(modint (reduce #'* args))))
(declaim (ftype (function (fixnum &optional fixnum) fixnum) mod-inv))
(defun mod-inv (a &optional (m +mod+))
(declare (integer a m))
(let ((b m)
(u 1)
(v 0))
(loop until (zerop b) do
(let ((w (truncate a b)))
(decf a (* w b))
(rotatef a b)
(decf u (* w v))
(rotatef u v))
finally
(loop while (minusp u) do
(incf u m))
(return (mod u m)))))
(declaim (ftype (function (&rest fixnum) fixnum) mod/))
(defun mod/ (&rest args)
(declare (inline modint))
(if (null args)
0
(reduce (lambda (x y)
(modint (* x (mod-inv y))))
args
:initial-value 1)))
(declaim (ftype (function (finxum fixnum &optional fixnum) fixnum) mod-power))
(defun mod-power (a n &optional (m +mod+))
(declare (integer a)
((integer 0) n))
(labels ((sub (a n &optional (res 1))
(if (zerop n)
res
(sub (mod (* a a) m)
(truncate n 2)
(if (oddp n)
(mod (* res a) m)
res)))))
(sub a n)))
(declaim (ftype (function (fixnum fixnum &optional fixnum) fixnum) mod-binomial))
(defun mod-binomial (n k &optional (m +mod+))
(declare ((integer 0) m))
(if (or (< n k) (< n 0) (< k 0))
0
(let ((k (if (< k (- n k)) k (- n k)))
(num 1)
(denom 1))
(declare ((integer 0) k num denom))
(loop for x from n above (- n k) do
(setq num (mod (* num x) m)))
(loop for x from 1 to k do
(setq denom (mod (* denom x) m)))
(mod (* num (mod-inv denom m)) m))))
;;; end inserted contents
(defun main ()
(declare #.OPT)
(tlet ((n (read) fixnum))
(tlet ((a (sort (read-numbers-to-list n) #'<) list))
(println
(mod+ n
(ntlet (rec fixnum) ((xs a list)
(acc 0 fixnum))
(cond
((null (rest xs)) acc)
((<= (abs (- (second xs)
(first xs)))
1)
(rec (rest xs) (modint (1+ acc))))
(t
(rec (rest xs) acc)))))))))
#-swank (main)