Project:
 ```1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 ``` ```; lenstra's algorithm (define sort #f) (define merge #f) (let () (define dosort (lambda (pred? ls n) (if (= n 1) (list (car ls)) (let ((i (quotient n 2))) (domerge pred? (dosort pred? ls i) (dosort pred? (list-tail ls i) (- n i))))))) (define domerge (lambda (pred? l1 l2) (cond ((null? l1) l2) ((null? l2) l1) ((pred? (car l2) (car l1)) (cons (car l2) (domerge pred? l1 (cdr l2)))) (else (cons (car l1) (domerge pred? (cdr l1) l2)))))) (set! sort (lambda (pred? l) (if (null? l) l (dosort pred? l (length l))))) (set! merge (lambda (pred? l1 l2) (domerge pred? l1 l2)))) (define rand (let* ((a 3141592653) (c 2718281829) (m (expt 2 35)) (x 5772156649) (next (lambda () (let ((x-prime (modulo (+ (* a x) c) m))) (set! x x-prime) x-prime))) (k 103) (v (list->vector (reverse (let loop ((i k) (vs (list x))) (if (= i 1) vs (loop (- i 1) (cons (next) vs))))))) (y (next)) (init (lambda (s) (set! x s) (vector-set! v 0 x) (do ((i 1 (+ i 1))) ((= i k)) (vector-set! v i (next)))))) (lambda seed (cond ((null? seed) (let* ((j (quotient (* k y) m)) (q (vector-ref v j))) (set! y q) (vector-set! v j (next)) (/ y m))) ((eq? (car seed) 'get) (list a c m x y k v)) ((eq? (car seed) 'set) (let ((state (cadr seed))) (set! a (list-ref state 0)) (set! c (list-ref state 1)) (set! m (list-ref state 2)) (set! x (list-ref state 3)) (set! y (list-ref state 4)) (set! k (list-ref state 5)) (set! v (list-ref state 6)))) (else (init (modulo (numerator (inexact->exact (car seed))) m)) (rand)))))) (define (randint . args) (cond ((null? (cdr args)) (inexact->exact (floor (* (rand) (car args))))) ((< (car args) (cadr args)) (+ (inexact->exact (floor (* (rand) (- (cadr args) (car args))))) (car args))) (else (+ (inexact->exact (ceiling (* (rand) (- (cadr args) (car args))))) (car args))))) (define (primes n) (let* ((max-index (quotient (- n 3) 2)) (v (make-vector (+ 1 max-index) #t))) (let loop ((i 0) (ps '(2))) (let ((p (+ i i 3)) (startj (+ (* 2 i i) (* 6 i) 3))) (cond ((>= (* p p) n) (let loop ((j i) (ps ps)) (cond ((> j max-index) (reverse ps)) ((vector-ref v j) (loop (+ j 1) (cons (+ j j 3) ps))) (else (loop (+ j 1) ps))))) ((vector-ref v i) (let loop ((j startj)) (if (<= j max-index) (begin (vector-set! v j #f) (loop (+ j p))))) (loop (+ 1 i) (cons p ps))) (else (loop (+ 1 i) ps))))))) (define (expm b e m) (define (m* x y) (modulo (* x y) m)) (cond ((zero? e) 1) ((even? e) (expm (m* b b) (/ e 2) m)) (else (m* b (expm (m* b b) (/ (- e 1) 2) m))))) (define (check? a n) (let loop ((r 0) (s (- n 1))) (if (even? s) (loop (+ r 1) (/ s 2)) (if (= (expm a s n) 1) #t (let loop ((j 0) (s s)) (cond ((= j r) #f) ((= (expm a s n) (- n 1)) #t) (else (loop (+ j 1) (* s 2))))))))) (define (prime? n) (cond ((< n 2) #f) ((= n 2) #t) ((even? n) #f) (else (let loop ((k 50)) (cond ((zero? k) #t) ((not (check? (randint 1 n) n)) #f) (else (loop (- k 1)))))))) (define (lenstra n limit) (call-with-current-continuation (lambda (return) (let* ((x (randint n)) (y (randint n)) (a (randint n)) (b (- (* y y) (* x x x) (* a x))) (d (+ (* 4 a a a) (* 27 b b))) (g (gcd d n)) (ps (primes limit))) (define (inverse x) (let loop ((x (modulo x n)) (a 1)) (cond ((zero? x) (return #f)) ((= x 1) a) (else (let ((q (- (quotient n x)))) (loop (+ n (* q x)) (modulo (* q a) n))))))) (define (add p1 p2) (let* ((x1 (car p1)) (y1 (cdr p1)) (x2 (car p2)) (y2 (cdr p2)) (g (gcd (- x1 x2) n))) (if (zero? g) (return #f)) (if (< 1 g n) (return g)) (let* ((slope (* (inverse (- x1 x2)) (- y1 y2))) (newx (modulo (- (* slope slope) x1 x2) n)) (newy (modulo (- (* slope (- x1 newx)) y1) n))) (cons newx newy)))) (define (double p) (let* ((x (car p)) (y (cdr p)) (g (gcd (+ y y) n))) (if (zero? g) (return #f)) (if (< 1 g n) (return g)) (let* ((slope (* (inverse (+ y y)) (+ (* 3 x x) b))) (newx (modulo (- (* slope slope) x x) n)) (newy (modulo (- (* slope (- x newx)) y) n))) (cons newx newy)))) (define (mult k p) (cond ((= k 1) p) ((even? k) (mult (quotient k 2) (double p))) (else (add (mult (quotient k 2) (double p)) p)))) (if (zero? g) (return #f)) (if (< 1 g n) (return g)) (let loop ((p (car ps)) (q (car ps)) (ps (cdr ps)) (xy (cons x y))) (cond ((null? ps) (return #f)) ((< limit q) (loop (car ps) (car ps) (cdr ps) xy)) (else (loop p (* p q) ps (mult p xy))))))))) (define (factor n limit curves) (let loop ((curves curves)) (if (zero? curves) #f (let ((f (lenstra n limit))) (if f f (loop (- curves 1))))))) (define (trial-factors n ps) (let loop ((ps ps) (facts '()) (cofact n)) (cond ((or (null? ps) (= cofact 1)) (values (reverse facts) cofact)) ((< cofact (* (car ps) (car ps))) (values (reverse (cons cofact facts)) 1)) ((zero? (modulo cofact (car ps))) (loop ps (cons (car ps) facts) (quotient cofact (car ps)))) (else (loop (cdr ps) facts cofact))))) (define (factors n . args) ; factors n limit curves trial-limit (let ((limit (if (< 1 (length args)) (car args) 10000)) (curves (if (< 2 (length args)) (cadr args) 1000)) (trial-limit (if (< 3 (length args)) (caddr args) #e1e6))) (call-with-values (lambda () (trial-factors n (primes trial-limit))) (lambda (facts cofact) (let fact ((n cofact) (facts facts)) (cond ((= n 1) (sort < facts)) ((prime? n) (sort < (cons n facts))) (else (let ((f (factor n limit curves))) (cond ((not f) (display "failed with factors") (for-each (lambda (f) (display " ") (display f)) (sort < facts)) (display " and co-factor ") (display n) (newline)) ((prime? f) (fact (/ n f) (cons f facts))) (else (let ((fs (fact (/ n f) (list f)))) (fact (apply / n fs) (append fs facts))))))))))))) (display (factors (/ (- (expt 10 47) 1) 9))) ```
 ```1 ``` `(35121409 316362908763458525001406154038726382279)`