Lenstra因子分解橢圓曲線方法
阿新 • • 發佈：2019-01-03
(defvar *prime-list* (make-list 0))
(defvar *B* 12000)
(defun initial (N)
(setf *B* N))
(defun generate () ;;;生成*B*以下的素數列表
(loop while (pop *prime-list*)) ;;;Empty the list
(let ((test (make-list *B* :initial-element t)))
(loop for i from 2 to (ceiling (/ *B* 2)) do
(setf j 2)
(loop while (<= (* i j) *B*) do
(setf (nth (- (* i j) 1) test) nil)
(incf j)))
(loop for i from 0 to (- *B* 1) do
(if (nth i test) (push (+ 1 i) *prime-list*)))))
(defun p (i)
(nth (- i 1) *prime-list*))
(defun ecm (n) ;;;分解主程式
(if (/= (gcd n 6) 1)
(progn (format t "(~a,6)<>1" n) (return-from ecm)))
(let ((d n)(a 0)(ctl 1)(result (make-list 0)))
(loop do
(loop while (= ctl 1) do
(setf a (random n))
(setf result (ecm-adds *B* n a (list 0 1)))
(setf ctl (second result)))
(setf d (gcd n (third result)))
(if (/= d n) (return)
(setf ctl 1)))
d))
(defun getx (a)
(first a))
(defun gety (a)
(second a))
(defun P-eq (P Q)
(and (= (getx P) (getx Q)) (= (gety P) (gety Q))))
(defun setP (P Q)
(setf (first P) (first Q))
(setf (second P) (second Q)))
(defun ecm-add (a n P Q) ;;;Z/NZ上橢圓曲線的加法運算
(let ((lmd 0))
(if (P-eq P Q)
(setf lmd (mod (* (+ a (* 3 (expt (getx P) 2)))
(extended-gcd (* 2 (gety P)) n)) n))
(setf lmd (mod (* (- (gety P) (gety Q))
(extended-gcd (- (getx P) (getx Q)) n)) n)))
(let ((x3 (mod (- (expt lmd 2) n (getx P) (getx Q)) n)))
(list x3 (mod (- (* lmd (- (getx P) x3)) (gety P)) n)))))
(defun ecm-adds (B n a P) ;;;模橢圓曲線群上連續的加法
(let ((c 1) (S (list 0 0))(control 1)(x1-x2 0))
(setP S P)
(loop for i from 1 to (- (length *prime-list*) 1) do
(setf c (* c (expt (p i) (floor (/ (log B) (log (p i))))))))
(loop for i from 2 to c do
(if (or (and (not (P-eq S P)) (/= 1 (gcd (- (getx S) (getx P)) n)))
(and (P-eq S P) (/= 1 (gcd n (gety S)))))
(progn
(setf control 3)
(setf x1-x2 (- (getx S) (getx P)))
(return)))
(setP S (ecm-add a n S P)))
(list S control x1-x2)))
(defun extended-gcd (m n) ;;;求m mod n的逆元
(let ((a 0) (b 1) (a0 1) (b0 0)
(c m) (d n)
(q (floor (/ m n))) (r (mod m n)))
(loop until (= 0 r) do
(rotatef c d)
(rotatef d r)
(rotatef a a0)
(setf a (- a (* q a0)))
(rotatef b b0)
(setf b (- b (* q b0)))
(setf q (floor (/ c d)))
(setf r (mod c d)))
(if (< a 0) (+ a n) a)))
(defvar *B* 12000)
(defun initial (N)
(setf *B* N))
(defun generate () ;;;生成*B*以下的素數列表
(loop while (pop *prime-list*)) ;;;Empty the list
(let ((test (make-list *B* :initial-element t)))
(loop for i from 2 to (ceiling (/ *B* 2)) do
(setf j 2)
(loop while (<= (* i j) *B*) do
(setf (nth (- (* i j) 1) test) nil)
(incf j)))
(loop for i from 0 to (- *B* 1) do
(if (nth i test) (push (+ 1 i) *prime-list*)))))
(defun p (i)
(nth (- i 1) *prime-list*))
(defun ecm (n) ;;;分解主程式
(if (/= (gcd n 6) 1)
(progn (format t "(~a,6)<>1" n) (return-from ecm)))
(let ((d n)(a 0)(ctl 1)(result (make-list 0)))
(loop do
(loop while (= ctl 1) do
(setf a (random n))
(setf result (ecm-adds *B* n a (list 0 1)))
(setf ctl (second result)))
(setf d (gcd n (third result)))
(if (/= d n) (return)
(setf ctl 1)))
d))
(defun getx (a)
(first a))
(defun gety (a)
(second a))
(defun P-eq (P Q)
(and (= (getx P) (getx Q)) (= (gety P) (gety Q))))
(defun setP (P Q)
(setf (first P) (first Q))
(setf (second P) (second Q)))
(defun ecm-add (a n P Q) ;;;Z/NZ上橢圓曲線的加法運算
(let ((lmd 0))
(if (P-eq P Q)
(setf lmd (mod (* (+ a (* 3 (expt (getx P) 2)))
(extended-gcd (* 2 (gety P)) n)) n))
(setf lmd (mod (* (- (gety P) (gety Q))
(extended-gcd (- (getx P) (getx Q)) n)) n)))
(let ((x3 (mod (- (expt lmd 2) n (getx P) (getx Q)) n)))
(list x3 (mod (- (* lmd (- (getx P) x3)) (gety P)) n)))))
(defun ecm-adds (B n a P) ;;;模橢圓曲線群上連續的加法
(let ((c 1) (S (list 0 0))(control 1)(x1-x2 0))
(setP S P)
(loop for i from 1 to (- (length *prime-list*) 1) do
(setf c (* c (expt (p i) (floor (/ (log B) (log (p i))))))))
(loop for i from 2 to c do
(if (or (and (not (P-eq S P)) (/= 1 (gcd (- (getx S) (getx P)) n)))
(and (P-eq S P) (/= 1 (gcd n (gety S)))))
(progn
(setf control 3)
(setf x1-x2 (- (getx S) (getx P)))
(return)))
(setP S (ecm-add a n S P)))
(list S control x1-x2)))
(defun extended-gcd (m n) ;;;求m mod n的逆元
(let ((a 0) (b 1) (a0 1) (b0 0)
(c m) (d n)
(q (floor (/ m n))) (r (mod m n)))
(loop until (= 0 r) do
(rotatef c d)
(rotatef d r)
(rotatef a a0)
(setf a (- a (* q a0)))
(rotatef b b0)
(setf b (- b (* q b0)))
(setf q (floor (/ c d)))
(setf r (mod c d)))
(if (< a 0) (+ a n) a)))