結果

問題 No.551 夏休みの思い出（２）
ユーザー sansaquasansaqua
提出日時 2021-11-21 20:08:00
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 40 ms / 4,000 ms
コード長 10,398 bytes
コンパイル時間 1,358 ms
コンパイル使用メモリ 67,704 KB
実行使用メモリ 28,000 KB
最終ジャッジ日時 2023-09-05 05:58:00
合計ジャッジ時間 5,064 ms
ジャッジサーバーID
（参考情報） 		judge11 / judge14
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 10 ms
27,972 KB
testcase_01 AC 10 ms
23,832 KB
testcase_02 AC 9 ms
23,796 KB
testcase_03 AC 11 ms
23,864 KB
testcase_04 AC 12 ms
27,244 KB
testcase_05 AC 14 ms
23,960 KB
testcase_06 AC 15 ms
23,980 KB
testcase_07 AC 9 ms
23,824 KB
testcase_08 AC 11 ms
23,832 KB
testcase_09 AC 9 ms
23,828 KB
testcase_10 AC 9 ms
23,756 KB
testcase_11 AC 10 ms
23,756 KB
testcase_12 AC 10 ms
23,824 KB
testcase_13 AC 10 ms
27,896 KB
testcase_14 AC 9 ms
23,820 KB
testcase_15 AC 10 ms
23,828 KB
testcase_16 AC 9 ms
23,784 KB
testcase_17 AC 9 ms
23,820 KB
testcase_18 AC 9 ms
23,848 KB
testcase_19 AC 10 ms
27,880 KB
testcase_20 AC 10 ms
25,916 KB
testcase_21 AC 9 ms
23,760 KB
testcase_22 AC 10 ms
23,840 KB
testcase_23 AC 10 ms
25,852 KB
testcase_24 AC 10 ms
27,864 KB
testcase_25 AC 10 ms
23,856 KB
testcase_26 AC 10 ms
23,836 KB
testcase_27 AC 38 ms
24,064 KB
testcase_28 AC 38 ms
28,000 KB
testcase_29 AC 35 ms
26,172 KB
testcase_30 AC 37 ms
26,176 KB
testcase_31 AC 34 ms
27,892 KB
testcase_32 AC 39 ms
27,996 KB
testcase_33 AC 37 ms
24,116 KB
testcase_34 AC 36 ms
24,140 KB
testcase_35 AC 36 ms
26,132 KB
testcase_36 AC 37 ms
26,248 KB
testcase_37 AC 40 ms
24,108 KB
testcase_38 AC 40 ms
24,080 KB
testcase_39 AC 39 ms
24,084 KB
testcase_40 AC 40 ms
24,176 KB
testcase_41 AC 38 ms
24,124 KB
testcase_42 AC 40 ms
24,112 KB
testcase_43 AC 38 ms
24,072 KB
testcase_44 AC 38 ms
24,160 KB
testcase_45 AC 39 ms
24,108 KB
testcase_46 AC 39 ms
24,172 KB
testcase_47 AC 10 ms
23,792 KB
testcase_48 AC 10 ms
23,764 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 05 SEP 2023 05:57:55 AM):
; processing (IN-PACKAGE :CL-USER)
; processing (DEFPARAMETER *OPT* ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DOLIST (F #) ...)
; processing (SETQ *RANDOM-STATE* ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFMACRO DBG ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFPACKAGE :CP/READ-FIXNUM ...)
; processing (IN-PACKAGE :CP/READ-FIXNUM)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (DEFPACKAGE :CP/TZCOUNT ...)
; processing (IN-PACKAGE :CP/TZCOUNT)
; processing (DECLAIM (INLINE TZCOUNT))
; processing (DEFUN TZCOUNT ...)
; processing (DEFPACKAGE :CP/MOD-INVERSE ...)
; processing (IN-PACKAGE :CP/MOD-INVERSE)
; processing (SB-C:DEFKNOWN %MOD-INVERSE ...)
; processing (SB-C:DEFKNOWN MOD-INVERSE ...)
; processing (DEFUN DERIVE-MOD ...)
; processing (DEFOPTIMIZER (%MOD-INVERSE DERIVE-TYPE) ...)
; processing (DEFOPTIMIZER (MOD-INVERSE DERIVE-TYPE) ...)
; processing (DEFUN %MOD-INVERSE ...)
; processing (DECLAIM (INLINE MOD-INVERSE))
; processing (DEFUN MOD-INVERSE ...)
; processing (DEFPACKAGE :CP/MOD-POWER ...)
; processing (IN-PACKAGE :CP/MOD-POWER)
; processing (DECLAIM (INLINE MOD-POWER))
; processing (DEFUN MOD-POWER ...)
; processing (DEFPACKAGE :CP/MOD-SQRT ...)
; processing (IN-PACKAGE :CP/MOD-SQRT)
; processing (DEFCONSTANT +NBITS+ ...)
; processing (DEFTYPE UINT ...)
; processing (DECLAIM (INLINE MOD-SQRT))
; processing (DEFUN MOD-SQRT ...)
; processing (USE-PACKAGE :CP/MOD-INVERSE ...)
; processing (USE-PACKAGE :CP/MOD-SQRT ...)
; processing (USE-PACKAGE :CP/READ-FIXNUM ...)
; processing (IN-PACKAGE :CL-USER)
; processing (DECLAIM (INLINE SOLVE))
; processing (DEFUN SOLVE ...)
; processing (DEFUN MAIN ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAIN
;     (LET* ((P (READ)) (R (READ)) (Q (READ)))
;

ソースコード

diff # 

(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))))
0