diff --git a/scheme/base.sld b/scheme/base.sld index 0de787b5..882c237b 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -13,6 +13,8 @@ exact? inexact? odd? + gcd + lcm call-with-current-continuation call/cc call-with-values @@ -176,7 +178,6 @@ ; expt ; foldl ; foldr -; gcd ; get-output-bytevector ; get-output-string ; include @@ -184,7 +185,6 @@ ; input-port? ; integer->char ; integer? -; lcm ; length ; let*-values ; let-values @@ -899,4 +899,34 @@ (define (inexact? num) (not (exact? num))) (define (max first . rest) (foldl (lambda (old new) (if (> old new) old new)) first rest)) (define (min first . rest) (foldl (lambda (old new) (if (< old new) old new)) first rest)) + ; Implementations of gcd and lcm using Euclid's algorithm + ; + ; Also note that each form is written to accept either 0 or + ; 2 arguments, per R5RS. This could probably be generalized + ; even further, if necessary. + ; + (define gcd gcd/entry) + (define lcm lcm/entry) + ; Main GCD algorithm + (define (gcd/main a b) + (if (= b 0) + (abs a) + (gcd/main b (modulo a b)))) + + ; A helper function to reduce the input list + (define (gcd/entry . nums) + (if (eqv? nums '()) + 0 + (foldl gcd/main (car nums) (cdr nums)))) + + ; Main LCM algorithm + (define (lcm/main a b) + (abs (/ (* a b) (gcd/main a b)))) + + ; A helper function to reduce the input list + (define (lcm/entry . nums) + (if (eqv? nums '()) + 1 + (foldl lcm/main (car nums) (cdr nums)))) + ;; END gcd lcm ))