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.
Contents
Matrix & Vector Functions
;; 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
;; 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
;; 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
;; 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
;; 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
;; 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
;; 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
;; 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
;; 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))) )