(eval-when (:compile-toplevel :load-toplevel :execute) (sb-int:defconstant-eqx OPT #+swank '(optimize (speed 3) (safety 2)) #-swank '(optimize (speed 3) (safety 0) (debug 0)) #'equal) #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t) #-swank (set-dispatch-macro-character ;; enclose the form with VALUES to avoid being captured by LOOP macro #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))) #+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax) #-swank (disable-debugger) ; for CS Academy ;; BEGIN_INSERTED_CONTENTS (declaim (ftype (function * (values fixnum &optional)) read-fixnum)) (defun read-fixnum (&optional (in *standard-input*)) "NOTE: cannot read -2^62" (macrolet ((%read-byte () `(the (unsigned-byte 8) #+swank (char-code (read-char in nil #\Nul)) #-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil)))) (let* ((minus nil) (result (loop (let ((byte (%read-byte))) (cond ((<= 48 byte 57) (return (- byte 48))) ((zerop byte) ; #\Nul (error "Read EOF or #\Nul.")) ((= byte #.(char-code #\-)) (setf minus t))))))) (declare ((integer 0 #.most-positive-fixnum) result)) (loop (let* ((byte (%read-byte))) (if (<= 48 byte 57) (setq result (+ (- byte 48) (* 10 (the (integer 0 #.(floor most-positive-fixnum 10)) result)))) (return (if minus (- result) result)))))))) ;;; ;;; Arithmetic operations with static modulus ;;; ;; FIXME: Currently MOD* and MOD+ doesn't apply MOD when the number of ;; parameters is one. (defmacro define-mod-operations (divisor) `(progn (defun mod* (&rest args) (reduce (lambda (x y) (mod (* x y) ,divisor)) args)) (sb-c:define-source-transform mod* (&rest args) (if (null args) 1 (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args))) (defun mod+ (&rest args) (reduce (lambda (x y) (mod (+ x y) ,divisor)) args)) (sb-c:define-source-transform mod+ (&rest args) (if (null args) 0 (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args))) (defun mod- (&rest args) (reduce (lambda (x y) (mod (- x y) ,divisor)) args)) (sb-c:define-source-transform mod- (&rest args) (if (null args) 0 (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))))) ;;; ;;; Modular arithmetic ;;; ;; Blankinship algorithm ;; Reference: https://topcoder.g.hatena.ne.jp/spaghetti_source/20130126/1359171466 (Japanese) (declaim (ftype (function * (values fixnum fixnum &optional)) %ext-gcd)) (defun %ext-gcd (a b) (declare (optimize (speed 3) (safety 0)) (fixnum a b)) (let ((y 1) (x 0) (u 1) (v 0)) (declare (fixnum y x u v)) (loop (when (zerop a) (return (values x y))) (let ((q (floor b a))) (decf x (the fixnum (* q u))) (rotatef x u) (decf y (the fixnum (* q v))) (rotatef y v) (decf b (the fixnum (* q a))) (rotatef b a))))) ;; recursive version ;; (defun %ext-gcd (a b) ;; (declare (optimize (speed 3) (safety 0)) ;; (fixnum a b)) ;; (if (zerop b) ;; (values 1 0) ;; (multiple-value-bind (p q) (floor a b) ; a = pb + q ;; (multiple-value-bind (v u) (%ext-gcd b q) ;; (declare (fixnum u v)) ;; (values u (the fixnum (- v (the fixnum (* p u))))))))) ;; TODO: deal with bignums (declaim (inline ext-gcd)) (defun ext-gcd (a b) "Returns two integers X and Y which satisfy AX + BY = gcd(A, B)." (declare ((integer #.(- most-positive-fixnum) #.most-positive-fixnum) a b)) (if (>= a 0) (if (>= b 0) (%ext-gcd a b) (multiple-value-bind (x y) (%ext-gcd a (- b)) (declare (fixnum x y)) (values x (- y)))) (if (>= b 0) (multiple-value-bind (x y) (%ext-gcd (- a) b) (declare (fixnum x y)) (values (- x) y)) (multiple-value-bind (x y) (%ext-gcd (- a) (- b)) (declare (fixnum x y)) (values (- x) (- y)))))) (declaim (inline mod-inverse) (ftype (function * (values (mod #.most-positive-fixnum) &optional)) mod-inverse)) ;; (defun mod-inverse (a modulus) ;; "Solves ax ≡ 1 mod m. A and M must be coprime." ;; (declare (integer a) ;; ((integer 1 #.most-positive-fixnum) modulus)) ;; (mod (%ext-gcd (mod a modulus) modulus) modulus)) (defun mod-inverse (a modulus) (declare ((integer 1 #.most-positive-fixnum) modulus)) (let ((a (mod a modulus)) (b modulus) (u 1) (v 0)) (declare (fixnum a b u v)) (loop until (zerop b) for quot = (floor a b) do (decf a (the fixnum (* quot b))) (rotatef a b) (decf u (the fixnum (* quot v))) (rotatef u v)) (setq u (mod u modulus)) (if (< u 0) (+ u modulus) u))) ;; not tested ;; TODO: move to another file (declaim (inline binomial)) (defun mod-binomial (n k modulus) (declare ((integer 0 #.most-positive-fixnum) modulus)) (if (or (< n k) (< n 0) (< k 0)) 0 (let ((k (if (< k (- n k)) k (- n k))) (num 1) (denom 1)) (declare ((integer 0) k num denom)) (loop for x from n above (- n k) do (setq num (mod (* num x) modulus))) (loop for x from 1 to k do (setq denom (mod (* denom x) modulus))) (mod (* num (mod-inverse denom modulus)) modulus)))) (declaim (ftype (function * (values (or null (integer 1 #.most-positive-fixnum)) &optional)) mod-log)) (defun mod-log (x y modulus) "Returns the smallest positive integer k that satiefies x^k ≡ y mod p. Returns NIL if it is infeasible." (declare (optimize (speed 3)) (integer x y) ((integer 1 #.most-positive-fixnum) modulus)) (let ((x (mod x modulus)) (y (mod y modulus)) (g (gcd x modulus))) (declare (optimize (safety 0)) ((mod #.most-positive-fixnum) x y g)) (if (= g 1) ;; coprime case (let* ((m (+ 1 (isqrt (- modulus 1)))) ; smallest integer equal to or ; larger than sqrt(p) (x^m (loop for i below m for res of-type (integer 0 #.most-positive-fixnum) = x then (mod (* res x) modulus) finally (return res))) (table (make-hash-table :size m :test 'eq))) ;; Constructs TABLE: yx^j |-> j (j = 0, ..., m-1) (loop for j from 0 below m for res of-type (integer 0 #.most-positive-fixnum) = y then (mod (* res x) modulus) do (setf (gethash res table) j)) ;; Finds i and j that satisfy (x^m)^i = yx^j and returns m*i-j (loop for i from 1 to m for x^m^i of-type (integer 0 #.most-positive-fixnum) = x^m then (mod (* x^m^i x^m) modulus) for j = (gethash x^m^i table) when j do (locally (declare ((integer 0 #.most-positive-fixnum) j)) (return (- (* i m) j))) finally (return nil))) ;; If x and p are not coprime, let g := gcd(x, p), x := gx', y := gy', p ;; := gp' and solve x^(k-1) ≡ y'x'^(-1) mod p' instead. See ;; https://math.stackexchange.com/questions/131127/ for the detail. (if (= x y) ;; This is tha special treatment for the case x ≡ y. Without this ;; (mod-log 4 0 4) returns not 1 but 2. 1 (multiple-value-bind (y-prime rem) (floor y g) (if (zerop rem) (let* ((x-prime (floor x g)) (p-prime (floor modulus g)) (next-rhs (mod (* y-prime (mod-inverse x-prime p-prime)) p-prime)) (res (mod-log x next-rhs p-prime))) (declare ((integer 0 #.most-positive-fixnum) x-prime p-prime next-rhs)) (if res (+ 1 res) nil)) nil)))))) (declaim (inline %calc-min-factor)) (defun %calc-min-factor (x alpha) "Returns k, so that x+k*alpha is the smallest non-negative number." (if (plusp alpha) (ceiling (- x) alpha) (floor (- x) alpha))) (declaim (inline %calc-max-factor)) (defun %calc-max-factor (x alpha) "Returns k, so that x+k*alpha is the largest non-positive number." (if (plusp alpha) (floor (- x) alpha) (ceiling (- x) alpha))) (defun solve-bezout (a b c &optional min max) "Returns an integer solution of a*x+b*y = c if it exists, otherwise returns (VALUES NIL NIL). If MIN is specified and MAX is null, the returned x is the smallest integer equal to or larger than MIN. If MAX is specified and MIN is null, x is the largest integer equal to or smaller than MAX. If the both are specified, x is an integer in [MIN, MAX]. This function returns NIL when no x that satisfies the given condition exists." (declare (fixnum a b c) ((or null fixnum) min max)) (let ((gcd-ab (gcd a b))) (if (zerop (mod c gcd-ab)) (multiple-value-bind (init-x init-y) (ext-gcd a b) (let* ((factor (floor c gcd-ab)) ;; m*x0 + n*y0 = d (x0 (* init-x factor)) (y0 (* init-y factor))) (if (and (null min) (null max)) (values x0 y0) (let (;; general solution: x = x0 + kΔx, y = y0 - kΔy (deltax (floor b gcd-ab)) (deltay (floor a gcd-ab))) (if min (let* ((k-min (%calc-min-factor (- x0 min) deltax)) (x (+ x0 (* k-min deltax))) (y (- y0 (* k-min deltay)))) (if (and max (> x max)) (values nil nil) (values x y))) (let* ((k-max (%calc-max-factor (- x0 max) deltax)) (x (+ x0 (* k-max deltax))) (y (- y0 (* k-max deltay)))) (if (<= x max) (values x y) (values nil nil)))))))) (values nil nil)))) ;; Reference: http://drken1215.hatenablog.com/entry/2019/03/20/202800 (declaim (inline mod-echelon!)) (defun mod-echelon! (matrix modulus &optional extended) "Returns the row echelon form of MATRIX by gaussian elimination and returns the rank as the second value. This function destructively modifies MATRIX." (declare ((integer 1 #.most-positive-fixnum) modulus)) (destructuring-bind (m n) (array-dimensions matrix) (declare ((integer 0 #.most-positive-fixnum) m n)) (dotimes (i m) (dotimes (j n) (setf (aref matrix i j) (mod (aref matrix i j) modulus)))) (let ((rank 0)) (dotimes (target-col (if extended (- n 1) n)) (let ((pivot-row (do ((i rank (+ 1 i))) ((= i m) -1) (unless (zerop (aref matrix i target-col)) (return i))))) (when (>= pivot-row 0) ;; swap rows (loop for j from target-col below n do (rotatef (aref matrix rank j) (aref matrix pivot-row j))) (let ((inv (mod-inverse (aref matrix rank target-col) modulus))) (dotimes (j n) (setf (aref matrix rank j) (mod (* inv (aref matrix rank j)) modulus))) (dotimes (i m) (unless (or (= i rank) (zerop (aref matrix i target-col))) (let ((factor (aref matrix i target-col))) (loop for j from target-col below n do (setf (aref matrix i j) (mod (- (aref matrix i j) (mod (* (aref matrix rank j) factor) modulus)) modulus))))))) (incf rank)))) (values matrix rank)))) (declaim (inline mod-inverse-matrix!)) (defun mod-inverse-matrix! (matrix modulus) "Returns the inverse of MATRIX by gaussian elimination if it exists and returns NIL otherwise. This function destructively modifies MATRIX." (declare ((integer 1 #.most-positive-fixnum) modulus)) (destructuring-bind (m n) (array-dimensions matrix) (declare ((integer 0 #.most-positive-fixnum) m n)) (assert (= m n)) (dotimes (i n) (dotimes (j n) (setf (aref matrix i j) (mod (aref matrix i j) modulus)))) (let ((result (make-array (list n n) :element-type (array-element-type matrix)))) (dotimes (i n) (setf (aref result i i) 1)) (dotimes (target n) (let ((pivot-row (do ((i target (+ 1 i))) ((= i n) -1) (unless (zerop (aref matrix i target)) (return i))))) (when (= pivot-row -1) ; when singular (return-from mod-inverse-matrix! nil)) (loop for j from target below n do (rotatef (aref matrix target j) (aref matrix pivot-row j)) (rotatef (aref result target j) (aref result pivot-row j))) (let ((inv (mod-inverse (aref matrix target target) modulus))) ;; process the pivot row (dotimes (j n) (setf (aref matrix target j) (mod (* inv (aref matrix target j)) modulus)) (setf (aref result target j) (mod (* inv (aref result target j)) modulus))) ;; eliminate the column (dotimes (i n) (unless (or (= i target) (zerop (aref matrix i target))) (let ((factor (aref matrix i target))) (dotimes (j n) (setf (aref matrix i j) (mod (- (aref matrix i j) (mod (* (aref matrix target j) factor) modulus)) modulus)) (setf (aref result i j) (mod (- (aref result i j) (mod (* (aref result target j) factor) modulus)) modulus))))))))) result))) (declaim (inline mod-solve-linear-system)) (defun mod-solve-linear-system (matrix vector modulus) "Solves Ax ≡ b and returns a root vector if it exists. Otherwise it returns NIL. In addition, this function returns the rank of A as the second value." (destructuring-bind (m n) (array-dimensions matrix) (declare ((integer 0 #.most-positive-fixnum) m n)) (assert (= n (length vector))) (let ((extended (make-array (list m (+ n 1)) :element-type (array-element-type matrix)))) (dotimes (i m) (dotimes (j n) (setf (aref extended i j) (aref matrix i j))) (setf (aref extended i n) (aref vector i))) (let ((rank (nth-value 1 (mod-echelon! extended modulus t)))) (if (loop for i from rank below m always (zerop (aref extended i n))) (let ((result (make-array m :element-type (array-element-type matrix) :initial-element 0))) (dotimes (i rank) (setf (aref result i) (aref extended i n))) (values result rank)) (values nil rank)))))) (declaim (inline power-mod)) (defun power-mod (base power modulus) "BASE := integer POWER, MODULUS := non-negative fixnum" (declare ((integer 0 #.most-positive-fixnum) modulus power) (integer base)) (labels ((recur (x p) (declare ((integer 0 #.most-positive-fixnum) x p) (values (integer 0 #.most-positive-fixnum))) (cond ((zerop p) 1) ((evenp p) (recur (mod (* x x) modulus) (ash p -1))) (t (mod (* x (recur x (- p 1))) modulus))))) (recur (mod base modulus) power))) (defmacro dbg (&rest forms) #+swank (if (= (length forms) 1) `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms)) `(format *error-output* "~A => ~A~%" ',forms `(,,@forms))) #-swank (declare (ignore forms))) (defmacro define-int-types (&rest bits) `(progn ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits) ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits))) (define-int-types 2 4 7 8 15 16 31 32 62 63 64) (declaim (inline println)) (defun println (obj &optional (stream *standard-output*)) (let ((*read-default-float-format* 'double-float)) (prog1 (princ obj stream) (terpri stream)))) (defconstant +mod+ 1000000007) ;;; ;;; Body ;;; (define-mod-operations +mod+) (defun main () (let* ((n (read)) (m (read)) (k (read)) (p (read)) (q (read)) (p/q (mod* p (mod-inverse q +mod+))) (even-factor (mod* 500000004 (mod+ 1 (power-mod (mod (- 1 (* 2 p/q)) +mod+) k +mod+)))) (odd-factor (mod* 500000004 (mod- 1 (power-mod (mod (- 1 (* 2 p/q)) +mod+) k +mod+)))) (b1 0) (b2 0)) (loop for i below n for b = (read-fixnum) do (if (< i m) (incf b1 b) (incf b2 b))) (println (mod+ (mod* even-factor b1) (mod* odd-factor b2))))) #-swank (main) ;;; ;;; Test and benchmark ;;; #+swank (defun io-equal (in-string out-string &key (function #'main) (test #'equal)) "Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true if the string output to *STANDARD-OUTPUT* is equal to OUT-STRING." (labels ((ensure-last-lf (s) (if (eql (uiop:last-char s) #\Linefeed) s (uiop:strcat s uiop:+lf+)))) (funcall test (ensure-last-lf out-string) (with-output-to-string (out) (let ((*standard-output* out)) (with-input-from-string (*standard-input* (ensure-last-lf in-string)) (funcall function))))))) #+swank (defun get-clipbrd () (with-output-to-string (out) (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t))) #+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname)) #+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*)) #+swank (defun run (&optional thing (out *standard-output*)) "THING := null | string | symbol | pathname null: run #'MAIN using the text on clipboard as input. string: run #'MAIN using the string as input. symbol: alias of FIVEAM:RUN!. pathname: run #'MAIN using the text file as input." (let ((*standard-output* out)) (etypecase thing (null (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd))) (main))) (string (with-input-from-string (*standard-input* (delete #\Return thing)) (main))) (symbol (5am:run! thing)) (pathname (with-open-file (*standard-input* thing) (main)))))) #+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)))