codepad

Language:

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))
        (values (reverse zs) xs)
        (loop (- n 1) (cdr xs) (cons (car xs) zs)))))

(define (log2 n) (/ (log n) (log 2)))

(define (prime? n)
  (if (even? n) (= n 2)
    (let loop ((d 3))
      (cond ((< n (* d d)) #t)
            ((zero? (modulo n d)) #f)
            (else (loop (+ d 2)))))))

(define (factors n)
  (let twos ((n n) (fs '()))
    (if (even? n)
        (twos (/ n 2) (cons 2 fs))
        (let odds ((n n) (d 3) (fs fs))
          (cond ((< n (* d d))
                  (reverse (cons n fs)))
                ((zero? (modulo n d))
                  (odds (/ n d) d (cons d fs)))
                (else (odds n (+ d 2) fs)))))))

(define (compute-r n)
  (let loop ((r 2))
    (if (= r n) r
      (if (not (= (gcd n r) 1)) 'composite
        (if (or (= r 2) (not (prime? r))) (loop (+ r 1))
          (let ((q (car (reverse (factors (- r 1))))))
            (if (and (< (* 4 (sqrt r) (log2 n)) q)
                     (not (= (expm n (/ (- r 1) q) r) 1)))
                r
                (loop (+ r 1)))))))))

(define (poly-mult-mod xs ys r n)
  (define (times x) (lambda (y) (* x y)))
  (define (plus xs ys)
    (let loop ((xs xs) (ys ys) (zs (list)))
      (cond ((null? xs) (reverse (append (reverse ys) zs)))
            ((null? ys) (reverse (append (reverse xs) zs)))
            (else (loop (cdr xs) (cdr ys)
                        (cons (+ (car xs) (car ys)) zs))))))
  (define (mod-poly xs)
    (let-values (((hs ts) (split r (reverse xs))))
      (reverse (plus hs ts))))
  (define (mod-n x) (modulo x n))
  (let ((xs (reverse xs)))
    (let loop ((xs (cdr xs)) (zs (map (times (car xs)) ys)))
      (if (null? xs) (map mod-n (mod-poly zs))
        (loop (cdr xs) (plus (cons 0 zs)
                             (map (times (car xs)) ys)))))))

(define (poly-power-mod bs e r n)
  (let loop ((bs bs) (e e) (rs (list 1)))
    (if (zero? e) rs
      (loop (poly-mult-mod bs bs r n)
            (quotient e 2)
            (if (even? e) rs
              (poly-mult-mod rs bs r n))))))

(display (poly-power-mod '(1 -17) 89 89 89)) (newline)

(display (compute-r 89)) (newline)

Private [?]

Run code