From 7a9044854508f83516de80139dad178aefe18e27 Mon Sep 17 00:00:00 2001 From: Ken Harris Date: Sun, 16 Jun 2013 11:17:29 -0700 Subject: [PATCH] GCD, LCM, SIGNUM. --- src/numbers.lisp | 33 +++++++++++++++++++++++++++++++++ tests/numbers.lisp | 18 ++++++++++++++++++ 2 files changed, 51 insertions(+) diff --git a/src/numbers.lisp b/src/numbers.lisp index 18d679c..66c2db8 100644 --- a/src/numbers.lisp +++ b/src/numbers.lisp @@ -59,6 +59,9 @@ (defun zerop (x) (= x 0)) (defun plusp (x) (< 0 x)) +(defun signum (x) + (if (zerop x) x (/ x (abs x)))) + ;; TODO: Use MACROLET when it exists (defmacro defcomparison (operator) `(defun ,operator (x &rest args) @@ -91,3 +94,33 @@ (defun expt (base power) (expt base power)) (defun exp (power) (expt 2.718281828459045 power)) + +(defun gcd-2 (a b) + (if (zerop b) + (abs a) + (gcd-2 b (mod a b)))) + +(defun gcd (&rest integers) + (cond ((null integers) + 0) + ((null (cdr integers)) + (abs (first integers))) + ((null (cddr integers)) + (gcd-2 (first integers) (second integers))) + (t + (apply #'gcd (gcd (first integers) (second integers)) (nthcdr 2 integers))))) + +(defun lcm-2 (a b) + (if (or (zerop a) (zerop b)) + 0 + (/ (abs (* a b)) (gcd a b)))) + +(defun lcm (&rest integers) + (cond ((null integers) + 1) + ((null (cdr integers)) + (abs (first integers))) + ((null (cddr integers)) + (lcm-2 (first integers) (second integers))) + (t + (apply #'lcm (lcm (first integers) (second integers)) (nthcdr 2 integers))))) diff --git a/tests/numbers.lisp b/tests/numbers.lisp index 2d44def..811d423 100644 --- a/tests/numbers.lisp +++ b/tests/numbers.lisp @@ -66,3 +66,21 @@ (test (floatp pi)) (test (floatp (- pi))) (test (not (floatp 1))) + +;;; GCD +(test (= 0 (gcd))) +(test (= 6 (gcd 60 42))) +(test (= 1 (gcd 3333 -33 101))) +(test (= 11 (gcd 3333 -33 1002001))) +(test (= 7 (gcd 91 -49))) +(test (= 7 (gcd 63 -42 35))) +(test (= 5 (gcd 5))) +(test (= 4 (gcd -4))) + +;;; LCM +(test (= 10 (lcm 10))) +(test (= 150 (lcm 25 30))) +(test (= 360 (lcm -24 18 10))) +(test (= 70 (lcm 14 35))) +(test (= 0 (lcm 0 5))) +(test (= 60 (lcm 1 2 3 4 5 6))) -- 1.7.10.4