結果
| 問題 | No.1392 Don't be together |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-02-13 01:56:03 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 739 ms / 2,000 ms |
| コード長 | 21,133 bytes |
| コンパイル時間 | 1,473 ms |
| コンパイル使用メモリ | 78,656 KB |
| 実行使用メモリ | 219,776 KB |
| 最終ジャッジ日時 | 2024-07-20 03:20:41 |
| 合計ジャッジ時間 | 15,680 ms |
|
ジャッジサーバーID （参考情報） |
judge1 / judge3 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 140 ms
219,136 KB |
| testcase_01 | AC | 141 ms
219,264 KB |
| testcase_02 | AC | 140 ms
219,136 KB |
| testcase_03 | AC | 139 ms
219,264 KB |
| testcase_04 | AC | 141 ms
219,264 KB |
| testcase_05 | AC | 141 ms
219,136 KB |
| testcase_06 | AC | 514 ms
219,776 KB |
| testcase_07 | AC | 710 ms
219,776 KB |
| testcase_08 | AC | 708 ms
219,776 KB |
| testcase_09 | AC | 688 ms
219,648 KB |
| testcase_10 | AC | 646 ms
219,716 KB |
| testcase_11 | AC | 715 ms
219,776 KB |
| testcase_12 | AC | 618 ms
219,776 KB |
| testcase_13 | AC | 685 ms
219,776 KB |
| testcase_14 | AC | 705 ms
219,776 KB |
| testcase_15 | AC | 618 ms
219,776 KB |
| testcase_16 | AC | 739 ms
219,776 KB |
| testcase_17 | AC | 632 ms
219,776 KB |
| testcase_18 | AC | 716 ms
219,776 KB |
| testcase_19 | AC | 692 ms
219,776 KB |
| testcase_20 | AC | 284 ms
219,520 KB |
| testcase_21 | AC | 187 ms
219,392 KB |
| testcase_22 | AC | 482 ms
219,648 KB |
| testcase_23 | AC | 332 ms
219,520 KB |
| testcase_24 | AC | 277 ms
219,520 KB |
| testcase_25 | AC | 368 ms
219,520 KB |
| testcase_26 | AC | 189 ms
219,392 KB |
| testcase_27 | AC | 232 ms
219,520 KB |
| testcase_28 | AC | 324 ms
219,520 KB |
| testcase_29 | AC | 222 ms
219,392 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 20 JUL 2024 03:20:24 AM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MAIN ; (LENGTH CYCLE) ; ; note: unable to ; optimize ; due to type uncertainty: ; The first argument is a SEQUENCE, not a VECTOR. ; (- (READ) 1) ; ; note: forced to do GENERIC-- (cost 10) ; unable to do inline fixnum arithmetic (cost 1) because: ; The first argument is a NUMBER, not a FIXNUM. ; unable to do inline fixnum arithmetic (cost 2) because: ; The first argument is a NUMBER, not a FIXNUM. ; etc. ; (ERROR "Huh?") ; ; note: deleting unreachable code ; ; compilation unit finished ; printed 3 notes ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.338
ソースコード
(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)))
(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 ; 先頭の場合は先頭と同じ箱でないとだめ
(mod (+ (dp (- x 1) (- y 1) 0)
(dp (- x 1) (- y 1) 1)
(mod* (max 0 (- y 2)) (dp (- x 1) y 0))
(mod* (the uint31 (- y 1)) (dp (- x 1) y 1)))
+mod+)))
((= 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 (mod+ (dp (- x 1) y 0)
(dp (- x 1) y 1))))
+mod+))
(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))))