[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/xUSr2dTr    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Sep 30:
; aks primality prover, part 1

(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 (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 (ord r n)
  (do ((k 2 (+ k 1)))
      ((= (expm n k r) 1) k)))

(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 (ord 191 89)) (newline)
(display (poly-power-mod '(1 4 12 3) 2 5 17)) (newline)


Output:
1
2
190
(6 0 15 5 0)


Create a new paste based on this one


Comments: