結果
| 問題 | No.1392 Don't be together |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-02-12 22:18:57 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 1,607 ms / 2,000 ms |
| コード長 | 21,222 bytes |
| コンパイル時間 | 490 ms |
| コンパイル使用メモリ | 79,768 KB |
| 実行使用メモリ | 219,904 KB |
| 最終ジャッジ日時 | 2024-07-19 22:38:21 |
| 合計ジャッジ時間 | 27,826 ms |
|
ジャッジサーバーID （参考情報） |
judge1 / judge3 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 142 ms
219,136 KB |
| testcase_01 | AC | 136 ms
219,264 KB |
| testcase_02 | AC | 137 ms
219,136 KB |
| testcase_03 | AC | 138 ms
219,136 KB |
| testcase_04 | AC | 136 ms
219,264 KB |
| testcase_05 | AC | 159 ms
219,136 KB |
| testcase_06 | AC | 1,038 ms
219,776 KB |
| testcase_07 | AC | 1,607 ms
219,776 KB |
| testcase_08 | AC | 1,500 ms
219,776 KB |
| testcase_09 | AC | 1,496 ms
219,776 KB |
| testcase_10 | AC | 1,303 ms
219,776 KB |
| testcase_11 | AC | 1,583 ms
219,904 KB |
| testcase_12 | AC | 1,272 ms
219,776 KB |
| testcase_13 | AC | 1,502 ms
219,776 KB |
| testcase_14 | AC | 1,578 ms
219,648 KB |
| testcase_15 | AC | 1,301 ms
219,776 KB |
| testcase_16 | AC | 1,584 ms
219,776 KB |
| testcase_17 | AC | 1,350 ms
219,776 KB |
| testcase_18 | AC | 1,562 ms
219,904 KB |
| testcase_19 | AC | 1,456 ms
219,776 KB |
| testcase_20 | AC | 525 ms
219,392 KB |
| testcase_21 | AC | 270 ms
219,392 KB |
| testcase_22 | AC | 967 ms
219,648 KB |
| testcase_23 | AC | 627 ms
219,520 KB |
| testcase_24 | AC | 465 ms
219,648 KB |
| testcase_25 | AC | 688 ms
219,648 KB |
| testcase_26 | AC | 263 ms
219,392 KB |
| testcase_27 | AC | 387 ms
219,520 KB |
| testcase_28 | AC | 625 ms
219,520 KB |
| testcase_29 | AC | 381 ms
219,520 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 19 JUL 2024 10:37:51 PM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MAIN ; (ERROR "Huh?") ; ; note: deleting unreachable code ; ; compilation unit finished ; printed 1 note ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.311
ソースコード
(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))))