### Author Topic: nxn matrices - challenge  (Read 9377 times)

0 Members and 1 Guest are viewing this topic.

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### nxn matrices - challenge
« on: November 11, 2013, 01:30:14 PM »
I never had some math books ab matrices, so my research is totally unknown...

With this my examples, I realized that I can't get correct m/m if determinant is 0.0... Beside that, maybe I am wrong and maybe there is more elegant and efficient way to accomplish this task and what is more important my version isn't correct... It may give correct result in random cases but with this case I am pretty stuck... If I multiply 2 matrices and get their product, when I try to divide product with one of these 2 matrix I get wrong or error result (divide by zero)... Can someone reply with right direction?

Code - Auto/Visual Lisp: [Select]
1. ;;;***********************************************************************************;;;
2. ;;; (detm m) function calculates determinant of square martix                         ;;;
3. ;;; Marko Ribar, d.i.a.                                                               ;;;
4. ;;; Args: m - nxn matrix                                                              ;;;
5. ;;; (detm '((0 1) (1 0)))                                                             ;;;
6. ;;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
7. ;;;***********************************************************************************;;;
8. (defun detm ( m / d i j r )
9.
10.   (defun d ( k n / z )
11.     (setq k (cdr k))
12.     (setq k (apply 'mapcar (cons 'list k)))
13.     (setq z -1)
14.     (while (<= (setq z (1+ z)) (length k))
15.       (if (eq z n)
16.         (setq k (cdr k))
17.         (setq k (reverse (cons (car k) (reverse (cdr k)))))
18.       )
19.     )
20.     (setq k (apply 'mapcar (cons 'list k)))
21.     (if (= (length k) 1) (caar k) k)
22.   )
23.
24.   (if (not (eq (length m) 1))
25.       (setq i -1)
26.       (setq j -1)
27.       (setq r 0)
28.       (foreach e (car m)
29.         (setq i (1+ i))
30.         (setq j (* j (- 1)))
31.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
32.       )
33.       r
34.     )
35.     (caar m)
36.   )
37. )
38.
39. ;; TRP
40. ;; Transposes a matrix -Doug Wilson-
41. ;;
42. ;; Argument : a matrix
43.
44. (defun trp (m) (apply 'mapcar (cons 'list m)))
45.
46. ;; MXV
47. ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
48. ;;
49. ;; Arguments : a matrix and a vector
50.
51. (defun mxv (m v)
52.   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
53.           m
54.   )
55. )
56.
57. ;; MXM
58. ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
59. ;;
60. ;; Arguments : two matrices
61.
62. (defun mxm (m q)
63.   (mapcar (function (lambda (r) (mxv (trp q) r))) m)
64. )
65.
66. ;; M/V
67. ;; Applies a transformation matrix to a vector -Marko Ribar-
68. ;;
69. ;; Arguments : a matrix and a vector
70.
71. (defun m/v (m v)
72.       (lambda (r)
73.         (apply '+
74.                (mapcar '/ r (mapcar (function (lambda (r) (* -1 r))) v))
75.         )
76.       )
77.     )
78.     m
79.   )
80. )
81.
82. ;; M/M
83. ;; Divides two matrices -Marko Ribar-
84. ;;
85. ;; Arguments : two matrices
86.
87. (defun m/m (m q / Dq k j D mj mk)
88.   (setq Dq (detm (trp q)))
89.   (setq k -1)
90.   (repeat (length m)
91.     (setq k (1+ k))
92.     (setq j -1)
93.     (repeat (length (car (trp q)))
94.       (setq j (1+ j))
95.       (setq D
96.              (detm
97.                    (lambda (x y)
98.                      (subst x (nth j y) y)
99.                    )
100.                  )
101.                  (nth k m)
102.                  (trp q)
103.                )
104.              )
105.       )
106.       (setq mj (cons (/ D Dq) mj))
107.     )
108.     (setq mj (reverse mj))
109.     (setq mk (cons mj mk))
110.     (setq mj nil)
111.   )
112.   (reverse mk)
113. )
114.
115. (defun c:m1xm2 ()
116.   (setq mat1 '(
117.                (10. 20. 30.)
118.                (40. 50. 60.)
119.                (70. 80. 90.)
120.               )
121.   )
122.   (setq mat2 '(
123.                (90. 80. 70.)
124.                (60. 50. 40.)
125.                (30. 20. 10.)
126.               )
127.   )
128.   (princ (setq mm (mxm mat1 mat2)))
129.   (prin1)
130. )
131.
132. (defun c:mm/m2 ()
133.   (princ (m/m mm mat2))
134.   (prin1)
135. )
136.
137. (defun c:mm/m1 ()
138.   (princ (m/m mm mat1))
139.   (prin1)
140. )
141.

M.R.
« Last Edit: June 13, 2015, 12:00:48 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #1 on: November 11, 2013, 06:34:55 PM »
I figured that only with normal multiplications and divisions of matrices, results can be correct in both directions (m/m-n mm mat1) = mat2 and (m/m-n mm mat2) = mat1... With (transposed additional multiplication and division) direction is single : (mxm mat1 mat2) = mm; (m/m mm mat2) = mat1, but (m/m mm mat1) /= mat2...

Beside this with normal multiplication and division of matrices there can't be error (determinant isn't used in calculations, so no divide by zero error)

Code - Auto/Visual Lisp: [Select]
1. ;;;***********************************************************************************;;;
2. ;;; (detm m) function calculates determinant of square martix                         ;;;
3. ;;; Marko Ribar, d.i.a.                                                               ;;;
4. ;;; Args: m - nxn matrix                                                              ;;;
5. ;;; (detm '((0 1) (1 0)))                                                             ;;;
6. ;;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
7. ;;;***********************************************************************************;;;
8. (defun detm ( m / d i j r )
9.
10.   (defun d ( k n / z )
11.     (setq k (cdr k))
12.     (setq k (apply 'mapcar (cons 'list k)))
13.     (setq z -1)
14.     (while (<= (setq z (1+ z)) (length k))
15.       (if (eq z n)
16.         (setq k (cdr k))
17.         (setq k (reverse (cons (car k) (reverse (cdr k)))))
18.       )
19.     )
20.     (setq k (apply 'mapcar (cons 'list k)))
21.     (if (= (length k) 1) (caar k) k)
22.   )
23.
24.   (if (not (eq (length m) 1))
25.       (setq i -1)
26.       (setq j -1)
27.       (setq r 0)
28.       (foreach e (car m)
29.         (setq i (1+ i))
30.         (setq j (* j (- 1)))
31.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
32.       )
33.       r
34.     )
35.     (caar m)
36.   )
37. )
38.
39. ;; TRP
40. ;; Transposes a matrix -Doug Wilson-
41. ;;
42. ;; Argument : a matrix
43.
44. (defun trp (m) (apply 'mapcar (cons 'list m)))
45.
46. ;; MXV
47. ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
48. ;;
49. ;; Arguments : a matrix and a vector
50.
51. (defun mxv (m v)
52.  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
53.          m
54.  )
55. )
56.
57. ;; MXM
58. ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
59. ;;
60. ;; Arguments : two matrices
61.
62. (defun mxm (m q)
63.  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
64. )
65.
66. ;; MXM-N
67. ;; Multiplies two matrices (normal) -Marko Ribar-
68. ;;
69. ;; Arguments : two matrices
70.
71. (defun mxm-n (m q)
72.  (mapcar (function (lambda (r j) (mapcar (function (lambda (a b) (* a b))) r j))) m q)
73. )
74.
75. ;; M/V
76. ;; Applies a transformation matrix to a vector (inverse signs multiplication) -Marko Ribar-
77. ;;
78. ;; Arguments : a matrix and a vector
79.
80. (defun m/v (m v)
81.      (lambda (r)
82.        (apply '+
83.               (mapcar '/ r (mapcar (function (lambda (r) (* -1 r))) v))
84.        )
85.      )
86.    )
87.    m
88.  )
89. )
90.
91. ;; V/M
92. ;; Calculates vector of division of vector and matrix -Marko Ribar-
93. ;; (v/m (mxv mat v) mat) = v
94. ;; Arguments : a vector and a matrix
95.
96. (defun v/m (v m / Dm k D mk)
97.  (setq Dm (detm m))
98.  (setq k -1)
99.  (repeat (length v)
100.    (setq k (1+ k))
101.    (setq D
102.           (detm
103.                 (lambda (x y)
104.                   (subst x (nth k y) y)
105.                 )
106.               )
107.               v
108.               m
109.             )
110.           )
111.    )
112.    (setq mk (cons (/ D Dm) mk))
113.  )
114.  (reverse mk)
115. )
116.
117. ;; M/M
118. ;; Divides two matrices -Marko Ribar-
119. ;;
120. ;; Arguments : two matrices
121.
122. (defun m/m (m q / Dq k j D mj mk)
123.  (setq Dq (detm (trp q)))
124.  (setq k -1)
125.  (repeat (length m)
126.    (setq k (1+ k))
127.    (setq j -1)
128.    (repeat (length (car (trp q)))
129.      (setq j (1+ j))
130.      (setq D
131.             (detm
132.                   (lambda (x y)
133.                     (subst x (nth j y) y)
134.                   )
135.                 )
136.                 (nth k m)
137.                 (trp q)
138.               )
139.             )
140.      )
141.      (setq mj (cons (/ D Dq) mj))
142.    )
143.    (setq mj (reverse mj))
144.    (setq mk (cons mj mk))
145.    (setq mj nil)
146.  )
147.  (reverse mk)
148. )
149.
150. ;; M/M-N
151. ;; Divides two matrices (normal) -Marko Ribar-
152. ;;
153. ;; Arguments : two matrices
154.
155. (defun m/m-n (m q)
156.  (mapcar (function (lambda (r j) (mapcar (function (lambda (a b) (/ a b))) r j))) m q)
157. )
158.
159. (defun c:m1xm2 ()
160.  (setq mat1 '(
161.               (1. 4. 7.)
162.               (3. 6. 5.)
163.               (2. 9. 8.)
164.              )
165.  )
166.  (setq mat2 '(
167.               (1. 5. 6.)
168.               (3. 2. 8.)
169.               (9. 7. 4.)
170.              )
171.  )
172.  (princ (setq mm (mxm mat1 mat2)))
173.  (prin1)
174. )
175.
176. (defun c:mm/m2 ()
177.  (princ (m/m mm mat2))
178.  (prin1)
179. )
180.
181. (defun c:m1xm2-n ()
182.  (setq mat1 '(
183.               (1. 4. 7.)
184.               (3. 6. 5.)
185.               (2. 9. 8.)
186.              )
187.  )
188.  (setq mat2 '(
189.               (1. 5. 6.)
190.               (3. 2. 8.)
191.               (9. 7. 4.)
192.              )
193.  )
194.  (princ (setq mm (mxm-n mat1 mat2)))
195.  (prin1)
196. )
197.
198. (defun c:mm/m2-n ()
199.  (princ (m/m-n mm mat2))
200.  (prin1)
201. )
202.
203. (defun c:mm/m1-n ()
204.  (princ (m/m-n mm mat1))
205.  (prin1)
206. )
207.

M.R.
« Last Edit: June 13, 2015, 12:00:16 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #2 on: November 12, 2013, 09:07:41 AM »

Code - Auto/Visual Lisp: [Select]
1. ;; V/M
2. ;; Calculates vector of division of vector and matrix -Marko Ribar-
3. ;; (v/m (mxv mat v) mat) = v
4. ;; Arguments : a vector and a matrix
5.

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### Stefan

• Bull Frog
• Posts: 321
• The most I miss IRL is the Undo button
##### Re: nxn matrices - challenge
« Reply #3 on: November 12, 2013, 11:24:09 AM »
Hi Marko

Just a remark: (detm '((0 1) (1 0))) = 0 but it should be -1.

Try one of this http://www.theswamp.org/index.php?topic=30944.0

#### Lee Mac

• Seagull
• Posts: 12943
• London, England
##### Re: nxn matrices - challenge
« Reply #4 on: November 12, 2013, 11:53:28 AM »
Here is an updated version of my code in that thread:
Code - Auto/Visual Lisp: [Select]
1. ;; Matrix Determinant  -  Lee Mac
2. ;; Args: m - nxn matrix
3.
4. (defun detm ( m / i j )
5.     (setq i -1 j 0)
6.     (cond
7.         (   (null (cdr  m)) (caar m))
9.         (   (apply '+
10.                    '(lambda ( c ) (setq j (1+ j))
11.                         (* c (setq i (- i))
12.                             (detm
13.                                    '(lambda ( x / k )
14.                                         (setq k 0)
15.                                         (vl-remove-if '(lambda ( y ) (= j (setq k (1+ k)))) x)
16.                                     )
17.                                     (cdr m)
18.                                 )
19.                             )
20.                         )
21.                     )
22.                     (car m)
23.                 )
24.             )
25.         )
26.     )
27. )
Code - Auto/Visual Lisp: [Select]
1. _\$ (detm '((0 1) (1 0)))
2. -1
3. _\$ (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1)))
4. -577.975
( Verification of last example )
« Last Edit: November 12, 2013, 11:58:14 AM by Lee Mac »

#### ElpanovEvgeniy

• Water Moccasin
• Posts: 1569
• Moscow (Russia)
##### Re: nxn matrices - challenge
« Reply #5 on: November 13, 2013, 02:26:24 AM »
my new version

Code - Auto/Visual Lisp: [Select]
1. (defun detm (m / d)
2.   ;; Matrix Determinant  -  ElpanovEvgeniy
3.   ;; Last edit 2013.11.13
4.   ;; Args: m - nxn matrix
5.   ;; (detm '((0 1) (1 0)))
6.   ;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1)))
7.   (cond ((null m) 1)
8.         ((and (zerop (caar m))
9.               (setq d (car (vl-member-if-not (function (lambda (a) (zerop (car a)))) (cdr m))))
10.          )
11.          (detm (cons (mapcar (function +) (car m) d) (cdr m)))
12.         )
13.         ((zerop (caar m)) 0)
14.         ((* (caar m)
15.             (detm (mapcar (function (lambda (a / d)
16.                                       (setq d (/ (car a) (float (caar m))))
17.                                       (mapcar (function (lambda (b c) (- b (* c d)))) (cdr a) (cdar m))
18.                                     )
19.                           )
20.                           (cdr m)
21.                   )
22.             )
23.          )
24.         )
25.   )
26. )

#### Lee Mac

• Seagull
• Posts: 12943
• London, England
##### Re: nxn matrices - challenge
« Reply #6 on: November 13, 2013, 04:57:29 PM »
Bravo Evgeniy  :kewl:

Your code using LU decomposition is far more efficient than my implementation of Laplace's formula

#### ymg

• Guest
##### Re: nxn matrices - challenge
« Reply #7 on: November 14, 2013, 01:32:01 AM »
Great!

When you got a need for speed you can always rely on Evgeniy

ymg

#### ElpanovEvgeniy

• Water Moccasin
• Posts: 1569
• Moscow (Russia)
##### Re: nxn matrices - challenge
« Reply #8 on: November 14, 2013, 02:46:40 AM »
Bravo Evgeniy  :kewl:

Your code using LU decomposition is far more efficient than my implementation of Laplace's formula

Great!

When you got a need for speed you can always rely on Evgeniy

ymg

Yes, I'm doing upper triangular matrix and multiplies the diagonal.

Thanks!

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #9 on: May 25, 2014, 05:03:18 AM »
Here is my version, also uses Laplace's method... Don't know if it's usable, but it works... Efficiency was not my issue for this one...

Code - Auto/Visual Lisp: [Select]
1. ;;;***********************************************************************************;;;
2. ;;; (detm m) function calculates determinant of square martix                         ;;;
3. ;;; Marko Ribar, d.i.a.                                                               ;;;
4. ;;; Args: m - nxn matrix                                                              ;;;
5. ;;; (detm '((0 1) (1 0)))                                                             ;;;
6. ;;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
7. ;;;***********************************************************************************;;;
8. (defun detm ( m / d i j r )
9.
10.   (defun d ( k n / z )
11.     (setq k (cdr k))
12.     (setq k (apply 'mapcar (cons 'list k)))
13.     (setq z -1)
14.     (while (<= (setq z (1+ z)) (length k))
15.       (if (eq z n)
16.         (setq k (cdr k))
17.         (setq k (reverse (cons (car k) (reverse (cdr k)))))
18.       )
19.     )
20.     (setq k (apply 'mapcar (cons 'list k)))
21.     (if (= (length k) 1) (caar k) k)
22.   )
23.
24.   (if (not (eq (length m) 1))
25.       (setq i -1)
26.       (setq j -1)
27.       (setq r 0)
28.       (foreach e (car m)
29.         (setq i (1+ i))
30.         (setq j (* j (- 1)))
31.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
32.       )
33.       r
34.     )
35.     (caar m)
36.   )
37. )
38.
« Last Edit: June 13, 2015, 11:52:02 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### chlh_jd

• Guest
##### Re: nxn matrices - challenge
« Reply #10 on: May 25, 2014, 07:09:06 AM »
Great!

When you got a need for speed you can always rely on Evgeniy

ymg
1+

Hi, Ribarm,  why don't you use this method to do "m/m" ----> A / B = A* [inverse B] ,
if the Det of Matrix B is zero , it has no inverse matrix , but has  a generalized inverse matrix or Moore-Penrose inverse matrix .
« Last Edit: May 25, 2014, 07:13:25 AM by chlh_jd »

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #11 on: June 13, 2015, 12:14:09 PM »
Hi, Ribarm,  why don't you use this method to do "m/m" ----> A / B = A* [inverse B] ,
if the Det of Matrix B is zero , it has no inverse matrix , but has  a generalized inverse matrix or Moore-Penrose inverse matrix .

Code - Auto/Visual Lisp: [Select]
1. ;;;***********************************************************************************;;;
2. ;;; (detm m) function calculates determinant of square martix                         ;;;
3. ;;; Marko Ribar, d.i.a.                                                               ;;;
4. ;;; Args: m - nxn matrix                                                              ;;;
5. ;;; (detm '((0 1) (1 0)))                                                             ;;;
6. ;;; (detm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
7. ;;;***********************************************************************************;;;
8. (defun detm ( m / d i j r )
9.
10.   (defun d ( k n / z )
11.     (setq k (cdr k))
12.     (setq k (apply 'mapcar (cons 'list k)))
13.     (setq z -1)
14.     (while (<= (setq z (1+ z)) (length k))
15.       (if (eq z n)
16.         (setq k (cdr k))
17.         (setq k (reverse (cons (car k) (reverse (cdr k)))))
18.       )
19.     )
20.     (setq k (apply 'mapcar (cons 'list k)))
21.     (if (= (length k) 1) (caar k) k)
22.   )
23.
24.   (if (not (eq (length m) 1))
25.       (setq i -1)
26.       (setq j -1)
27.       (setq r 0)
28.       (foreach e (car m)
29.         (setq i (1+ i))
30.         (setq j (* j (- 1)))
31.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
32.       )
33.       r
34.     )
35.     (caar m)
36.   )
37. )
38.
39. ;;;***********************************************************************************;;;
40. ;;; (mmin m) function calculates matrix of minors of square martix                    ;;;
41. ;;; Marko Ribar, d.i.a.                                                               ;;;
42. ;;; Args: m - nxn matrix                                                              ;;;
43. ;;; (mmin '((0 1) (1 0)))                                                             ;;;
44. ;;; (mmin '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
45. ;;;***********************************************************************************;;;
46. (defun mmin ( m / i j r rr )
47.
48.   (defun dd ( r c m )
49.     (setq m (vl-remove (nth r m) m))
50.     (setq m (apply 'mapcar (cons 'list m)))
51.     (setq m (vl-remove (nth c m) m))
52.     (setq m (apply 'mapcar (cons 'list m)))
53.     (detm m)
54.   )
55.
56.   (setq i -1)
57.   (mapcar '(lambda ( x )
58.     (setq j -1)
59.     (mapcar '(lambda ( y )
60.       (setq r (cons (dd (1+ i) (setq j (1+ j)) m) r))) x
61.     )
62.     (setq i (1+ i))
63.     (setq r (reverse r))
64.     (setq rr (cons r rr))
65.     (setq r nil)
66.     ) m
67.   )
68.   (reverse rr)
69. )
70.
71. ;;;***********************************************************************************;;;
72. ;;; (cofm m) function calculates cofactor matrix of square martix                     ;;;
73. ;;; Marko Ribar, d.i.a.                                                               ;;;
74. ;;; Args: m - nxn matrix                                                              ;;;
75. ;;; (cofm '((0 1) (1 0)))                                                             ;;;
76. ;;; (cofm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
77. ;;;***********************************************************************************;;;
78. (defun cofm ( m / i j r rr )
79.
80.   (setq i -1)
81.   (mapcar '(lambda ( x )
82.     (setq j -1)
83.     (mapcar '(lambda ( y )
84.       (setq r (cons (if (equal (rem (float (+ (1+ i) (setq j (1+ j)))) 2.0) 1.0) (- y) y) r))) x
85.     )
86.     (setq i (1+ i))
87.     (setq r (reverse r))
88.     (setq rr (cons r rr))
89.     (setq r nil)
90.     ) m
91.   )
92.   (reverse rr)
93. )
94.
95. ;;;***********************************************************************************;;;
96. ;;; (adjm m) function calculates adjugate matrix of square martix                     ;;;
97. ;;; Marko Ribar, d.i.a.                                                               ;;;
98. ;;; Args: m - nxn matrix                                                              ;;;
99. ;;; (adjm '((0 1) (1 0)))                                                             ;;;
100. ;;; (adjm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
101. ;;;***********************************************************************************;;;
102. (defun adjm ( m )
103.   (apply 'mapcar (cons 'list m))
104. )
105.
106. ;;;***********************************************************************************;;;
107. ;;; (invm m) function calculates inverse matrix of square martix                      ;;;
108. ;;; or returns nil if matrix is singular                                              ;;;
109. ;;; Marko Ribar, d.i.a.                                                               ;;;
110. ;;; Args: m - nxn matrix                                                              ;;;
111. ;;; (invm '((0 1) (1 0)))                                                             ;;;
112. ;;; (invm '((1.4 2.1 5.4 6.5) (4.1 9.3 4.5 8.5) (1.2 4.1 6.2 7.5) (4.7 8.5 9.3 0.1))) ;;;
113. ;;;***********************************************************************************;;;
114. (defun invm ( m / k i j r rr )
115.
116.   (if (and (listp m) (vl-every '(lambda ( x ) (eq (length x) (length m))) m) (/= (detm m) 0.0))
117.       (setq k (/ 1.0 (detm m)))
118.       (setq i -1)
119.       (mapcar '(lambda ( x )
120.         (setq j -1)
121.         (mapcar '(lambda ( y )
122.           (setq r (cons (* k y) r))) x
123.         )
124.         (setq i (1+ i))
125.         (setq r (reverse r))
126.         (setq rr (cons r rr))
127.         (setq r nil)
128.         ) (adjm (cofm (mmin m)))
129.       )
130.       (reverse rr)
131.     )
132.     (if (not (listp m))
133.       (prompt "\nSupplied argument isn't matrix list")
134.       (if (not (vl-every '(lambda ( x ) (eq (length x) (length m))) m))
135.         (prompt "\nSupplied argument list isn't square matrix")
136.         nil
137.       )
138.     )
139.   )
140. )
141.

What should I do?
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #12 on: December 18, 2019, 06:28:30 PM »
I've just updated my version to be applicable and for complex numbers...

Code - Auto/Visual Lisp: [Select]
1. ;;;***********************************************************************************;;;
2. ;;; (detm m) function calculates determinant of square martix                         ;;;
3. ;;; this version includes complex numbers                                             ;;;
4. ;;; Marko Ribar, d.i.a.                                                               ;;;
5. ;;; Args: m - nxn matrix of complex numbers                                           ;;;
6. ;;; (detm '(((0 0) (1 0)) ((1 0) (0 0))))                                             ;;;
7. ;;; (detm '(((1.4 0) (2.1 0) (5.4 0) (6.5 0)) ((4.1 0) (9.3 0) (4.5 0) (8.5 0)) ((1.2 0) (4.1 0) (6.2 0) (7.5 0)) ((4.7 0) (8.5 0) (9.3 0) (0.1 0))))                                                                                 ;;;
8. ;;;***********************************************************************************;;;
9.
10. ;;; Command: (detm '(((1.2 1.0) (2.4 1.3) (0.5 0.6)) ((1.3 1.25) (1.5 2.0) (0.8 -1.4)) ((-2.3 -1.4) (0.6 -0.6) (-0.3 -0.3))))
11. ;;; (-15.3785 7.4325)
12.
13. ;;; det = (1.2 + 1.0i)(1.5 + 2.0i)(-0.3 - 0.3i)+(2.4 + 1.3i)(0.8 - 1.4i)(-2.3 - 1.4i)+(0.5 + 0.6i)(1.3 + 1.25i)(0.6 - 0.6i)-(-2.3 - 1.4i)(1.5 + 2.0i)(0.5 + 0.6i)-(0.6 - 0.6i)(0.8 - 1.4i)(1.2 + 1.0i)-(-0.3 - 0.3i)(1.3 + 1.25i)(2.4 + 1.3i)
14. ;;; det = (1.8 + 2.4i + 1.5i - 2)(-0.3 - 0.3i)+(1.92 - 3.36i + 1.04i + 1.82)(-2.3 - 1.4i)+(0.65 + 0.625i + 0.78i - 0.75)(0.6 - 0.6i)-(-3.45 - 4.6i - 2.1i + 2.8)(0.5 + 0.6i)-(0.48 - 0.84i - 0.48i - 0.84)(1.2 + 1.0i)-(-0.39 - 0.375i - 0.39i + 0.375)(2.4 + 1.3i)
15. ;;; det = (-0.2 + 3.9i)(-0.3 - 0.3i)+(3.74 - 2.32i)(-2.3 - 1.4i)+(-0.1 + 1.405i)(0.6 - 0.6i)-(-0.65 - 6.7i)(0.5 + 0.6i)-(-0.36 - 1.32i)(1.2 + 1.0i)-(-0.015 - 0.765i)(2.4 + 1.3i)
16. ;;; det = 0.06 + 0.06i - 1.17i + 1.17 - 8.602 - 5.236i + 5.336i - 3.248 - 0.06 + 0.06i + 0.843i + 0.843 + 0.325 + 0.39i + 3.35i - 4.02 + 0.432 + 0.36i + 1.584i - 1.32 + 0.036 + 0.0195i + 1.836i - 0.9945
17. ;;; det = -15.3785 + 7.4325i
18.
19. (defun detm ( m / d cxc det )
20.
21.   (defun d ( k n / z )
22.     (setq k (cdr k))
23.     (setq k (apply 'mapcar (cons 'list k)))
24.     (setq z -1)
25.     (while (<= (setq z (1+ z)) (length k))
26.       (if (= z n)
27.         (setq k (cdr k))
28.         (setq k (reverse (cons (car k) (reverse (cdr k)))))
29.       )
30.     )
31.     (setq k (apply 'mapcar (cons 'list k)))
32.     (if (= (length k) 1) (caar k) k)
33.   )
34.
35.   (defun cxc ( c1 c2 / a1 a2 b1 b2 r i )
36.     (setq a1 (car c1) b1 (cadr c1))
37.     (setq a2 (car c2) b2 (cadr c2))
38.     (setq r (- (* a1 a2) (* b1 b2)))
39.     (setq i (+ (* a1 b2) (* a2 b1)))
40.     (list r i)
41.   )
42.
43.   (defun det ( q / i j r )
44.     (if (not (vl-every 'numberp q))
45.         (setq i -1)
46.         (setq j -1)
47.         (setq r (list 0 0))
48.         (foreach e (car q)
49.           (setq i (1+ i))
50.           (setq j (* j (- 1)))
51.           (setq r (mapcar '+ r (cxc (mapcar '* (list j j) e) (det (d q i)))))
52.         )
53.         r
54.       )
55.       q
56.     )
57.   )
58.
59.   (det m)
60. )
61.

Maybe now there will be more deeper attempt to final solution of eigenvalues and eigenvectors problem, as eigenvalues can be also real and also complex numbers...
« Last Edit: December 19, 2019, 12:33:13 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### dgpuertas

• Newt
• Posts: 87
##### Re: nxn matrices - challenge
« Reply #13 on: December 23, 2019, 07:43:40 AM »
Following the reasoning of ribarm, and with this post of Matlab I have managed to reverse a matrix of complex numbers
I hope it is useful
https://es.mathworks.com/matlabcentral/fileexchange/49373-complex-matrix-inversion-by-real-matrix-inversion

Code: [Select]
`(defun invmcomplex (mat / a b r i)  (setq a (mapcar (function (lambda (v) (mapcar (function car) v))) mat) b (mapcar (function (lambda (v) (mapcar (function cadr) v))) mat) r (invm (m+m a (mxm (mxm b (invm a)) b))) i (invm (m+m b (mxm (mxm a (invm b)) a))) )    (mapcar (function (lambda (a b) (mapcar (function (lambda (c d) (list c (- d)))) a b))) r i))`
With

Code: [Select]
`;; 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 (function (lambda ( x ) (mapcar (function (lambda ( a b ) (- a (* (car x) b)))) (cdr x) p))) m)    )    (setq  m (mapcar (function append) m (imat (length m))))    (while m        (setq c (mapcar (function (lambda (x) (abs (car x)))) m))        (repeat (vl-position (apply (function 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 (function (lambda (x) (/ (float x) (caar m)))) (cdar m))                  m (f p (cdr m))                  r (cons p (f p r))            )        )    )    (reverse r)) (defun mxm ( m n )    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (transpose n)));; Matrix + Matrix - Lee Mac;; Args: m,n - nxn matrices(defun m+m (m n)  (mapcar (function (lambda ( r s ) (mapcar (function +) r s))) m n))`

#### mailmaverick

• Bull Frog
• Posts: 495
##### Re: nxn matrices - challenge
« Reply #14 on: February 19, 2020, 11:59:33 PM »
Another easy way is to open a new excel workbook through AutoLISP, write your matrix in Excel, Use Inbuilt Matrix functions of Excel, get the result, Close the Excel workbook and switch back to your LISP with the result in your hand.
Note : Excel matrix functions would be much faster for big matrices.

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #15 on: July 11, 2024, 05:04:07 PM »
Maybe I am wrong, but that with Matlab is IMHO pretty bad...
@dgpuertas, I think that inverse of complex matrix you proposed is somewhat wrong...
Here is my example for which I think is correct...

Code - Auto/Visual Lisp: [Select]
1. ;; Matrix Inverse Complex  -  gile & Lee Mac
2. ;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn complex matrix.
3. ;; Args: m - nxn complex matrix
4.
5. (defun invmcomplex ( m / car-_vl-sort-i f c p r )
6.
7.   (defun car-_vl-sort-i ( lst fun )
8.     (car (mapcar (function (lambda ( x ) (nth x lst))) (vl-sort-i lst fun)))
9.   )
10.
11.   (defun f ( p m )
12.     (mapcar (function (lambda ( x ) (mapcar (function (lambda ( a b ) (c-c a (cxc (car x) b)))) (cdr x) p))) m)
13.   )
14.
15.   (setq  m (mapcar (function append) m (imatcomplex (length m))))
16.   (while m
17.     (setq c (mapcar (function (lambda ( x ) (list (abs (caar x)) (abs (cadar x))))) m))
18.     (repeat (vl-position (car-_vl-sort-i c (function (lambda ( a b ) (if (equal (car a) (car b) 1e-6) (> (cadr a) (cadr b)) (> (car a) (car b)))))) c)
19.       (setq m (append (cdr m) (list (car m))))
20.     )
21.     (if (equal (list 0.0 0.0) (caar m) 1e-14)
22.       (setq m nil
23.             r nil
24.       )
25.       (setq p (mapcar (function (lambda ( x ) (c/c (mapcar 'float x) (caar m)))) (cdar m))
26.             m (f p (cdr m))
27.             r (cons p (f p r))
28.       )
29.     )
30.   )
31.   (reverse r)
32. )
33.
34. ;; Identity Matrix Complex  -  Lee Mac
35. ;; Args: n - complex matrix dimension
36.
37. (defun imatcomplex ( n / i j l m )
38.   (repeat (setq i n)
39.     (repeat (setq j n)
40.       (setq l (cons (if (= i j) (list 1.0 0.0) (list 0.0 0.0)) l)
41.             j (1- j)
42.       )
43.     )
44.     (setq m (cons l m)
45.           l nil
46.           i (1- i)
47.     )
48.   )
49.   m
50. )
51.
52. (defun cxc ( c1 c2 / a1 a2 b1 b2 r i )
53.   (setq a1 (car c1) b1 (cadr c1))
54.   (setq a2 (car c2) b2 (cadr c2))
55.   (setq r (- (* a1 a2) (* b1 b2)))
56.   (setq i (+ (* a1 b2) (* a2 b1)))
57.   (list r i)
58. )
59.
60. (defun c-c ( c1 c2 )
61.   (mapcar (function -) c1 c2)
62. )
63.
64. (defun c+cm ( clst )
65.   (list (apply (function +) (mapcar (function car) clst)) (apply (function +) (mapcar (function cadr) clst)))
66. )
67.
68. (defun c_ ( c1 )
69.   (list (car c1) (- (cadr c1)))
70. )
71.
72. (defun c/c ( c1 c2 / d )
73.   ( (lambda ( d ) (mapcar (function (lambda ( x ) (/ x d))) (cxc c1 (c_ c2))))
74.     (car (cxc c2 (c_ c2)))
75.   )
76. )
77.
78. (invmcomplex (list (list '(2 5) '(3 6) '(7 2) '(4 2)) (list '(1 8) '(2 6) '(3 2) '(6 5)) (list '(9 2) '(3 4) '(4 3) '(2 5)) (list '(8 4) '(4 6) '(5 6) '(6 5))))
79. (((-0.0120802851247421 0.162220971675108) (0.0634402551116113 -0.166197711498781) (0.259463515287938 -0.01755768148565) (-0.24111798912024 -0.000225098480585259)) ((0.023597824048021 -0.554980303882949) (-0.315850684674545 0.317613956105796) (-0.553217032451698 0.00986681673232037) (0.714274995310448 0.170211967735884)) ((-0.0759332207840931 0.114912774338773) (0.141624460701557 0.107709622960045) (0.164246858000375 0.242018383042581) (-0.134646407803414 -0.382367285687488)) ((-0.100131307447008 0.201763271431251) (0.215906959294691 -0.127893453385856) (0.0897767773400863 -0.0436691052335397) (-0.156968673794785 -0.082611142374789)))
80.
81. (invmcomplex '(((-0.0120802851247421 0.162220971675108) (0.0634402551116113 -0.166197711498781) (0.259463515287938 -0.01755768148565) (-0.24111798912024 -0.000225098480585259)) ((0.023597824048021 -0.554980303882949) (-0.315850684674545 0.317613956105796) (-0.553217032451698 0.00986681673232037) (0.714274995310448 0.170211967735884)) ((-0.0759332207840931 0.114912774338773) (0.141624460701557 0.107709622960045) (0.164246858000375 0.242018383042581) (-0.134646407803414 -0.382367285687488)) ((-0.100131307447008 0.201763271431251) (0.215906959294691 -0.127893453385856) (0.0897767773400863 -0.0436691052335397) (-0.156968673794785 -0.082611142374789))))
82. (((1.99999999999997 5.00000000000003) (2.99999999999995 6.00000000000001) (6.99999999999996 2.00000000000003) (3.99999999999994 2.00000000000001)) ((0.999999999999948 8.00000000000004) (1.99999999999994 6.0) (2.99999999999995 2.00000000000002) (5.99999999999994 5.00000000000001)) ((8.99999999999999 2.00000000000003) (2.99999999999996 4.00000000000002) (3.99999999999998 3.00000000000004) (1.99999999999996 5.00000000000005)) ((7.99999999999998 4.00000000000006) (3.99999999999994 6.00000000000003) (4.99999999999996 6.00000000000005) (5.99999999999994 5.00000000000005)))
83.

Regards, M.R.
« Last Edit: July 12, 2024, 12:46:46 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3333
• Marko Ribar, architect
##### Re: nxn matrices - challenge
« Reply #16 on: July 12, 2024, 01:26:36 AM »
It seems that @dgpuertas version also works well... So I was wrong, but he omitted to provide all subs that goes with his version...

Code - Auto/Visual Lisp: [Select]
1. (defun invmcomplex ( mat / a b r i )
2.   (setq a (mapcar (function (lambda ( v ) (mapcar (function car) v))) mat)
3.         b (mapcar (function (lambda ( v ) (mapcar (function cadr) v))) mat)
4.         r (invm (m+m a (mxm (mxm b (invm a)) b)))
5.         i (invm (m+m b (mxm (mxm a (invm b)) a)))
6.   )
7.
8.   (mapcar (function (lambda ( a b ) (mapcar (function (lambda ( c d ) (list c (- d)))) a b))) r i)
9. )
10.
11. ;; Matrix Inverse  -  gile & Lee Mac
12. ;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn matrix.
13. ;; Args: m - nxn matrix
14.
15. (defun invm ( m / c f p r)
16.
17.   (defun f ( p m )
18.     (mapcar (function (lambda ( x ) (mapcar (function (lambda ( a b ) (- a (* (car x) b)))) (cdr x) p))) m)
19.   )
20.
21.   (setq  m (mapcar (function append) m (imat (length m))))
22.   (while m
23.     (setq c (mapcar (function (lambda ( x ) (abs (car x)))) m))
24.       (setq m (append (cdr m) (list (car m))))
25.     )
26.     (if (equal 0.0 (caar m) 1e-14)
27.       (setq m nil
28.             r nil
29.       )
30.       (setq p (mapcar (function (lambda ( x ) (/ (float x) (caar m)))) (cdar m))
31.             m (f p (cdr m))
32.             r (cons p (f p r))
33.       )
34.     )
35.   )
36.   (reverse r)
37. )
38.
39. ;; Identity Matrix  -  Lee Mac
40. ;; Args: n - matrix dimension
41.
42. (defun imat ( n / i j l m )
43.   (repeat (setq i n)
44.     (repeat (setq j n)
45.       (setq l (cons (if (= i j) 1.0 0.0) l)
46.             j (1- j)
47.       )
48.     )
49.     (setq m (cons l m)
50.           l nil
51.           i (1- i)
52.     )
53.   )
54.   m
55. )
56.
57. ;; Matrix Transpose  -  Doug Wilson
58. ;; Args: m - nxn matrix
59.
60. (defun trp ( m )
61. )
62.
63. ;; Matrix x Matrix - Lee Mac
64. ;; Args: m,n - nxn matrices
65.
66. (defun mxm ( m n )
67.   ((lambda ( a ) (mapcar (function (lambda ( r ) (mxv a r))) m)) (trp n))
68. )
69.
70. ;; Matrix + Matrix - Lee Mac
71. ;; Args: m,n - nxn matrices
72.
73. (defun m+m ( m n )
74.   (mapcar (function (lambda ( r s ) (mapcar (function +) r s))) m n)
75. )
76.
Marko Ribar, d.i.a. (graduated engineer of architecture)