3 ;; JSCL is free software: you can redistribute it and/or
4 ;; modify it under the terms of the GNU General Public License as
5 ;; published by the Free Software Foundation, either version 3 of the
6 ;; License, or (at your option) any later version.
8 ;; JSCL is distributed in the hope that it will be useful, but
9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 ;; General Public License for more details.
13 ;; You should have received a copy of the GNU General Public License
14 ;; along with JSCL. If not, see <http://www.gnu.org/licenses/>.
16 (/debug "loading numbers.lisp!")
18 ;;;; Various numeric functions and constants
20 (macrolet ((def (operator initial-value)
21 (let ((init-sym (gensym))
22 (dolist-sym (gensym)))
23 `(defun ,operator (&rest args)
24 (let ((,init-sym ,initial-value))
25 (dolist (,dolist-sym args)
26 (setq ,init-sym (,operator ,init-sym ,dolist-sym)))
31 ;; - and / work differently from the above macro.
32 ;; If only one arg is given, it negates it or takes its reciprocal.
33 ;; Otherwise all the other args are subtracted from or divided by it.
34 (macrolet ((def (operator unary-form)
35 `(defun ,operator (x &rest args)
37 ((null args) ,unary-form)
39 (setq x (,operator x y)))
45 (defun 1+ (x) (+ x 1))
46 (defun 1- (x) (- x 1))
48 (defun truncate (x &optional (y 1))
52 (and (numberp x) (= (floor x) x)))
55 (and (numberp x) (not (integerp x))))
57 (defun minusp (x) (< x 0))
58 (defun zerop (x) (= x 0))
59 (defun plusp (x) (< 0 x))
62 (if (zerop x) x (/ x (abs x))))
64 (macrolet ((def (operator)
65 `(defun ,operator (x &rest args)
69 (return-from ,operator nil)))
78 (defconstant pi 3.141592653589793)
80 (defun evenp (x) (= (mod x 2) 0))
81 (defun oddp (x) (not (evenp x)))
83 (macrolet ((def (name comparison)
84 `(defun ,name (x &rest xs)
86 (when (,comparison y x)
92 (defun abs (x) (if (> x 0) x (- x)))
94 (defun expt (base power) (expt base power))
95 (defun exp (power) (expt 2.718281828459045 power))
97 (defun sqrt (x) (sqrt x))
102 (gcd-2 b (mod a b))))
104 (defun gcd (&rest integers)
105 (cond ((null integers)
107 ((null (cdr integers))
108 (abs (first integers)))
109 ((null (cddr integers))
110 (gcd-2 (first integers) (second integers)))
112 (apply #'gcd (gcd (first integers) (second integers)) (nthcdr 2 integers)))))
115 (if (or (zerop a) (zerop b))
117 (/ (abs (* a b)) (gcd a b))))
119 (defun lcm (&rest integers)
120 (cond ((null integers)
122 ((null (cdr integers))
123 (abs (first integers)))
124 ((null (cddr integers))
125 (lcm-2 (first integers) (second integers)))
127 (apply #'lcm (lcm (first integers) (second integers)) (nthcdr 2 integers)))))