結果
| 問題 | No.1392 Don't be together |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-02-12 22:20:10 |
| 言語 | Common Lisp (sbcl 2.3.8) |
| 結果 |
AC
|
| 実行時間 | 719 ms / 2,000 ms |
| コード長 | 21,189 bytes |
| コンパイル時間 | 404 ms |
| コンパイル使用メモリ | 71,680 KB |
| 実行使用メモリ | 219,904 KB |
| 最終ジャッジ日時 | 2024-07-19 22:41:09 |
| 合計ジャッジ時間 | 14,177 ms |
|
ジャッジサーバーID （参考情報） |
judge2 / judge1 |
（要ログイン）
テストケース
テストケース表示| 入力 | 結果 | 実行時間 実行使用メモリ |
|---|---|---|
| testcase_00 | AC | 121 ms
219,264 KB |
| testcase_01 | AC | 121 ms
219,392 KB |
| testcase_02 | AC | 122 ms
219,264 KB |
| testcase_03 | AC | 117 ms
219,264 KB |
| testcase_04 | AC | 115 ms
219,392 KB |
| testcase_05 | AC | 127 ms
219,264 KB |
| testcase_06 | AC | 487 ms
219,776 KB |
| testcase_07 | AC | 719 ms
219,776 KB |
| testcase_08 | AC | 665 ms
219,776 KB |
| testcase_09 | AC | 681 ms
219,904 KB |
| testcase_10 | AC | 611 ms
219,904 KB |
| testcase_11 | AC | 705 ms
219,904 KB |
| testcase_12 | AC | 587 ms
219,648 KB |
| testcase_13 | AC | 671 ms
219,904 KB |
| testcase_14 | AC | 687 ms
219,648 KB |
| testcase_15 | AC | 596 ms
219,776 KB |
| testcase_16 | AC | 706 ms
219,776 KB |
| testcase_17 | AC | 607 ms
219,648 KB |
| testcase_18 | AC | 669 ms
219,648 KB |
| testcase_19 | AC | 642 ms
219,648 KB |
| testcase_20 | AC | 272 ms
219,520 KB |
| testcase_21 | AC | 161 ms
219,264 KB |
| testcase_22 | AC | 460 ms
219,648 KB |
| testcase_23 | AC | 315 ms
219,392 KB |
| testcase_24 | AC | 247 ms
219,392 KB |
| testcase_25 | AC | 331 ms
219,648 KB |
| testcase_26 | AC | 162 ms
219,392 KB |
| testcase_27 | AC | 212 ms
219,520 KB |
| testcase_28 | AC | 312 ms
219,648 KB |
| testcase_29 | AC | 209 ms
219,392 KB |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 19 JUL 2024 10:40:52 PM): ; 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.228
ソースコード
(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))))