MAPLIST.

[jscl.git] / src / numbers.lisp

diff --git a/src/numbers.lisp b/src/numbers.lisp
index 060e657..66c2db8 100644 (file)
--- a/src/numbers.lisp
+++ b/src/numbers.lisp
@@ -15,23 +15,36 @@
 
 ;;;; Various numeric functions and constants
 
-;; Basic functions
-(defun * (x y) (* x y))
-(defun / (x y) (/ x y))
-(defun 1+ (x) (+ x 1))
-(defun 1- (x) (- x 1))
+;; TODO: Use MACROLET when it exists
+(defmacro define-variadic-op (operator initial-value)
+  (let ((init-sym   (gensym))
+        (dolist-sym (gensym)))
+    `(defun ,operator (&rest args)
+       (let ((,init-sym ,initial-value))
+         (dolist (,dolist-sym args)
+           (setq ,init-sym (,operator ,init-sym ,dolist-sym)))
+         ,init-sym))))
+
+(define-variadic-op + 0)
+(define-variadic-op * 1)
+
+;; - and / work differently from the above macro.
+;; If only one arg is given, it negates it or takes its reciprocal.
+;; Otherwise all the other args are subtracted from or divided by it.
+;; TODO: Use MACROLET when it exists
+(defmacro define-sub-or-div (operator unary-form)
+  `(defun ,operator (x &rest args)
+     (cond
+       ((null args) ,unary-form)
+       (t (dolist (y args)
+            (setq x (,operator x y)))
+          x))))
 
-(defun + (&rest args)
-  (let ((r 0))
-    (dolist (x args r)
-      (incf r x))))
+(define-sub-or-div - (-   x))
+(define-sub-or-div / (/ 1 x))
 
-(defun - (x &rest others)
-  (if (null others)
-      (- x)
-      (let ((r x))
-        (dolist (y others r)
-          (decf r y)))))
+(defun 1+ (x) (+ x 1))
+(defun 1- (x) (- x 1))
 
 (defun truncate (x &optional (y 1))
   (floor (/ x y)))
@@ -46,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)
@@ -60,6 +76,7 @@
 (defcomparison =) 
 (defcomparison <)
 (defcomparison <=)
+(defcomparison /=)
 
 (defconstant pi 3.141592653589793) 
 
@@ -77,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)))))