結果
| 問題 |
No.551 夏休みの思い出（２）
|
| コンテスト | |
| ユーザー |
 sansaqua
|
| 提出日時 | 2021-11-21 20:08:00 |
| 言語 | Common Lisp (sbcl 2.5.0) |
| 結果 |
AC
|
| 実行時間 | 37 ms / 4,000 ms |
| コード長 | 10,398 bytes |
| コンパイル時間 | 1,339 ms |
| コンパイル使用メモリ | 78,428 KB |
| 実行使用メモリ | 23,424 KB |
| 最終ジャッジ日時 | 2024-06-23 02:23:42 |
| 合計ジャッジ時間 | 3,610 ms |
|
ジャッジサーバーID （参考情報） |
judge5 / judge4 |
（要ログイン）
| ファイルパターン | 結果 |
|---|---|
| sample | AC * 2 |
| other | AC * 47 |
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 23 JUN 2024 02:23:38 AM): ; file: /home/judge/data/code/Main.lisp ; in: DEFUN MAIN ; (R (READ)) ; ; caught STYLE-WARNING: ; The variable R is defined but never used. ; ; compilation unit finished ; caught 1 STYLE-WARNING condition ; wrote /home/judge/data/code/Main.fasl ; compilation finished in 0:00:00.194
ソースコード
(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*))
(setq *random-state* (make-random-state t)))
#-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+ 1000000007)
(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
(defpackage :cp/read-fixnum
(:use :cl)
(:export #:read-fixnum))
(in-package :cp/read-fixnum)
(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 #\-))
(setq 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))))))))
(defpackage :cp/tzcount
(:use :cl)
(:export #:tzcount))
(in-package :cp/tzcount)
(declaim (inline tzcount))
(defun tzcount (x)
"Returns the number of trailing zero bits of X. Note that (TZCOUNT 0) = -1."
(- (integer-length (logand x (- x))) 1))
(defpackage :cp/mod-inverse
(:use :cl)
#+sbcl (:import-from #:sb-c #:defoptimizer #:lvar-type #:integer-type-numeric-bounds
#:derive-type #:flushable #:foldable)
#+sbcl (:import-from :sb-kernel #:specifier-type)
(:export #:mod-inverse))
(in-package :cp/mod-inverse)
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(sb-c:defknown %mod-inverse ((integer 0) (integer 1)) (integer 0)
(flushable foldable)
:overwrite-fndb-silently t)
(sb-c:defknown mod-inverse (integer (integer 1)) (integer 0)
(flushable foldable)
:overwrite-fndb-silently t)
(defun derive-mod (modulus)
(let ((high (nth-value 1 (integer-type-numeric-bounds (lvar-type modulus)))))
(specifier-type (if (integerp high)
`(integer 0 (,high))
`(integer 0)))))
(defoptimizer (%mod-inverse derive-type) ((integer modulus))
(declare (ignore integer))
(derive-mod modulus))
(defoptimizer (mod-inverse derive-type) ((integer modulus))
(declare (ignore integer))
(derive-mod modulus)))
(defun %mod-inverse (integer modulus)
(declare (optimize (speed 3) (safety 0))
#+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
(macrolet ((frob (stype)
`(let ((a integer)
(b modulus)
(u 1)
(v 0))
(declare (,stype a b u v))
(loop until (zerop b)
for quot = (floor a b)
do (decf a (the ,stype (* quot b)))
(rotatef a b)
(decf u (the ,stype (* quot v)))
(rotatef u v))
(if (< u 0)
(+ u modulus)
u))))
(typecase modulus
((unsigned-byte 31) (frob (signed-byte 32)))
((unsigned-byte 62) (frob (signed-byte 63)))
(otherwise (frob integer)))))
(declaim (inline mod-inverse))
(defun mod-inverse (integer modulus)
"Solves ax = 1 mod m. Signals DIVISION-BY-ZERO when INTEGER and MODULUS are
not coprime."
(let* ((integer (mod integer modulus))
(result (%mod-inverse integer modulus)))
(unless (or (= 1 (mod (* integer result) modulus)) (= 1 modulus))
(error 'division-by-zero
:operands (list integer modulus)
:operation 'mod-inverse))
result))
(defpackage :cp/mod-power
(:use :cl)
(:export #:mod-power))
(in-package :cp/mod-power)
(declaim (inline mod-power))
(defun mod-power (base power modulus)
"Returns BASE^POWER mod MODULUS. Note: 0^0 = 1.
BASE := integer
POWER, MODULUS := non-negative fixnum"
(declare ((integer 0 #.most-positive-fixnum) modulus power)
(integer base))
(let ((base (mod base modulus))
(res (mod 1 modulus)))
(declare ((integer 0 #.most-positive-fixnum) base res))
(loop while (> power 0)
when (oddp power)
do (setq res (mod (* res base) modulus))
do (setq base (mod (* base base) modulus)
power (ash power -1)))
res))
(defpackage :cp/mod-sqrt
(:use :cl :cp/mod-power :cp/mod-inverse :cp/tzcount)
(:export #:mod-sqrt)
(:documentation "Provides Tonelli-Shanks algorithm for finding a modular
square root."))
(in-package :cp/mod-sqrt)
(defconstant +nbits+ 31)
(deftype uint () '(integer 0 #.(- (ash 1 +nbits+) 1)))
(declaim (inline mod-sqrt))
(defun mod-sqrt (a mod)
"Returns a modular square root of A if it exists; otherwise returns NIL. MOD
must be prime."
(declare ((integer 0) a)
((and (integer 1) uint) mod))
(let ((a (mod a mod)))
(when (or (< a 2) (= mod 2))
(return-from mod-sqrt a))
;; Euler's criterion
(unless (= 1 (mod-power a (ash (- mod 1) -1) mod))
(return-from mod-sqrt))
(let* ((b (loop for b = (+ 1 (random (- mod 1)))
while (= 1 (mod-power b (ash (- mod 1) -1) mod))
finally (return b)))
(init-shift (tzcount (- mod 1)))
(q (ash (- mod 1) (- init-shift)))
(x (mod-power a (ash (+ q 1) -1) mod))
(b (mod-power b q mod))
(/a (mod-inverse a mod))
(shift 2))
(declare ((mod #.+nbits+) shift init-shift)
(uint b q x /a))
(loop until (= a (mod (* x x) mod))
for error = (mod (* /a (mod (* x x) mod)) mod)
unless (= 1 (mod-power error (ash 1 (- init-shift shift)) mod))
do (setq x (mod (* x b) mod))
do (setq b (mod (* b b) mod))
(incf shift)
finally (return x)))))
;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/mod-inverse :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/mod-sqrt :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
(use-package :cp/read-fixnum :cl-user))
(in-package :cl-user)
;;;
;;; Body
;;;
(declaim (inline solve))
(defun solve (a b c p)
(declare (optimize (speed 3))
((integer 0 #.(expt 10 9)) a b c p))
(let* ((det (mod (- (mod (* b b) p)
(mod (* a c 4) p))
p))
(sqrtdet (mod-sqrt det p)))
(if sqrtdet
(let* ((/2a (mod-inverse (* 2 a) p))
(res1 (mod (* (mod (+ (- b) sqrtdet) p) /2a) p))
(res2 (mod (* (mod (- (- b) sqrtdet) p) /2a) p)))
(when (> res1 res2)
(rotatef res1 res2))
(values res1 res2))
(values nil nil))))
(defun main ()
(declare (optimize (speed 3)))
(let* ((p (read))
(r (read))
(q (read)))
(declare (uint31 p r q))
(write-string
(with-output-to-string (*standard-output* nil :element-type 'base-char)
(dotimes (_ q)
(let ((a (read-fixnum))
(b (read-fixnum))
(c (read-fixnum)))
(multiple-value-bind (res1 res2) (solve a b c p)
(cond ((null res1)
(println -1))
((= res1 res2)
(println res1))
(t (format t "~D ~D~%" res1 res2))))))))))
#-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/551"))
#+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 "0
2 3
-1
"
(run "5 2
3
1 0 0
1 0 1
1 0 2
" nil)))
(5am:is
(equal "0 3
4
1 2
"
(run "5 2
3
1 2 0
1 2 1
1 2 2
" nil))))