[ create a new paste ] login | about

Link: http://codepad.org/fuTsFyTD    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jan 27:
; hart's one-line factoring 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 (isqrt n)
  (if (not (and (positive? n) (integer? n)))
      (error 'isqrt "must be positive integer")
      (let loop ((x n))
        (let ((y (quotient (+ x (quotient n x)) 2)))
          (if (< y x) (loop y) x)))))

(define (wheel-factors n limit)
  (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
    (let loop ((n n) (f 2) (next 0) (fs (list)))
      (cond ((< limit f) (values n fs))
            ((< n (* f f)) (values 1 (cons n fs)))
            ((zero? (modulo n f))
              (loop (/ n f) f next (cons f fs)))
            (else (loop n (+ f (vector-ref wheel next))
                        (if (= next 10) 3 (+ next 1)) fs))))))

(define (one-line-factor n)
  (let loop ((ni n))
    (let* ((s (isqrt ni))
           (s (if (= ni (* s s)) s (+ s 1)))
           (m (modulo (* s s) n))
           (t (isqrt m)))
      (if (= (* t t) m)
          (gcd (- s t) n)
          (loop (+ ni n))))))

(define (factors n)
  (call-with-values
    (lambda () (wheel-factors n (max 2 (expt n 1/3))))
    (lambda (n fs)
      (if (= n 1) fs
        (let ((f (one-line-factor n)))
          (if (= f 1) (cons n fs)
            (cons (/ n f) (cons f fs))))))))

(do ((n 2 (+ n 1))) (#f)
  (display n) (display ":")
  (for-each
    (lambda (f) (display " ") (display f))
    (sort < (factors (- (expt 2 n) 1))))
  (newline))


Output:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
2: 3
3: 7
4: 3 5
5: 31
6: 3 3 7
7: 127
8: 3 5 17
9: 7 73
10: 3 11 31
11: 23 89
12: 3 3 5 7 13
13: 8191
14: 3 43 127
15: 7 31 151
16: 3 5 17 257
17: 131071
18: 3 3 3 7 19 73

Timeout


Create a new paste based on this one


Comments: