(in-package :cl-user)
(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
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(macrolet ((def-int (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (defs (&rest bits) `(progn ,@(mapcar (lambda (b) `(def-int ,b)) bits))))
  (defs 2 4 7 8 15 16 31 32 62 63 64))

(defconstant +mod+ 1000000007)

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

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

;; BEGIN_INSERTED_CONTENTS
(defpackage :cp/eratosthenes
  (:use :cl)
  (:export #:make-prime-table #:make-prime-sequence #:prime-data #:make-prime-data
           #:prime-data-seq #:prime-data-table #:prime-data-p
           #:factorize #:make-omega-table))
(in-package :cp/eratosthenes)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (assert (= sb-vm:n-word-bits 64)))

(declaim (ftype (function * (values simple-bit-vector &optional)) make-prime-table))
(defun make-prime-table (sup)
  "Returns a simple-bit-vector of length SUP, whose (0-based) i-th bit is 1 if i
is prime and 0 otherwise.

Example: (make-prime-table 10) => #*0011010100"
  (declare (optimize (speed 3) (safety 0)))
  (check-type sup (integer 2 (#.array-total-size-limit)))
  (let ((table (make-array sup :element-type 'bit :initial-element 0))
        (sup/64 (ceiling sup 64)))
    ;; special treatment for p = 2
    (dotimes (i sup/64)
      (setf (sb-kernel:%vector-raw-bits table i) #xAAAAAAAAAAAAAAAA))
    (setf (sbit table 1) 0
          (sbit table 2) 1)
    ;; p >= 3
    (loop for p from 3 to (+ 1 (isqrt (- sup 1))) by 2
          when (= 1 (sbit table p))
          do (loop for composite from (* p p) below sup by p
                   do (setf (sbit table composite) 0)))
    table))

(declaim (ftype (function * (values (simple-array (integer 0 #.most-positive-fixnum) (*))
                                    simple-bit-vector
                                    &optional))
                make-prime-sequence))
(defun make-prime-sequence (sup)
  "Returns the ascending sequence of primes smaller than SUP. Internally calls
MAKE-PRIME-TABLE and returns its result as the second value."
  (declare (optimize (speed 3) (safety 0)))
  (check-type sup (integer 2 (#.array-total-size-limit)))
  (let ((table (make-prime-table sup)))
    (let* ((length (count 1 table))
           (result (make-array length :element-type '(integer 0 #.most-positive-fixnum)))
           (index 0))
      (declare ((integer 0 #.most-positive-fixnum) length))
      (loop for x below sup
            when (= 1 (sbit table x))
            do (setf (aref result index) x)
               (incf index))
      (values result table))))

(defstruct (prime-data (:constructor %make-prime-data (seq table))
                       (:copier nil))
  (seq nil :type (simple-array (integer 0 #.most-positive-fixnum) (*)))
  (table nil :type simple-bit-vector))

(defun make-prime-data (sup)
  (multiple-value-call #'%make-prime-data (make-prime-sequence sup)))

(declaim (inline factorize)
         (ftype (function * (values list list &optional)) factorize))
(defun factorize (x prime-data)
  "Returns the associative list of prime factors of X, which is composed
of (<prime> . <exponent>). E.g. (factorize 40 <prime-table>) => '((2 . 3) (5
. 1)).

- Any numbers beyond the range of PRIME-DATA are regarded as prime.
- The returned list is in ascending order w.r.t. prime factors."
  (declare (integer x))
  (let* ((x (abs x))
         (prime-seq (prime-data-seq prime-data))
         (result (load-time-value (list :root)))
         (tail result))
    (labels ((add (x)
               (setf (cdr tail) (list x)
                     tail (cdr tail))))
      (loop for prime of-type unsigned-byte across prime-seq
            until (= x 1)
            do (loop for exponent of-type (integer 0 #.most-positive-fixnum) from 0
                     do (multiple-value-bind (quot rem) (floor x prime)
                          (unless (zerop rem)
                            (when (> exponent 0)
                              (add (cons prime exponent)))
                            (return))
                          (setq x quot)))
            finally (unless (= x 1)
                      (add (cons x 1))))
      (multiple-value-prog1 (values (cdr result)
                                    (if (eq result tail) nil tail))
        (setf (cdr result) nil)))))

(defun make-omega-table (sup prime-data)
  "Returns the table of prime omega function on {0, 1, ..., SUP-1}."
  (declare ((integer 0 #.most-positive-fixnum) sup))
  ;; (assert (>= (expt (aref prime-seq (- (length prime-seq) 1)) 2) (- sup 1)))
  (let ((prime-seq (prime-data-seq prime-data))
        (table (make-array sup :element-type '(unsigned-byte 32)))
        (res (make-array sup :element-type '(unsigned-byte 8))))
    (dotimes (i (length table))
      (setf (aref table i) i))
    (loop for p of-type (integer 0 #.most-positive-fixnum) across prime-seq
          do (loop for i from p below sup by p
                   do (loop
                        (multiple-value-bind (quot rem) (floor (aref table i) p)
                          (if (zerop rem)
                              (progn (incf (aref res i))
                                     (setf (aref table i) quot))
                              (return))))))
    (loop for i below sup
          unless (= 1 (aref table i))
          do (incf (aref res i)))
    res))

;;;
;;; Bignum arithmetic by Chinese remainder theorem
;;;

(defpackage :cp/chinese-remainder
  (:use :cl)
  (:export #:chinese-rem #:chinese-rem*))
(in-package :cp/chinese-remainder)

;; Extended Euclidean algorithm (Blankinship algorithm)
(declaim (ftype (function * (values integer integer &optional)) %ext-gcd/bignum))
(defun %ext-gcd/bignum (a b)
  (declare (optimize (speed 3) (safety 0))
           (unsigned-byte a b))
  (let ((y 1)
        (x 0)
        (u 1)
        (v 0))
    (declare (integer y x u v))
    (loop (when (zerop a)
            (return (values x y)))
          (let ((q (floor b a)))
            (decf x (* q u))
            (rotatef x u)
            (decf y (* q v))
            (rotatef y v)
            (decf b (* q a))
            (rotatef b a)))))

;; Reference: https://qiita.com/drken/items/ae02240cd1f8edfc86fd (Japanese)
(declaim (inline chinese-rem))
(defun chinese-rem (b1 mod1 b2 mod2)
  "Solves x ≡ b1 mod m1, x ≡ b2 mod m2. The returned integer is in [0, LCM(m1,
m2)). Returns LCM(m1, m2) as the second value.

This function returns (VALUES NIL NIL) when the system is infeasible."
  (declare (integer b1 b2)
           ((integer 1) mod1 mod2))
  (multiple-value-bind (p q) (%ext-gcd/bignum mod1 mod2)
    (let ((gcd (+ (* p mod1) (* q mod2))))
      (declare (unsigned-byte gcd))
      (unless (zerop (mod (- b2 b1) gcd))
        ;; b1 ≡ b2 mod gcd(m1, m2) must holds
        (return-from chinese-rem (values nil nil)))
      (let* ((lcm/mod1 (floor mod2 gcd))
             (tmp (mod (* (floor (- b2 b1) gcd) p) lcm/mod1))
             (lcm (* mod1 lcm/mod1)))
        (values (mod (+ b1 (* mod1 tmp)) lcm) lcm)))))

(defun chinese-rem* (rems moduli)
  "Solves x_i ≡ b_i mod m_i, i in {1, 2, ..., k}. The returned integers are in
[0, LCM(m_1, m_2, ..., m_k)). Returns LCM(m_1, m_2, ..., m_k} as the second
value.

This function returns (VALUES NIL NIL) when the system is infeasible.

REMS := vector of integers
MODULI := vector of positive integers"
  (declare (vector rems moduli))
  (let ((result 0)
        (modulus 1))
    (declare (unsigned-byte result modulus))
    (dotimes (i (length rems))
      ;; Iteratively solves the system of two equations: x1 ≡ b1 mod m1 and x2
      ;; ≡ b2 mod m2, where RESULT = b1, MODULUS = m1, (AREF REMS I) = b2, and
      ;; (AREF MODULI I) = m2.
      (let ((b2 (aref rems i))
            (m2 (aref moduli i)))
        (declare (integer b2)
                 ((integer 1) m2))
        (multiple-value-bind (p q) (%ext-gcd/bignum modulus m2)
          (let ((gcd (+ (* p modulus) (* q m2))))
            (declare (unsigned-byte gcd))
            (unless (zerop (mod (- b2 result) gcd))
              ;; b1 ≡ b2 mod gcd(m1, m2) must holds
              (return-from chinese-rem* (values nil nil)))
            (let* ((lcm/m1 (floor m2 gcd))
                   (tmp (mod (* (floor (- b2 result) gcd) p) lcm/m1)))
              (declare (unsigned-byte lcm/m1 tmp))
              (setq result (+ result (* modulus tmp)))
              (setq modulus (* modulus lcm/m1)))))))
    (values result modulus)))

(defpackage :cp/modify-macro
  (:use :cl)
  (:export #:minf #:maxf #:mulf #:divf #:iorf #:xorf #:andf))
(in-package :cp/modify-macro)

(macrolet ((def (name fname)
             `(define-modify-macro ,name (new-value) ,fname)))
  (def minf min)
  (def maxf max)
  (def mulf *)
  (def divf /)
  (def iorf logior)
  (def xorf logxor)
  (def andf logand))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/modify-macro :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/chinese-remainder :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/eratosthenes :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (declare #.cl-user::opt)
  (let* ((n (read))
         (pdata (make-prime-data #.(* 5 (expt 10 7))))
         (factors (coerce (loop for (p . exp) in (factorize (* 2 n) pdata)
                                collect (expt p exp))
                          '(simple-array uint62 (*))))
         (res #.(expt 2 128)))
    (declare (uint62 n))
    (dotimes (bits (ash 1 (length factors)))
      (let ((p1 1)
            (p2 1))
        (declare (uint62 p1 p2))
        (dotimes (pos (length factors))
          (if (logbitp pos bits)
              (mulf p1 (aref factors pos))
              (mulf p2 (aref factors pos))))
        (multiple-value-bind (k lcm) (chinese-rem 0 p1 (- p2 1) p2)
          (when k
            (let ((k (if (zerop k) lcm k)))
              (when (< k res)
                (setq res k)))))))
    (println res)))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)
    #+os-unix (run-program "xsel" '("-b" "-o") :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* (or out (make-string-output-stream)))
         (res (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))))))
    (if out res (get-output-stream-string *standard-output*))))

#+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)))

#-swank
(eval-when (:compile-toplevel)
  (when (and (boundp 'sb-c::*compiler-warning-count*)
             (> sb-c::*compiler-warning-count* 0))
    (sb-ext:quit :unix-status 1)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (5am:is
   (equal "10
"
          (run "11
" nil)))
  (5am:is
   (equal "1100144
"
          (run "20200920
" nil))))


Measured memory_bytes: 55328