# 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))
(   (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
)
)

;; 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 )
(<
)
)

;; 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 )
)
)
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)
)
)

;; 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)
)
)

;; 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
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)
)
(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:arc-arc-inters c1 r1 s1 (+ e1 pi pi) c2 r2 s2 e2))
(   (< e2 s2) (LM:arc-arc-inters 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
)
)
)
)
)
l (cons (last l) l)
)
)
)
(list a a)
)
(cdr (assoc 210 e)) 0
)
)
)
(* 3.0
(apply '+
(mapcar
(function
(lambda ( a b )
)
)
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
(/ (- (* (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
)
)

;; 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