結果

問題 No.1339 循環小数
ユーザー EnderedEndered
提出日時 2021-02-15 21:22:12
言語 Common Lisp
(sbcl 2.3.8)
結果
WA  
実行時間 -
コード長 8,567 bytes
コンパイル時間 797 ms
コンパイル使用メモリ 53,672 KB
実行使用メモリ 29,320 KB
最終ジャッジ日時 2023-09-30 19:18:06
合計ジャッジ時間 3,377 ms
ジャッジサーバーID
(参考情報)
judge11 / judge12
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 21 ms
29,036 KB
testcase_01 WA -
testcase_02 WA -
testcase_03 WA -
testcase_04 WA -
testcase_05 WA -
testcase_06 WA -
testcase_07 WA -
testcase_08 WA -
testcase_09 WA -
testcase_10 WA -
testcase_11 WA -
testcase_12 WA -
testcase_13 WA -
testcase_14 WA -
testcase_15 WA -
testcase_16 WA -
testcase_17 WA -
testcase_18 WA -
testcase_19 WA -
testcase_20 WA -
testcase_21 WA -
testcase_22 WA -
testcase_23 WA -
testcase_24 WA -
testcase_25 WA -
testcase_26 WA -
testcase_27 WA -
testcase_28 WA -
testcase_29 WA -
testcase_30 WA -
testcase_31 WA -
testcase_32 WA -
testcase_33 WA -
testcase_34 WA -
testcase_35 WA -
testcase_36 WA -
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 30 SEP 2023 07:18:02 PM):
; processing (UNLESS (MEMBER :CHILD-SBCL ...) ...)
; processing (DEFMACRO DPLINE ...)
; processing (DEFMACRO DPHASH ...)
; processing (DEFMACRO TEST ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFMACRO TEST
;     (DEFMACRO TEST ((FUNC &BODY ARGS) &OPTIONAL (OUT-STREAM))
;       (LET ((EVALED-ARGS (GENSYM)))
;         `(LET ((,EVALED-ARGS #))
;            (FORMAT T "~w: ~w ~%" `(,',FUNC ,@,EVALED-ARGS)
;                    (APPLY #',FUNC ,EVALED-ARGS)))))
; --> SB-INT:NAMED-DS-BIND SB-INT:BINDING* 
; ==>
;   (LET* ((#:G0 (SB-C::CHECK-DS-LIST (CDR #:EXPR) 1 2 '(# # &OPTIONAL #)))
;          (#:G1 (SB-C::CHECK-DS-LIST/&REST (POP #:G0) 1 1 '(# FUNC &BODY ARGS)))
;          (FUNC (POP #:G1))
;          (ARGS #:G1)
;          (OUT-STREAM
;           (IF #:G0
;               (POP #:G0))))
;     (DECLARE (SB-C::CONSTANT-VALUE FUNC ARGS OUT-STREAM))
;     (BLOCK TEST
;       (LET ((EVALED-ARGS #))
;         `(LET (#)
;            (FORMAT T "~w: ~w ~%" `# #)))))
; 
; caught STYLE-WARNING:
;   The variable OUT-STREAM is defined but never used.

; file: /home/judge/data/code/Main.lisp
; in: DEFMACRO TEST
;     (DEFMACRO TEST ((FUNC &BODY ARGS) &OPTIONAL (OUT-STREAM))
;       (LET ((EVALED-ARGS (GENSYM)))
;         `(LET ((,EVALED-ARGS #))
;            (FORMAT T "~w: ~w ~%" `(,',FUNC ,@,EVALED-ARGS)
;                    (APPLY #',FUNC ,EVALED-ARGS)))))
; --> PROGN EVAL-WHEN SB-C::%DEFMACRO SB-C::%DEFMACRO SB-INT:NAMED-LAMBDA 
; --> FUNCTION SB-INT:NAMED-DS-BIND SB-INT:BINDING* 
; ==>
;   (LET* ((#:G0 (SB-C::CHECK-DS-LIST (CDR #:EXPR) 1 2 '(# # &OPTIONAL #)))
;          (#:G1 (SB-C::CHECK-DS-LIST/&REST (POP #:G0) 1 1 '(# FUNC &BODY ARGS)))
;          (FUNC (POP #:G1))
;          (ARGS #:G1)
;          (OUT-STREAM
;           (IF #:G0
;               (POP #:G0))))
;     (DECLARE (SB-C::CONSTANT-VALUE FUNC ARGS OUT-STREAM))
;     (BLOCK TEST
;       (LET ((EVALED-ARGS #))
;         `(LET (#

ソースコード

diff #

#-swank
(unless (member :child-sbcl *features*)
  "I refered from https://competitive12.blogspot.com/2020/03/common-lisp.html thank you!"
  (quit
   :unix-status
   (process-exit-code
    (run-program *runtime-pathname*
                 `("--control-stack-size" "256MB"
                   "--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options"
                   "--eval" "(push :child-sbcl *features*)"
                   "--script" ,(namestring *load-pathname*))
                 :output t :error t :input t))))

(defmacro dpline (name args memo-size &body body)
  (let ((memo (gensym)))
    `(let ((,memo (make-array ,memo-size :initial-element nil)))
       (defun ,name ,args
         (or (aref ,memo ,@args)
             (setf (aref ,memo ,@args)
                   ,@body))))))

(defmacro dphash (name args &body expr)
  `(let ((table (make-hash-table :test #'equal)))
     (defun  ,name ,args 
       (or (gethash (list ,@args) table)
           (setf (gethash (list ,@args) table)
                 (progn 
                   ,@expr))))))

(defmacro test ((func &body args) &optional (out-stream))
  (let ((evaled-args (gensym)))
    `(let ((,evaled-args (list ,@args)))
       (format t "~w: ~w ~%" `(,',func ,@,evaled-args) (apply #',func ,evaled-args)))))

(defmacro dplabels (funcs &body body)
  (let ((tables (loop for func in funcs collect (gensym))))
    `(let ,(mapcar (lambda (table) `(,table (make-hash-table :test #'equal)))
            tables)
       (labels ,(mapcar (lambda (func table)
                          (let ((name (first func))
                                (args (second func))
                                (body (cddr func))
                                (ok (gensym))
                                (val (gensym)))
                            `(,name ,args
                                    (multiple-value-bind (,val ,ok)
                                      (gethash (list ,@args) ,table)
                                      (if ,ok ,val
                                          (setf (gethash (list ,@args) ,table)
                                                (progn ,@body)))))))
                        funcs tables)
         ,@body))))

(defmacro dpfun (name args &body body)
  (let ((f (gensym)))
    `(dplabels ((,f ,args ,@body))
       (defun ,name (&rest args)
         (apply #',f args)))))


(defun split (x str)
  (let ((pos (search x str))
        (size (length x)))
    (if pos
        (cons (subseq str 0 pos)
              (split x (subseq str (+ pos size))))
        (list str))))

(defmacro collect-times (time body)
  `(loop repeat ,time collect ,body))

(defun read-times (time)
  (collect-times time (read)))

(defmacro aif (expr then else)
  `(let ((it ,expr))
     (if it ,then ,else)))

(defmacro awhen (expr &rest then)
  `(aif ,expr (progn ,@then) nil))

(defun comulative (function list &key base)
  (if base
      (comulative function (cons base list))
      (do ((lst (cdr list) (cdr lst))
           (acc (list (car list))))
          ((null lst) (reverse acc))
        (push (funcall function (car acc) (car lst)) acc))))

(defun binary-search (function left right
                      &optional
                        (eps 1)
                        (average-function (lambda (x y) (ash (+ x y) -1))))
  (if (<= (abs (- left right)) eps)
      right
      (let ((mid (funcall average-function left right)))
        (if (funcall function mid)
            (binary-search function left mid eps average-function)
            (binary-search function mid right eps average-function)))))

(defun arithmetic-mean (&rest body)
  (/ (apply #'+ body) (length body)))

(defvar +MOD+ (+ (expt 10 9) 7))

(defun range-0-n (n &optional (step 1))
  (loop for i from 0 below n by step collect i))

(defun range-1-n (n &optional (step 1))
  (loop for i from 1 below n by step collect i))

(defun range-a-b (a b &optional (step 1))
  (loop for i from a below b by step collect i))

(defun map-0-n (function n &optional (step 1))
  (mapcar function (range-0-n n step)))

(defun map-1-n (function n &optional (step 1))
  (mapcar function (range-1-n n step)))

(defun map-a-b (function a b &optional (step 1))
  (mapcar function (range-a-b a b step)))

(defun read-string (&optional (stream *standard-input*))
  (labels ((is-empty (x)
             (or (char= x #\space) (char= x #\newline))))
    (loop for char = (read-char stream)
          with result
          when (and result (is-empty char))
            do (return (concatenate 'string (nreverse result)))
          when (null (is-empty char))
            do (push char result))))

(defun merge-sort (lst &optional (compare #'<))
  (let ((turn 0))
    (labels ((merge-list (a b a-length b-length)
               (cond ((zerop a-length) b)
                     ((zerop b-length) a)
                     ((funcall compare (car b) (car a))
                      (incf turn a-length)
                      (cons (car b)
                            (merge-list a (cdr b) a-length (1- b-length))))
                     (t
                      (cons (car a)
                            (merge-list (cdr a) b (1- a-length) b-length)))))
             (f (lst length)
               (if (= length 1)
                   lst
                   (let ((mid (ash length -1)))
                     (merge-list (f (subseq lst 0 mid) mid)
                                 (f (subseq lst mid) (- length mid))
                                 mid
                                 (- length mid))))))
      (values (f lst (length lst)) turn))))

(defun group (lst &optional (test #'eql) (key nil))
  (let ((table (make-hash-table :test test)))
    (mapc (lambda (x)
            (push x (gethash (if key (funcall key x) x) table)))
          lst)
    (loop for value being each hash-value in table
          collect value)))

(defun nearby (&rest args)
  (let ((current (subseq args 0 (ash (length args) -1)))
        (validator (subseq args (ash (length args) -1)))
        (res nil))
    (labels ((check ()
               (every (lambda (x y) (and (<= 0 x) (< x y)))
                      current validator))
             (f (lst)
               (unless lst (return-from f))
               (let ((x (car lst)))
                 (setf (car lst) (1+ x))
                 (when (check) (push (copy-list current) res))
                 (setf (car lst) (1- x))
                 (when (check) (push (copy-list current) res))
                 (setf (car lst) x))
               (f (cdr lst))))
      (f current)
      res)))

(defun make-primes (max-number)
  (let ((array (make-array (1+ max-number) :initial-element t)))
    (loop for i from 2 to max-number
          for is-prime = (aref array i)
          when is-prime collect i
          when is-prime
          do (loop for j from (* 2 i) to max-number by i
                   do (setf (aref array j) nil)))))

(defun make-is-prime (max-number)
  (let ((primes (make-primes max-number))
        (table (make-array (1+ max-number) :initial-element nil)))
    (dolist (i primes)
      (setf (aref table i) t))
    (defun is-prime (x)
      (aref table x))))


(defparameter +MOD+ (+ 7 (expt 10 9)))
(defmacro mod+ (&body args)
  (reduce (lambda (a b) `(mod (+ ,a ,b) +MOD+))
          args))
(defmacro mod- (&body args)
  (reduce (lambda (a b) `(mod (- ,a ,b) +MOD+))
          args))
(defmacro mod* (&body args)
  (reduce (lambda (a b) `(mod (* ,a ,b) +MOD+))
          args))
(defun modpow (base power)
  (if (zerop power)
      1
      (let ((base2 (mod* base base)))
        (mod* (if (oddp power) base 1)
              (modpow base2 (ash power -1))))))
(defun modinv (x)
  (modpow x (- +MOD+ 2)))
(defmacro mod/ (x &body args)
  `(mod* ,x 
         (modinv (mod* ,@args))))


(defun get-prime-factor (n)
  (loop for i from 2
	while (<= (* i i) n)
	when (zerop (mod n i))
	  collect i into res
	  and do (loop while (zerop (mod n i)) do (setf n (/ n i)))
	finally (progn
		  (when (> n 1)
		    (push n res))
		  (return res))))

(defun over10 (n)
  (loop with v = 1
	while (< v n)
	do (setf v (* 10 v))
	finally (return v)))

(defun log10-int (n)
  (if (>= n 10)
      (1+ (log10-int (floor n 10)))
      0))

(log10-int 1)

(defun main (n)
  (let ((factors (get-prime-factor n)))
    (reduce #'*
	    (mapcar (lambda (v)
		      (cond ((or (= v 2) (= v 5))
			     1)
			    (t
			     (let ((ten (over10 v)))
			       (if (= 1 (mod ten v))
				   (log10-int ten)
				   (1- v))))))
		    factors))))


#-swank
(let ((n (read)))
  (dotimes (_ n)
    (format t "~a~%" (main (read)))))


0