結果

問題 No.181 A↑↑N mod M
コンテスト
ユーザー Common Lisp
提出日時 2024-11-17 01:59:47
言語 Common Lisp
(sbcl 2.6.3)
コンパイル:
sbclc _filename_
実行:
sbcl --script Main.fasl
結果
AC  
実行時間 11 ms / 5,000 ms
コード長 2,782 bytes
記録
記録タグの例:
初AC ショートコード 純ショートコード 純主流ショートコード 最速実行時間
コンパイル時間 215 ms
コンパイル使用メモリ 39,712 KB
実行使用メモリ 32,788 KB
最終ジャッジ日時 2026-05-12 04:47:29
合計ジャッジ時間 4,398 ms
ジャッジサーバーID
（参考情報） 		tmp-judge_1 / judge3_0
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 6
other AC * 37
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 12 MAY 2026 04:47:22 AM):

; wrote /home/judge/data/code/Main.fasl
; compilation finished in 0:00:00.025

ソースコード

diff #
raw source code 

(defun prime-table (&optional (m 1000000000))
  (let* ((thre (ceiling (sqrt m)))
         (flg (make-array (1+ thre) :initial-element nil))
         (i 2)
         (res '()))
    (loop while (<= (* i i) thre) do
          (unless (aref flg i)
                  (loop for j from (* i i) to thre by i do
                        (setf (aref flg j) t)))
          (incf i))
    (loop for i from 2 to thre do
          (unless (aref flg i)
                  (push i res)))
    (nreverse res)))

(defvar *prime-table* (prime-table))

(defun totient (n_)
  (let ((n n_)
        (res n_))
    (dolist (p *prime-table*)
      (when (> (* p p) n)
            (return))
      (when (zerop (mod n p))
            (setq res (* (floor res p) (1- p)))
            (loop while (zerop (mod n p)) do (setf n (floor n p)))))
    (when (/= n 1)
          (setf res (* (floor res n) (1- n))))
    res))

(defun mpow (a_ p_ m_)
  (let ((a a_)
        (p p_)
        (m m_)
        (flg t)
        (res (mod 1 m_)))
    (loop unless (zerop p) do
          (when (oddp p)
                (setf res (* res a))
                (when (>= res m)
                      (setf flg nil
                            res (mod res m))))
          (when (= p 1)
                (return))
          (setf a (* a a))
          (when (>= a m)
                (setf flg nil
                      a (mod a m)))
          (setf p (ash p -1)))
    (cons flg res)))

(defun tetration (a b m)
  (labels ((rec (aa bb mm)
                (cond ((= 0 aa) (cons t (logxor (logand bb 1) 1)))
                      ((= 1 aa) (cons t 1))
                      ((= 1 mm) (cons nil 0))
                      ((= 0 bb) (cons t 1))
                      ((= 1 bb) (cons (< aa mm) (mod aa mm)))
                      (t (let* ((phi-m (totient mm))
                                (flg1pre (rec aa (1- bb) phi-m))
                                (flg1 (car flg1pre))
                                (pre (cdr flg1pre))
                                (flg t)
                                (res 0))
                           (if flg1
                               (let ((flgres (mpow (mod aa mm) pre mm)))
                                 (setf flg (car flgres)
                                       res (cdr flgres))
                                 (cons (and flg flg1) res))
                               (let ((flgres (mpow (mod aa mm) (+ pre phi-m) mm)))
                                 (setf flg (car flgres)
                                       res (cdr flgres))
                                 (cons (and flg flg1) res))))))))
    (mod (cdr (rec a b m)) m)))

(defun main (&rest argv)
  (declare (ignorable argv))
  (let* ((a (read))
         (n (read))
         (m (read)))
    (format t "~d~%" (tetration a n m))))

(main)
0