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

0 Members and 1 Guest are viewing this topic.

#### ribarm

• Gator
• Posts: 3334
• 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: 3334
• 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)