Mathematical Functions

Here I present a small library of mathematically oriented subfunctions, encompassing functions for Matrix & Vector manipulation, Trigonometric functions, Complex Number functions, Factorial functions & Geometric functions.

Information about the purpose each function and its required arguments is detailed in the function headers.

Matrix & Vector Functions

Select all
;; Matrix Determinant (Upper Triangular Form)  -  ElpanovEvgeniy
;; Args: m - nxn matrix

(defun detm ( m / d )
    (cond
        (   (null m) 1)
        (   (and (zerop (caar m))
                 (setq d (car (vl-member-if-not (function (lambda ( a ) (zerop (car a)))) (cdr m))))
            )
            (detm (cons (mapcar '+ (car m) d) (cdr m)))
        )
        (   (zerop (caar m)) 0)
        (   (*  (caar m)
                (detm
                    (mapcar
                        (function
                            (lambda ( a / d ) (setq d (/ (car a) (float (caar m))))
                                (mapcar
                                    (function
                                        (lambda ( b c ) (- b (* c d)))
                                    )
                                    (cdr a) (cdar m)
                                )
                            )
                        )
                        (cdr m)
                    )
                )
            )
        )
    )
)

;; Matrix Determinant (Laplace Formula)  -  Lee Mac
;; Args: m - nxn matrix
 
(defun detm ( m / i j )
    (setq i -1 j 0)
    (cond
        (   (null (cdr  m)) (caar m))
        (   (null (cddr m)) (- (* (caar m) (cadadr m)) (* (cadar m) (caadr m))))
        (   (apply '+
                (mapcar
                   '(lambda ( c ) (setq j (1+ j))
                        (* c (setq i (- i))
                            (detm
                                (mapcar
                                   '(lambda ( x / k )
                                        (setq k 0)
                                        (vl-remove-if '(lambda ( y ) (= j (setq k (1+ k)))) x)
                                    )
                                    (cdr m)
                                )
                            )
                        )
                    )
                    (car m)
                )
            )
        )
    )
)

;; Matrix Inverse  -  gile & Lee Mac
;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn matrix.
;; Args: m - nxn matrix

(defun invm ( m / c f p r )
    
    (defun f ( p m )
        (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (- a (* (car x) b))) (cdr x) p)) m)
    )
    (setq  m (mapcar 'append m (imat (length m))))
    (while m
        (setq c (mapcar '(lambda ( x ) (abs (car x))) m))
        (repeat (vl-position (apply 'max c) c)
            (setq m (append (cdr m) (list (car m))))
        )
        (if (equal 0.0 (caar m) 1e-14)
            (setq m nil
                  r nil
            )
            (setq p (mapcar '(lambda ( x ) (/ (float x) (caar m))) (cdar m))
                  m (f p (cdr m))
                  r (cons p (f p r))
            )
        )
    )
    (reverse r)
)

;; Identity Matrix  -  Lee Mac
;; Args: n - matrix dimension

(defun imat ( n / i j l m )
    (repeat (setq i n)
        (repeat (setq j n)
            (setq l (cons (if (= i j) 1.0 0.0) l)
                  j (1- j)
            )
        )
        (setq m (cons l m)
              l nil
              i (1- i)
        )
    )
    m
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
    (apply 'mapcar (cons 'list m))
)

;; Matrix Trace  -  Lee Mac
;; Args: m - nxn matrix

(defun trc ( m )
    (if m (+ (caar m) (trc (mapcar 'cdr (cdr m)))) 0)
)

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix + Matrix  -  Lee Mac
;; Args: m,n - nxn matrices

(defun m+m ( m n )
    (mapcar '(lambda ( r s ) (mapcar '+ r s)) m n)
)

;; Matrix x Scalar  -  Lee Mac
;; Args: m - nxn matrix, n - real scalar

(defun mxs ( m s )
    (mapcar '(lambda ( r ) (mapcar '(lambda ( n ) (* n s)) r)) m)
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
    (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n

(defun vxv ( u v )
    (apply '+ (mapcar '* u v))
)

;; Vector Cross Product  -  Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
    (list
        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
)

;; Unit Vector  -  Lee Mac
;; Args: v - vector in R^2 or R^3

(defun vx1 ( v )
    (   (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
        (distance '(0.0 0.0 0.0) v)
    )
)

;; Vector Norm (R^n)  -  Lee Mac
;; Args: v - vector in R^n

(defun |v| ( v )
    (sqrt (apply '+ (mapcar '* v v)))
)

;; Unit Vector (R^n)  -  Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
    ((lambda ( n ) (if (equal 0.0 n 1e-10) nil (vxs v (/ 1.0 n)))) (|v| v))
)

Trigonometric Functions

Select all
;; Tangent  -  Lee Mac
;; Args: x - real

(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;; ArcSine  -  Lee Mac
;; Args: -1 <= x <= 1

(defun asin ( x )
    (if (<= -1.0 x 1.0)
        (atan x (sqrt (- 1.0 (* x x))))
    )
)

;; ArcCosine  -  Lee Mac
;; Args: -1 <= x <= 1

(defun acos ( x )
    (if (<= -1.0 x 1.0)
        (atan (sqrt (- 1.0 (* x x))) x)
    )
)

;; Hyperbolic Sine  -  Lee Mac
;; Args: x - real

(defun sinh ( x )
    (/ (- (exp x) (exp (- x))) 2.0)
)

;; Hyperbolic Cosine  -  Lee Mac
;; Args: x - real

(defun cosh ( x )
    (/ (+ (exp x) (exp (- x))) 2.0)
)

;; Hyperbolic Tangent  -  Lee Mac
;; Args: x - real

(defun tanh ( x )
    (/ (sinh x) (cosh x))
)

;; Area Hyperbolic Sine  -  Lee Mac
;; Args: x - real

(defun asinh ( x )
    (log (+ x (sqrt (1+ (* x x)))))
)

;; Area Hyperbolic Cosine  -  Lee Mac
;; Args: 1 <= x

(defun acosh ( x )
    (if (<= 1.0 x)
        (log (+ x (sqrt (1- (* x x)))))
    )
)

;; Area Hyperbolic Tangent  -  Lee Mac
;; Args: -1 < x < 1

(defun atanh ( x )
    (if (< (abs x) 1.0)
        (/ (log (/ (1+ x) (- 1.0 x))) 2.0)
    )
)

Geometric Functions

Predicate Functions

Select all
;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear

(defun LM:Collinear-p ( p1 p2 p3 )
    (
        (lambda ( a b c )
            (or
                (equal (+ a b) c 1e-8)
                (equal (+ b c) a 1e-8)
                (equal (+ c a) b 1e-8)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
)

;; List Collinear-p  -  Lee Mac
;; Returns T if all points in a list are collinear

(defun LM:ListCollinear-p ( lst )
    (or (null (cddr lst))
        (and
            (equal 1.0
                (abs
                    (vxv
                        (vx1 (mapcar '- (car lst) (cadr  lst)))
                        (vx1 (mapcar '- (car lst) (caddr lst)))
                    )
                )
                1e-8
            )
            (LM:ListCollinear-p (cdr lst))
        )
    )
)

;; Coplanar-p  -  Lee Mac
;; Returns T if points p1,p2,p3,p4 are coplanar

(defun LM:Coplanar-p ( p1 p2 p3 p4 )
    (
        (lambda ( n )
            (equal
                (last (trans p3 0 n))
                (last (trans p4 0 n))
                1e-8
            )
        )
        (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
    )
)

;; List Coplanar-p  -  Lee Mac
;; Returns T if all points in a list are coplanar

(defun LM:ListCoplanar-p ( lst )
    (or (null (cdddr lst))
        (and
            (
                (lambda ( n )
                    (equal
                        (last (trans (caddr  lst) 0 n))
                        (last (trans (cadddr lst) 0 n))
                        1e-8
                    )
                )
                (v^v (mapcar '- (car lst) (cadr lst)) (mapcar '- (car lst) (caddr lst)))
            )
            (LM:ListCoplanar-p (cdr lst))
        )
    )
)

;; Perpendicular-p  -  Lee Mac
;; Returns T if vectors v1,v2 are perpendicular

(defun LM:Perpendicular-p ( v1 v2 )
    (equal 0.0 (vxv v1 v2) 1e-8)
)

;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:Clockwise-p ( p1 p2 p3 )
    (<
        (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
        (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
    )
)

;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented

(defun LM:ListClockwise-p ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

;; InsideTriangle-p  -  Lee Mac
;; Returns T if pt lies inside the triangle formed by p1,p2,p3

(defun LM:InsideTriangle-p ( pt p1 p2 p3 )
    (
        (lambda ( a1 a2 a3 )
            (or
                (and (<= 0.0 a1) (<= 0.0 a2) (<= 0.0 a3))
                (and (<= a1 0.0) (<= a2 0.0) (<= a3 0.0))
            )
        )
        (sin (- (angle p1 pt) (angle p1 p2)))
        (sin (- (angle p2 pt) (angle p2 p3)))
        (sin (- (angle p3 pt) (angle p3 p1)))
    )
)

Projections

Select all
;; Project Point onto Line  -  Lee Mac
;; Projects pt onto the line defined by p1,p2

(defun LM:ProjectPointToLine ( pt p1 p2 / nm )
    (setq nm (mapcar '- p2 p1)
          p1 (trans p1 0 nm)
          pt (trans pt 0 nm)
    )
    (trans (list (car p1) (cadr p1) (caddr pt)) nm 0)
)

;; Project Point onto Plane  -  Lee Mac
;; Projects pt onto the plane defined by its origin and normal

(defun LM:ProjectPointToPlane ( pt org nm )
    (setq pt  (trans pt  0 nm)
          org (trans org 0 nm)
    )
    (trans (list (car pt) (cadr pt) (caddr org)) nm 0)
)

;; Reflect Point  -  Lee Mac
;; Returns the point obtained by reflecting 'pt' in the axis defined by points p1 & p2.

(defun LM:Reflect ( pt p1 p2 / ax )
    (setq ax (mapcar '- p1 p2)
          p1 (trans p1 0 ax)
          pt (trans pt 0 ax)
    )
    (trans (cons (- (+ (car p1) (car p1)) (car pt)) (cdr pt)) ax 0)
)

Intersections

Select all
;; Line-Plane Intersection  -  Lee Mac
;; Returns the point of intersection of a line defined by
;; points p1,p2 and a plane defined by its origin and normal

(defun LM:inters-line-plane ( p1 p2 org nm )
    (setq org (trans org 0 nm)
          p1  (trans p1  0 nm)
          p2  (trans p2  0 nm)
    )
    (trans
        (inters p1 p2
            (list (car p1) (cadr p1) (caddr org))
            (list (car p2) (cadr p2) (caddr org))
            nil
        )
        nm 0
    )
)

;; Line-Circle Intersection  -  Lee Mac
;; Returns the point(s) of intersection between an infinite line defined by
;; points p,q and circle with centre c and radius r

(defun LM:inters-line-circle ( p q c r / a d n s )
    (setq n (mapcar '- q p)
          p (trans p 0 n)
          c (trans c 0 n)
          a (list (car p) (cadr p) (caddr c))
    )
    (cond
        (   (equal r (setq d (distance c a)))
            (list (trans a n 0))
        )
        (   (< d r)
            (setq s (sqrt (- (* r r) (* d d))))
            (list
                (trans (list (car p) (cadr p) (- (caddr c) s)) n 0)
                (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0)
            )
        )
    )
)

;; Line-Circle Intersection (vector version)  -  Lee Mac
;; Returns the point(s) of intersection between an infinite line defined by
;; points p,q and circle with centre c and radius r

(defun LM:inters-line-circle ( p q c r / v s )
    (setq v (mapcar '- q p)
          s (mapcar '- p c)
    )
    (mapcar '(lambda ( s ) (mapcar '+ p (vxs v s)))
        (quad (vxv v v) (* 2 (vxv v s)) (- (vxv s s) (* r r)))
    )
)

;; 2-Circle Intersection  -  Lee Mac
;; Returns the point(s) of intersection between two circles
;; with centres c1,c2 and radii r1,r2

(defun LM:inters-circle-circle ( c1 r1 c2 r2 / a d m l x y )
    (if (and (<= (setq d (distance c1 c2)) (+ r1 r2))
             (<= (abs (- r1 r2)) d)
        )
        (progn
            (if (equal r1 (setq x (/ (- (+ (* r1 r1) (* d d)) (* r2 r2)) (+ d d))) 1e-8)
                (setq  l  (list (list x 0.0 0.0)))
                (setq  y  (sqrt (- (* r1 r1) (* x x)))
                       l  (list (list x y 0.0) (list x (- y) 0.0))
                )
            )
            (setq a (angle c1 c2)
                  m (list (list (cos a) (- (sin a)) 0) (list (sin a) (cos a) 0) '(0 0 1))
            )
            (mapcar '(lambda ( v ) (mapcar '+ c1 (mxv m v))) l)
        )
    )
)

;; 2-Circle Intersection (trans version)  -  Lee Mac
;; Returns the point(s) of intersection between two circles
;; with centres c1,c2 and radii r1,r2

(defun LM:inters-circle-circle ( c1 r1 c2 r2 / n d1 x z )
    (if
        (and
            (< (setq d1 (distance c1 c2)) (+ r1 r2))
            (< (abs (- r1 r2)) d1)
        )
        (progn
            (setq n  (mapcar '- c2 c1)
                  c1 (trans c1 0 n)
                  z  (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))
            )
            (if (equal z r1 1e-8)
                (list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 0))
                (progn
                    (setq x (sqrt (- (* r1 r1) (* z z))))
                    (list
                        (trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
                        (trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 0)
                    )
                )
            )
        )
    )
)

;; 2-Arc Intersection  -  Lee Mac
;; Returns the point(s) of intersection between two arcs
;; with centres c1,c2 radii r1,r2, start angles s1,s2 & end angles e1,e2

(defun LM:inters-arc-arc ( c1 r1 s1 e1 c2 r2 s2 e2 )
    (cond
        (   (< e1 s1) (LM:inters-arc-arc c1 r1 s1 (+ e1 pi pi) c2 r2 s2 e2))
        (   (< e2 s2) (LM:inters-arc-arc c1 r1 s1 e1 c2 r2 s2 (+ e2 pi pi)))
        (   (vl-remove-if-not
               '(lambda ( pt ) (and (<= s1 (angle c1 pt) e1) (<= s2 (angle c2 pt) e2)))
                (LM:inters-circle-circle c1 r1 c2 r2)
            )
        )
    )
)

Geometric Calculation

Select all
;; Midpoint  -  Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Polygon Centroid  -  Lee Mac
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM:PolyCentroid ( e / l )
    (foreach x (setq e (entget e))
        (if (= 10 (car x)) (setq l (cons (cdr x) l)))
    )
    (
        (lambda ( a )
            (if (not (equal 0.0 a 1e-8))
                (trans
                    (mapcar '/
                        (apply 'mapcar
                            (cons '+
                                (mapcar
                                    (function
                                        (lambda ( a b )
                                            (
                                                (lambda ( m )
                                                    (mapcar
                                                        (function
                                                            (lambda ( c d ) (* (+ c d) m))
                                                        )
                                                        a b
                                                    )
                                                )
                                                (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                                            )
                                        )
                                    )
                                    l (cons (last l) l)
                                )
                            )
                        )
                        (list a a)
                    )
                    (cdr (assoc 210 e)) 0
                )
            )
        )
        (* 3.0
            (apply '+
                (mapcar
                    (function
                        (lambda ( a b )
                            (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                        )
                    )
                    l (cons (last l) l)
                )
            )
        )
    )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the center and radius of the circle defined by three supplied points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
    (setq m1 (mid p1 p2)
          m2 (mid p2 p3)
    )
    (if
        (setq cn
            (inters
                m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
                m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
                nil
            )
        )
        (list cn (distance cn p1))
    )
)

;; 3-Point Circle (Cartesian)  -  Lee Mac
;; Returns the center and radius of the circle defined by the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / a b c d )
    (setq p2 (mapcar '- p2 p1)
          p3 (mapcar '- p3 p1)
          a  (* 2.0 (- (* (car p2) (cadr p3)) (* (cadr p2) (car p3))))
          b  (distance '(0.0 0.0) p2)
          c  (distance '(0.0 0.0) p3)
          b  (* b b)
          c  (* c c)
    )
    (if (not (equal 0.0 a 1e-8))
        (list
            (setq d
                (mapcar '+ p1
                    (list
                        (/ (- (* (cadr p3) b) (* (cadr p2) c)) a)
                        (/ (- (* (car  p2) c) (* (car  p3) b)) a)
                        0.0
                    )
                )
            )
            (distance d p1)
        )
    )
)

;; 3-Point Arc  -  Lee Mac
;; Returns the center, start/end angle and radius of the arc defined by three supplied points.

(defun LM:3PArc ( p1 p2 p3 / cn m1 m2 )
    (setq m1 (mid p1 p2)
          m2 (mid p2 p3)
    )
    (if
        (setq cn
            (inters
                m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
                m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
                nil
            )
        )
        (append (list cn)
            (if (LM:Clockwise-p p1 p2 p3)
                (list (angle cn p3) (angle cn p1))
                (list (angle cn p1) (angle cn p3))
            )
            (list (distance cn p1))
        )
    )
)

;; 2-Circle Tangents  -  Lee Mac
;; Returns the two groups of points for which a line from a point in
;; each group is tangent to both circles with centres c1,c2 and radii r1,r2

(defun LM:2CircleTangents ( c1 r1 c2 r2 / d1 d2 a1 a2 )
    (if (< (abs (setq d1 (- r1 r2))) (setq d2 (distance c1 c2)))
        (progn
            (setq a1 (atan (sqrt (- (* d2 d2) (* d1 d1))) d1)
                  a2 (angle c1 c2)
            )
            (list
                (list (polar c1 (+ a2 a1) r1) (polar c1 (- a2 a1) r1))
                (list (polar c2 (+ a2 a1) r2) (polar c2 (- a2 a1) r2))
            )
        )
    )
)

;; Point-Circle Tangents  -  Lee Mac
;; Returns the two points for which a line from 'pt' to each point returned
;; is tangent to the circle with centre c1 and radius r1

(defun LM:PointCircleTangents ( pt c1 r1 / a1 a2 d1 )
    (if (< r1 (setq a1 (angle c1 pt) d1 (distance pt c1)))
        (progn
            (setq a2 (atan (sqrt (- (* d1 d1) (* r1 r1))) r1))
            (list
                (polar c1 (+ a1 a2) r1)
                (polar c1 (- a1 a2) r1)
            )
        )
    )
)

Arithmetic Functions

Select all
;; Quadratic Solution  -  Lee Mac
;; Args: a,b,c - coefficients of ax^2 + bx + c = 0
 
(defun quad ( a b c / d r )
    (cond
        (   (equal 0.0 (setq d (- (* b b) (* 4.0 a c))) 1e-8)
            (list (/ b (* -2.0 a)))
        )
        (   (< 0 d)
            (setq r (sqrt d))
            (list (/ (- r b) (* 2.0 a)) (/ (- (- b) r) (* 2.0 a)))
        )
    )
)

;; Least Common Multiple  -  Lee Mac
;; Args: a,b - positive non-zero integers

(defun lcm ( a b ) (* b (/ a (gcd a b))))

;; Least Common Multiple of List  -  Lee Mac
;; Args: l - list of positive non-zero integers

(defun lcml ( l )
   (if (cddr l)
       (lcm (car l) (lcml (cdr l)))
       (apply 'lcm l)
   )
)

;; Prime Factors  -  Lee Mac
;; Args: n - positive non-zero integer

(defun pf ( n / m p r )
    (setq p 2)
    (while (< 1 n)
        (while (zerop (rem n p))
            (setq r (cons p r)
                  n (/ n p)
            )
        )
        (if (< 1 (setq m (sqrt n)) (setq p (if (= p 2) 3 (+ 2 p))))
            (setq r (cons n r)
                  n 0
            )
            (while (and (<= p m) (< 0 (rem n p)))
                (setq p (+ 2 p))
            )
        )
    )
    (reverse r)
)

;; Prime-p  -  Lee Mac
;; Args: n - positive non-zero integer

(defun prime-p ( n / m p )
    (or (= 2 n)
        (and
            (< 2 n)
            (= 1 (rem n 2))
            (progn
                (setq m (1+ (sqrt n))
                      p 3
                )
                (while (and (< p m) (< 0 (rem n p)))
                    (setq p (+ 2 p))
                )
                (< m p)
            )
        )
    )
)

Factorial Functions

Select all
;; Factorial  -  Lee Mac
;; Args: n - positive integer

(defun n! ( n / r )
    (setq r n)
    (repeat (fix (- n 2)) (setq r (* r (setq n (1- n)))))
    (if (< r 2) 1 r)
)

;; Factorial (recursive version)  -  Lee Mac
;; Args: n - positive integer

(defun n!-rec ( n )
    (if (< n 2) 1 (* n (n!-rec (1- n))))
)

;; Factorial Division  -  Lee Mac
;; Args: n,k - positive integers

(defun n!/k! ( n k / m r )
    (cond
        (   (= n k) 1)
        (   (setq r (max n k) m r)
            (repeat (fix (1- (abs (- n k)))) (setq r (* r (setq m (1- m)))))
            (if (< k n) r (/ 1.0 r))
        )
    )
)

;; Factorial Multiplication  -  Lee Mac
;; Args: n,k - positive integers

(defun n!k! ( n k / m )
    (setq m (n! (min n k)))
    (* (n!/k! (max n k) (min n k)) m m)
)

Complex Number Functions

For the following functions pertaining to the arithmetic manipulation of complex numbers, the parameters requiring complex numbers should be in the form of a list of two elements representing the real and imaginary coefficients of the complex number, i.e. the complex number a+bi would be represented by the list (a b).

For example, in order to multiply the complex numbers 3+4i & 2+5i, the cxc function would be called in the following way:

(3+4i)(2+5i):

(cxc '(3 4) '(2 5))  ==>  (-14 23) = -14+23i
Select all
;; Complex Addition  -  Lee Mac
;; Args: c1,c2 - complex numbers of the form a+bi = (a b)

(defun c+c ( c1 c2 )
    (mapcar '+ c1 c2)
)

;; Complex Subtraction  -  Lee Mac
;; Args: c1,c2 - complex numbers of the form a+bi = (a b)

(defun c-c ( c1 c2 )
    (mapcar '- c1 c2)
)

;; Complex Multiplication  -  Lee Mac
;; Args: c1,c2 - complex numbers of the form a+bi = (a b)

(defun cxc ( c1 c2 )
    (list
        (- (* (car c1) (car  c2)) (* (cadr c1) (cadr c2)))
        (+ (* (car c1) (cadr c2)) (* (cadr c1) (car  c2)))
    )
)

;; Complex Conjugate  -  Lee Mac
;; Args: c1 - complex number of the form a+bi = (a b)

(defun c_ ( c1 )
    (list (car c1) (- (cadr c1)))
)

;; Complex Division  -  Lee Mac
;; Args: c1,c2 - complex numbers of the form a+bi = (a b)

(defun c/c ( c1 c2 / d )
    (   (lambda ( d ) (mapcar '(lambda ( x ) (/ x d)) (cxc c1 (c_ c2))))
        (car (cxc c2 (c_ c2)))
    )
)

;; Complex Norm  -  Lee Mac
;; Args: c1 - complex number of the form a+bi = (a b)

(defun |c| ( c1 )
    (sqrt (apply '+ (mapcar '* c1 c1)))
)

textsize

increase · reset · decrease

Designed & Created by Lee Mac © 2010