結果
問題 | No.1392 Don't be together |
ユーザー |
|
提出日時 | 2021-02-12 22:18:57 |
言語 | Common Lisp (sbcl 2.5.0) |
結果 |
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 |
(要ログイン)
ファイルパターン | 結果 |
---|---|
sample | AC * 3 |
other | AC * 27 |
コンパイルメッセージ
; 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 argsunless (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 ofarguments. In this case ADD stores the key (CONS A B) and the returned value toa hash-table when (ADD A B) is evaluated for the first time. When it is calledwith the same arguments (w.r.t. EQUAL) again, ADD will return the stored valueinstead of recomputing it.The storage for cache can be hash-table or array. Let's see an example forarray:\(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 createdby (make-array (list 10 20 30) :initial-element -1 :element-type 'fixnum). Notethat INITIAL-ELEMENT must always be given here as it is used as the flagexpressing `not yet stored'. (Therefore INITIAL-ELEMENT should be a value FOOnever 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 cacheAvailable definition forms in WITH-CACHE are DEFUN, LABELS, FLET, andSB-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-typemake-reset-name make-reset-formmake-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 localfunctions."(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-typemake-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-listfor cache-form in cache-form-listcollect `(,cache-symbol ,cache-form))(,(car def-form)(,@(loop for def in definitionsfor cache-type in cache-type-listfor make-reset-name in make-reset-name-listfor make-reset-form in make-reset-form-listcollect `(,(funcall make-reset-name (def-name def)) (),(funcall make-reset-form cache-type))),@(loop for def in definitionsfor cache-type in cache-type-listfor make-cache-querier in make-cache-querier-listcollect `(,(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 definitionsfor make-reset-name in make-reset-name-listcollect `#',(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 returnsits 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 xdo (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 bepermutations. 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 cyclesfor 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 22 1 4 3" nil)))(5am:is(equal "0"(run "3 22 3 1" nil)))(5am:is(equal "136233051"(run "20 1114 10 11 20 19 8 4 15 12 17 3 16 5 18 2 6 7 9 1 13" nil))))