結果
| 問題 | No.1392 Don't be together |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-02-12 22:20:10 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 437 ms / 2,000 ms |
| コード長 | 21,189 bytes |
| コンパイル時間 | 348 ms |
| コンパイル使用メモリ | 80,020 KB |
| 実行使用メモリ | 225,156 KB |
| 最終ジャッジ日時 | 2023-09-27 04:47:18 |
| 合計ジャッジ時間 | 10,388 ms |
|
ジャッジサーバーID （参考情報） |
judge14 / judge15 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 61 ms
221,164 KB |
| testcase_01 | AC | 61 ms
223,204 KB |
| testcase_02 | AC | 61 ms
223,288 KB |
| testcase_03 | AC | 62 ms
224,760 KB |
| testcase_04 | AC | 61 ms
221,244 KB |
| testcase_05 | AC | 63 ms
224,940 KB |
| testcase_06 | AC | 299 ms
221,596 KB |
| testcase_07 | AC | 434 ms
221,512 KB |
| testcase_08 | AC | 414 ms
221,500 KB |
| testcase_09 | AC | 430 ms
221,576 KB |
| testcase_10 | AC | 342 ms
221,472 KB |
| testcase_11 | AC | 428 ms
221,488 KB |
| testcase_12 | AC | 327 ms
223,260 KB |
| testcase_13 | AC | 392 ms
225,156 KB |
| testcase_14 | AC | 416 ms
221,484 KB |
| testcase_15 | AC | 345 ms
221,560 KB |
| testcase_16 | AC | 437 ms
221,488 KB |
| testcase_17 | AC | 355 ms
221,492 KB |
| testcase_18 | AC | 408 ms
223,172 KB |
| testcase_19 | AC | 394 ms
221,484 KB |
| testcase_20 | AC | 174 ms
221,336 KB |
| testcase_21 | AC | 100 ms
221,284 KB |
| testcase_22 | AC | 283 ms
221,420 KB |
| testcase_23 | AC | 197 ms
224,784 KB |
| testcase_24 | AC | 156 ms
225,064 KB |
| testcase_25 | AC | 213 ms
224,688 KB |
| testcase_26 | AC | 99 ms
221,268 KB |
| testcase_27 | AC | 134 ms
221,356 KB |
| testcase_28 | AC | 208 ms
221,360 KB |
| testcase_29 | AC | 132 ms
221,364 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 27 SEP 2023 04:47:02 AM): ; processing (IN-PACKAGE :CL-USER) ; processing (DEFPARAMETER *OPT* ...) ; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...) ; processing (DOLIST (F #) ...) ; processing (SETQ *RANDOM-STATE* ...) ; processing (DEFINE-INT-TYPES 2 ...) ; processing (DEFCONSTANT +MOD+ ...) ; processing (DEFMACRO DBG ...) ; processing (DECLAIM (INLINE PRINTLN)) ; processing (DEFUN PRINTLN ...) ; processing (DEFPACKAGE :CP/MOD-OPERATIONS ...) ; processing (IN-PACKAGE :CP/MOD-OPERATIONS) ; processing (DEFMACRO DEFINE-MOD-OPERATIONS ...) ; processing (DEFINE-MOD-OPERATIONS COMMON-LISP-USER::+MOD+ ...) ; processing (DEFPACKAGE :CP/WITH-CACHE ...) ; processing (IN-PACKAGE :CP/WITH-CACHE) ; processing (DECLAIM (TYPE # ...)) ; processing (DEFPARAMETER *RECURSION-DEPTH* ...) ; processing (DEFUN %ENCLOSE-WITH-TRACE ...) ; processing (DEFUN %EXTRACT-DECLARATIONS ...) ; processing (DEFUN %PARSE-CACHE-FORM ...) ; processing (DEFMACRO WITH-CACHE ...) ; processing (DEFMACRO WITH-CACHES ...) ; processing (DEFPACKAGE :CP/SYMMETRIC-GROUP ...) ; processing (IN-PACKAGE :CP/SYMMETRIC-GROUP) ; processing (DECLAIM (INLINE DECOMPOSE-TO-CYCLES)) ; processing (DEFUN DECOMPOSE-TO-CYCLES ...) ; processing (DECLAIM (INLINE PERM*)) ; processing (DEFUN PERM* ...) ; processing (DECLAIM (INLINE PERM-INVERSE)) ; processing (DEFUN PERM-INVERSE ...) ; processing (DECLAIM (INLINE IOTA)) ; processing (DEFUN IOTA ...) ; processing (USE-PACKAGE :CP/SYMMETRIC-GROUP ...) ; processing (USE-PACKAGE :CP/WITH-CACHE ...) ; processing (USE-PACKAGE :CP/MOD-OPERATIONS ...) ; processing (IN-PACKAGE :CL-USER) ; processing (DEFUN MAIN ...) ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MAIN ; (ERROR "Huh?") ; ==> ; "Huh?" ; ; note: deleting unreachable code ; (LENGTH CYCLE) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a SEQUENCE, not a VECTOR. ; (- (READ) 1) ; ; note: unable to ; open-co
ソースコード
(in-package :cl-user)
(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 :cp/util) :silent t)
#+swank (use-package :cp/util :cl-user)
#-swank (set-dispatch-macro-character
#\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))
#+sbcl (dolist (f '(:popcnt :sse4)) (pushnew f sb-c:*backend-subfeatures*))
#+sbcl (setq *random-state* (seed-random-state (nth-value 1 (get-time-of-day)))))
#-swank (eval-when (:compile-toplevel)
(setq *break-on-signals* '(and warning (not style-warning))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)
(macrolet ((def (b)
`(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
(define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(def ,b)) bits))))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64))
(defconstant +mod+ 998244353)
(defmacro dbg (&rest forms)
(declare (ignorable forms))
#+swank (if (= (length forms) 1)
`(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
`(format *error-output* "~A => ~A~%" ',forms `(,,@forms))))
(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
(let ((*read-default-float-format*
(if (typep obj 'double-float) 'double-float *read-default-float-format*)))
(prog1 (princ obj stream) (terpri stream))))
;; BEGIN_INSERTED_CONTENTS
;;;
;;; Arithmetic operations with static modulus
;;;
(defpackage :cp/mod-operations
(:use :cl)
(:export #:define-mod-operations))
(in-package :cp/mod-operations)
(defmacro define-mod-operations
(divisor &optional (package #+sbcl (sb-int:sane-package) #-sbcl *package*))
(let ((mod* (intern "MOD*" package))
(mod+ (intern "MOD+" package))
(mod- (intern "MOD-" package))
(incfmod (intern "INCFMOD" package))
(decfmod (intern "DECFMOD" package))
(mulfmod (intern "MULFMOD" package)))
`(progn
(defun ,mod* (&rest args)
(cond ((cdr args) (reduce (lambda (x y) (mod (* x y) ,divisor)) args))
(args (mod (car args) ,divisor))
(t 1)))
(defun ,mod+ (&rest args)
(cond ((cdr args) (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))
(args (mod (car args) ,divisor))
(t 0)))
(defun ,mod- (&rest args)
(if (cdr args)
(reduce (lambda (x y) (mod (- x y) ,divisor)) args)
(mod (- (car args)) ,divisor)))
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(locally (declare (sb-ext:muffle-conditions warning))
(sb-c:define-source-transform ,mod* (&rest args)
(case (length args)
(0 1)
(1 `(mod ,(car args) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args))))
(sb-c:define-source-transform ,mod+ (&rest args)
(case (length args)
(0 0)
(1 `(mod ,(car args) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args))))
(sb-c:define-source-transform ,mod- (&rest args)
(case (length args)
(0 (values nil t))
(1 `(mod (- ,(car args)) ,',divisor))
(otherwise (reduce (lambda (x y) `(mod (- ,x ,y) ,',divisor)) args))))))
(define-modify-macro ,incfmod (delta)
(lambda (x y) (mod (+ x y) ,divisor)))
(define-modify-macro ,decfmod (delta)
(lambda (x y) (mod (- x y) ,divisor)))
(define-modify-macro ,mulfmod (multiplier)
(lambda (x y) (mod (* x y) ,divisor))))))
(define-mod-operations cl-user::+mod+ :cl-user)
;;;
;;; Memoization macro
;;;
(defpackage :cp/with-cache
(:use :cl)
(:export #:with-cache #:with-caches))
(in-package :cp/with-cache)
;; FIXME: *RECURSION-DEPTH* should be included within the macro.
(declaim (type (integer 0 #.most-positive-fixnum) *recursion-depth*))
(defparameter *recursion-depth* 0)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun %enclose-with-trace (fname args form)
(let ((value (gensym)))
`(progn
(format t "~&~A~A: (~A ~{~A~^ ~}) =>"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',fname
(list ,@args))
(let ((,value (let ((*recursion-depth* (1+ *recursion-depth*)))
,form)))
(format t "~&~A~A: (~A ~{~A~^ ~}) => ~A"
(make-string *recursion-depth*
:element-type 'base-char
:initial-element #\ )
*recursion-depth*
',fname
(list ,@args)
,value)
,value))))
(defun %extract-declarations (body)
(remove-if-not (lambda (form) (and (consp form) (eql 'declare (car form))))
body))
(defun %parse-cache-form (cache-specifier)
(let ((cache-type (car cache-specifier))
(cache-attribs (cdr cache-specifier)))
(assert (member cache-type '(:hash-table :array)))
(let* ((dims-with-* (when (eql cache-type :array) (first cache-attribs)))
(dims (remove '* dims-with-*))
(rank (length dims))
(rest-attribs (ecase cache-type
(:hash-table cache-attribs)
(:array (cdr cache-attribs))))
(key (prog1 (getf rest-attribs :key) (remf rest-attribs :key)))
(trace-p (prog1 (getf rest-attribs :trace) (remf rest-attribs :trace)))
(cache-form (case cache-type
(:hash-table `(make-hash-table ,@rest-attribs))
(:array `(make-array (list ,@dims) ,@rest-attribs))))
(initial-element (when (eql cache-type :array)
(assert (member :initial-element rest-attribs))
(getf rest-attribs :initial-element))))
(let ((cache (gensym "CACHE"))
(value (gensym))
(present-p (gensym))
(args-lst (gensym))
(indices (loop repeat rank collect (gensym))))
(labels
((make-cache-querier (cache-type name args)
(let ((res (case cache-type
(:hash-table
`(let ((,args-lst (funcall ,(or key '#'list) ,@args)))
(multiple-value-bind (,value ,present-p)
(gethash ,args-lst ,cache)
(if ,present-p
,value
(setf (gethash ,args-lst ,cache)
(,name ,@args))))))
(:array
(assert (= (length args) (length dims-with-*)))
(let ((memoized-args (loop for dimension in dims-with-*
for arg in args
unless (eql dimension '*)
collect arg)))
(if key
`(multiple-value-bind ,indices
(funcall ,key ,@memoized-args)
(let ((,value (aref ,cache ,@indices)))
(if (eql ,initial-element ,value)
(setf (aref ,cache ,@indices)
(,name ,@args))
,value)))
`(let ((,value (aref ,cache ,@memoized-args)))
(if (eql ,initial-element ,value)
(setf (aref ,cache ,@memoized-args)
(,name ,@args))
,value))))))))
(if trace-p
(%enclose-with-trace name args res)
res)))
(make-reset-form (cache-type)
(case cache-type
(:hash-table `(setf ,cache (make-hash-table ,@rest-attribs)))
(:array `(prog1 nil
;; TODO: portable fill
(fill (sb-ext:array-storage-vector ,cache) ,initial-element)))))
(make-reset-name (name)
(intern (format nil "RESET-~A" (symbol-name name)))))
(values cache cache-form cache-type
#'make-reset-name
#'make-reset-form
#'make-cache-querier)))))))
(defmacro with-cache ((cache-type &rest cache-attribs) def-form)
"CACHE-TYPE := :HASH-TABLE | :ARRAY.
DEF-FORM := definition form with DEFUN, LABELS, FLET, or SB-INT:NAMED-LET.
Basic usage:
\(with-cache (:hash-table :test #'equal :key #'cons)
(defun add (a b)
(+ a b)))
This function caches the returned values for already passed combinations of
arguments. In this case ADD stores the key (CONS A B) and the returned value to
a hash-table when (ADD A B) is evaluated for the first time. When it is called
with the same arguments (w.r.t. EQUAL) again, ADD will return the stored value
instead of recomputing it.
The storage for cache can be hash-table or array. Let's see an example for
array:
\(with-cache (:array (10 20 30) :initial-element -1 :element-type 'fixnum)
(defun foo (a b c) ... ))
This form stores the value returned by FOO in an array, which was created
by (make-array (list 10 20 30) :initial-element -1 :element-type 'fixnum). Note
that INITIAL-ELEMENT must always be given here as it is used as the flag
expressing `not yet stored'. (Therefore INITIAL-ELEMENT should be a value FOO
never takes.)
If you want to ignore some arguments, you can put `*' in dimensions:
\(with-cache (:array (10 10 * 10) :initial-element -1)
(defun foo (a b c d) ...)) ; then C is ignored when querying or storing cache
Available definition forms in WITH-CACHE are DEFUN, LABELS, FLET, and
SB-INT:NAMED-LET.
You can trace a memoized function by :TRACE option:
\(with-cache (:array (10 10) :initial-element -1 :trace t)
(defun foo (x y) ...))
Then FOO is traced as with CL:TRACE.
"
(multiple-value-bind (cache-symbol cache-form cache-type
make-reset-name make-reset-form
make-cache-querier)
(%parse-cache-form (cons cache-type cache-attribs))
(ecase (car def-form)
((defun)
(destructuring-bind (_ name args &body body) def-form
(declare (ignore _))
`(let ((,cache-symbol ,cache-form))
(defun ,(funcall make-reset-name name) ()
,(funcall make-reset-form cache-type))
(defun ,name ,args
,@(%extract-declarations body)
(flet ((,name ,args ,@body))
(declare (inline ,name))
,(funcall make-cache-querier cache-type name args))))))
((labels flet)
(destructuring-bind (_ definitions &body labels-body) def-form
(declare (ignore _))
(destructuring-bind (name args &body body) (car definitions)
`(let ((,cache-symbol ,cache-form))
(,(car def-form)
((,(funcall make-reset-name name) ()
,(funcall make-reset-form cache-type))
(,name ,args
,@(%extract-declarations body)
(flet ((,name ,args ,@body))
(declare (inline ,name))
,(funcall make-cache-querier cache-type name args)))
,@(cdr definitions))
(declare (ignorable #',(funcall make-reset-name name)))
,@labels-body)))))
((nlet #+sbcl sb-int:named-let)
(destructuring-bind (_ name bindings &body body) def-form
(declare (ignore _))
`(let ((,cache-symbol ,cache-form))
(,(car def-form) ,name ,bindings
,@(%extract-declarations body)
,(let ((args (mapcar (lambda (x) (if (atom x) x (car x))) bindings)))
`(flet ((,name ,args ,@body))
(declare (inline ,name))
,(funcall make-cache-querier cache-type name args))))))))))
(defmacro with-caches (cache-specs def-form)
"DEF-FORM := definition form by LABELS or FLET.
\(with-caches (cache-spec1 cache-spec2)
(labels ((f (x) ...) (g (y) ...))))
is equivalent to the line up of
\(with-cache cache-spec1 (labels ((f (x) ...))))
and
\(with-cache cache-spec2 (labels ((g (y) ...))))
This macro will be useful to do mutual recursion between memoized local
functions."
(assert (member (car def-form) '(labels flet)))
(let (cache-symbol-list cache-form-list cache-type-list make-reset-name-list make-reset-form-list make-cache-querier-list)
(dolist (cache-spec (reverse cache-specs))
(multiple-value-bind (cache-symbol cache-form cache-type
make-reset-name make-reset-form make-cache-querier)
(%parse-cache-form cache-spec)
(push cache-symbol cache-symbol-list)
(push cache-form cache-form-list)
(push cache-type cache-type-list)
(push make-reset-name make-reset-name-list)
(push make-reset-form make-reset-form-list)
(push make-cache-querier make-cache-querier-list)))
(labels ((def-name (def) (first def))
(def-args (def) (second def))
(def-body (def) (cddr def)))
(destructuring-bind (_ definitions &body labels-body) def-form
(declare (ignore _))
`(let ,(loop for cache-symbol in cache-symbol-list
for cache-form in cache-form-list
collect `(,cache-symbol ,cache-form))
(,(car def-form)
(,@(loop for def in definitions
for cache-type in cache-type-list
for make-reset-name in make-reset-name-list
for make-reset-form in make-reset-form-list
collect `(,(funcall make-reset-name (def-name def)) ()
,(funcall make-reset-form cache-type)))
,@(loop for def in definitions
for cache-type in cache-type-list
for make-cache-querier in make-cache-querier-list
collect `(,(def-name def) ,(def-args def)
,@(%extract-declarations (def-body def))
(flet ((,(def-name def) ,(def-args def) ,@(def-body def)))
(declare (inline ,(def-name def)))
,(funcall make-cache-querier cache-type (def-name def) (def-args def))))))
(declare (ignorable ,@(loop for def in definitions
for make-reset-name in make-reset-name-list
collect `#',(funcall make-reset-name
(def-name def)))))
,@labels-body))))))
;;;
;;; Some operations on symmetric group
;;;
(defpackage :cp/symmetric-group
(:use :cl)
(:export #:decompose-to-cycles #:perm* #:perm-inverse #:iota))
(in-package :cp/symmetric-group)
;; NOTE: Here the underlying set is 0-based: {0, 1, 2, ..., N-1}
(declaim (inline decompose-to-cycles))
(defun decompose-to-cycles (permutation)
"Returns the list of all the cyclic permutations in PERMUTATION and returns
its the distance to the identity permutation, (0, 1, ..., N-1),
w.r.t. swapping."
(declare (vector permutation))
(let* ((n (length permutation))
result
(visited (make-array n :element-type 'bit :initial-element 0))
(sign 0))
(declare ((integer 0 #.most-positive-fixnum) sign))
(dotimes (init n)
(when (zerop (sbit visited init))
(push (loop for x = init then (aref permutation x)
until (= (sbit visited x) 1)
collect x
do (setf (sbit visited x) 1)
(incf sign))
result)
(decf sign)))
(values result sign)))
(declaim (inline perm*))
(defun perm* (perm1 perm2)
"Composes two permutations. (Actually the arguments doesn't need to be
permutations. This is just a composition of two maps.)"
(let* ((n (length perm1))
(result (make-array n :element-type (array-element-type perm2))))
(dotimes (i n)
(setf (aref result i) (aref perm2 (aref perm1 i))))
result))
(declaim (inline perm-inverse))
(defun perm-inverse (perm)
"Returns the inverse of a given permutation."
(let* ((n (length perm))
(result (make-array n :element-type 'fixnum)))
(dotimes (i n)
(setf (aref result (aref perm i)) i))
result))
(declaim (inline iota))
(defun iota (size)
"Returns #(0 1 2 ... SIZE-1)."
(declare ((integer 0 #.most-positive-fixnum) size))
(let ((result (make-array size :element-type 'fixnum)))
(dotimes (i size)
(setf (aref result i) i))
result))
;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/symmetric-group :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/with-cache :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/mod-operations :cl-user))
(in-package :cl-user)
;;;
;;; Body
;;;
(defun main ()
(declare #.*opt*)
(let* ((n (read))
(m (read))
(ps (make-array n :element-type 'uint31 :initial-element 0)))
(dotimes (i n)
(setf (aref ps i) (- (read) 1)))
(let ((cycles (decompose-to-cycles ps))
;; 1: 巡回置換の先頭, -1: 巡回置換の末尾
(signs (make-array n :element-type 'int8 :initial-element 0)))
(let ((sum 0))
(loop for cycle in cycles
for len = (length cycle)
do (setf (aref signs sum) 1
(aref signs (+ sum len -1)) -1)
(incf sum len)))
#>signs
(println
(with-cache (:array (5001 5001 2) :element-type 'uint31 :initial-element #x7fffffff)
(sb-int:named-let dp ((x n) (y m) (f 0))
(declare (uint31 x y f))
(cond ((= x y 0)
(if (zerop f) 1 0))
((or (= x 0) (= y 0)) 0)
((= f 0)
(if (= (aref signs (- x 1)) 1)
0 ; 先頭の場合は先頭と同じ箱でないとだめ
(let ((res 0))
(declare (uint31 res))
(incfmod res (dp (- x 1) (- y 1) 0))
(incfmod res (dp (- x 1) (- y 1) 1))
(incfmod res (mod* (max 0 (- y 2)) (dp (- x 1) y 0)))
(incfmod res (mod* (- y 1) (dp (- x 1) y 1)))
res)))
((= f 1)
(ecase (aref signs (- x 1))
(-1 0) ; 末尾の場合は先頭と違う箱でないとだめ
(1 (mod+ (dp (- x 1) (- y 1) 0)
(dp (- x 1) (- y 1) 1)
(mod* y (dp (- x 1) y 0))
(mod* y (dp (- x 1) y 1))))
(0 (dp (- x 1) y 0))))
(t (error "Huh?")))))))))
#-swank (main)
;;;
;;; Test
;;;
#+swank
(progn
(defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname))
(setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*))
(uiop:chdir *default-pathname-defaults*)
(defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*))
(defparameter *problem-url* "https://yukicoder.me/problems/no/1392"))
#+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)))
#+(and sbcl (not swank))
(eval-when (:compile-toplevel)
(when sb-c::*undefined-warnings*
(error "undefined warnings: ~{~A~^ ~}" sb-c::*undefined-warnings*)))
;; To run: (5am:run! :sample)
#+swank
(5am:test :sample
(5am:is
(equal "2
"
(run "4 2
2 1 4 3
" nil)))
(5am:is
(equal "0
"
(run "3 2
2 3 1
" nil)))
(5am:is
(equal "136233051
"
(run "20 11
14 10 11 20 19 8 4 15 12 17 3 16 5 18 2 6 7 9 1 13
" nil))))