Skip to content

Instantly share code, notes, and snippets.

@draftcode
Created May 17, 2010 10:02
Show Gist options
  • Save draftcode/403609 to your computer and use it in GitHub Desktop.
Save draftcode/403609 to your computer and use it in GitHub Desktop.
(define (gcd n m)
(cond ((= n 0) m)
((= m 0) n)
((> n m) (print (remainder n m)) (gcd (remainder n m) m))
((< n m) (print (remainder m n)) (gcd (remainder m n) n))))
; {{{
(define (poly-remove0 l)
(if (null? (cdr l)) l
(if (= 0 (car l)) (poly-remove0 (cdr l)) l)))
(define (poly-mul-token l n)
(if (= n 0) l
(poly-mul-token (append l (list 0)) (- n 1))))
(define (poly-mul-num l n)
(map (lambda (a) (* a n)) l))
(define (poly-iszero? l)
(if (null? l) #t (if (= 0 (car l)) (poly-iszero? (cdr l)) #f)))
(define (poly-sub l1 l2)
(cond ((< (length l1) (length l2)) (cons (* -1 (car l2))
(poly-sub l1 (cdr l2))))
((> (length l1) (length l2)) (cons (caar l1)
(poly-sub (cdr l1) l2)))
(else
(map (lambda (a b) (- a b)) l1 l2))))
(define (poly-cmp op l1 l2)
(if (not (= (length (poly-remove0 l1)) (length (poly-remove0 l2))))
(op (length (poly-remove0 l1)) (length (poly-remove0 l2)))
(fold-right (lambda (a b rest) (if (not (= a b)) (op a b) rest))
(op 0 0)
l1 l2)))
(define (poly-div l1 l2)
(cond ((< (length l1) (length l2))
(values (make-list (+ 1 (- (length l1) (length l2))) 0) l1))
((> (length l1) (length l2))
(receive (q r)
(poly-div l1 (poly-mul-token l2 (- (length l1) (length l2))))
(receive (qrest rrest)
(poly-div (cdr r) l2)
(values (append q qrest) (cons (car r) rrest)))))
(else
(values (list (/ (car l1) (car l2)))
(poly-sub l1 (poly-mul-num l2 (/ (car l1) (car l2))))))))
; }}}
(define (gcd-poly l1 l2)
(cond ((poly-iszero? l1) l2)
((poly-iszero? l2) l1)
((poly-cmp (lambda (a b) (> a b)) l1 l2)
(receive (q r) (poly-div l1 l2)
(begin
(print q (poly-remove0 r))
(if (= (car q) 0) r
(gcd-poly (poly-remove0 r) l2)))))
((poly-cmp (lambda (a b) (< a b)) l1 l2)
(receive (q r) (poly-div l2 l1)
(begin
(print q (poly-remove0 r))
(if (= (car q) 0) r
(gcd-poly (poly-remove0 r) l1)))))))
(gcd-poly (list 81 216 324 312 214 104 36 8 1)
(list 3 20 76 180 298 332 252 108 27))
; (gcd 4106508504 228886641)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment