結果
| 問題 | No.1392 Don't be together |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-02-12 22:18:57 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 1,323 ms / 2,000 ms |
| コード長 | 21,222 bytes |
| コンパイル時間 | 1,356 ms |
| コンパイル使用メモリ | 76,548 KB |
| 実行使用メモリ | 225,184 KB |
| 最終ジャッジ日時 | 2023-09-27 04:44:33 |
| 合計ジャッジ時間 | 23,778 ms |
|
ジャッジサーバーID （参考情報） |
judge12 / judge14 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 73 ms
224,916 KB |
| testcase_01 | AC | 74 ms
223,208 KB |
| testcase_02 | AC | 73 ms
221,208 KB |
| testcase_03 | AC | 73 ms
223,208 KB |
| testcase_04 | AC | 72 ms
221,156 KB |
| testcase_05 | AC | 71 ms
221,172 KB |
| testcase_06 | AC | 848 ms
221,664 KB |
| testcase_07 | AC | 1,323 ms
221,572 KB |
| testcase_08 | AC | 1,231 ms
224,956 KB |
| testcase_09 | AC | 1,275 ms
224,792 KB |
| testcase_10 | AC | 1,021 ms
223,300 KB |
| testcase_11 | AC | 1,289 ms
225,184 KB |
| testcase_12 | AC | 977 ms
221,556 KB |
| testcase_13 | AC | 1,195 ms
224,720 KB |
| testcase_14 | AC | 1,247 ms
223,180 KB |
| testcase_15 | AC | 1,019 ms
221,568 KB |
| testcase_16 | AC | 1,289 ms
225,028 KB |
| testcase_17 | AC | 1,066 ms
221,576 KB |
| testcase_18 | AC | 1,253 ms
221,576 KB |
| testcase_19 | AC | 1,170 ms
221,572 KB |
| testcase_20 | AC | 454 ms
225,044 KB |
| testcase_21 | AC | 199 ms
223,308 KB |
| testcase_22 | AC | 805 ms
221,520 KB |
| testcase_23 | AC | 542 ms
221,408 KB |
| testcase_24 | AC | 391 ms
221,504 KB |
| testcase_25 | AC | 593 ms
221,420 KB |
| testcase_26 | AC | 201 ms
224,972 KB |
| testcase_27 | AC | 309 ms
221,472 KB |
| testcase_28 | AC | 560 ms
221,384 KB |
| testcase_29 | AC | 319 ms
221,364 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 27 SEP 2023 04:44:04 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 ; processing (MAIN); ; compilation unit finished ; printed 1 note ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.231
ソースコード
(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 ()
(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
;; :trace t
)
(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))))