Author Topic: nxn matrices - challenge  (Read 4072 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2335
  • 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.     (progn
  26.       (setq i -1)
  27.       (setq j -1)
  28.       (setq r 0)
  29.       (foreach e (car m)
  30.         (setq i (1+ i))
  31.         (setq j (* j (- 1)))
  32.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
  33.       )
  34.       r
  35.     )
  36.     (caar m)
  37.   )
  38. )
  39.  
  40. ;; TRP
  41. ;; Transposes a matrix -Doug Wilson-
  42. ;;
  43. ;; Argument : a matrix
  44.  
  45. (defun trp (m) (apply 'mapcar (cons 'list m)))
  46.  
  47. ;; MXV
  48. ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
  49. ;;
  50. ;; Arguments : a matrix and a vector
  51.  
  52. (defun mxv (m v)
  53.   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  54.           m
  55.   )
  56. )
  57.  
  58. ;; MXM
  59. ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
  60. ;;
  61. ;; Arguments : two matrices
  62.  
  63. (defun mxm (m q)
  64.   (mapcar (function (lambda (r) (mxv (trp q) r))) m)
  65. )
  66.  
  67. ;; M/V
  68. ;; Applies a transformation matrix to a vector -Marko Ribar-
  69. ;;
  70. ;; Arguments : a matrix and a vector
  71.  
  72. (defun m/v (m v)
  73.   (mapcar
  74.     (function
  75.       (lambda (r)
  76.         (apply '+
  77.                (mapcar '/ r (mapcar (function (lambda (r) (* -1 r))) v))
  78.         )
  79.       )
  80.     )
  81.     m
  82.   )
  83. )
  84.  
  85. ;; M/M
  86. ;; Divides two matrices -Marko Ribar-
  87. ;;
  88. ;; Arguments : two matrices
  89.  
  90. (defun m/m (m q / Dq k j D mj mk)
  91.   (setq Dq (detm (trp q)))
  92.   (setq k -1)
  93.   (repeat (length m)
  94.     (setq k (1+ k))
  95.     (setq j -1)
  96.     (repeat (length (car (trp q)))
  97.       (setq j (1+ j))
  98.       (setq D
  99.              (detm
  100.                (mapcar
  101.                  (function
  102.                    (lambda (x y)
  103.                      (subst x (nth j y) y)
  104.                    )
  105.                  )
  106.                  (nth k m)
  107.                  (trp q)
  108.                )
  109.              )
  110.       )
  111.       (setq mj (cons (/ D Dq) mj))
  112.     )
  113.     (setq mj (reverse mj))
  114.     (setq mk (cons mj mk))
  115.     (setq mj nil)
  116.   )
  117.   (reverse mk)
  118. )
  119.  
  120. (defun c:m1xm2 ()
  121.   (setq mat1 '(
  122.                (10. 20. 30.)
  123.                (40. 50. 60.)
  124.                (70. 80. 90.)
  125.               )
  126.   )
  127.   (setq mat2 '(
  128.                (90. 80. 70.)
  129.                (60. 50. 40.)
  130.                (30. 20. 10.)
  131.               )
  132.   )
  133.   (princ (setq mm (mxm mat1 mat2)))
  134.   (prin1)
  135. )
  136.  
  137. (defun c:mm/m2 ()
  138.   (princ (m/m mm mat2))
  139.   (prin1)
  140. )
  141.  
  142. (defun c:mm/m1 ()
  143.   (princ (m/m mm mat1))
  144.   (prin1)
  145. )
  146.  

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

:)

M.R. on Youtube

ribarm

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

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

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2335
  • Marko Ribar, architect
Re: nxn matrices - challenge
« Reply #2 on: November 12, 2013, 09:07:41 AM »
I've added function :

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)

:)

M.R. on Youtube

Stefan

  • Bull Frog
  • Posts: 229
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: 12373
  • 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))
  8.         (   (null (cddr m)) (- (* (caar m) (cadadr m)) (* (cadar m) (caadr m))))
  9.         (   (apply '+
  10.                 (mapcar
  11.                    '(lambda ( c ) (setq j (1+ j))
  12.                         (* c (setq i (- i))
  13.                             (detm
  14.                                 (mapcar
  15.                                    '(lambda ( x / k )
  16.                                         (setq k 0)
  17.                                         (vl-remove-if '(lambda ( y ) (= j (setq k (1+ k)))) x)
  18.                                     )
  19.                                     (cdr m)
  20.                                 )
  21.                             )
  22.                         )
  23.                     )
  24.                     (car m)
  25.                 )
  26.             )
  27.         )
  28.     )
  29. )
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: 1542
  • 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. )
Stay home. Stay safe. Save lives.

Lee Mac

  • Seagull
  • Posts: 12373
  • 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

  • Swamp Rat
  • Posts: 725
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: 1542
  • 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!  :-)
Stay home. Stay safe. Save lives.

ribarm

  • Water Moccasin
  • Posts: 2335
  • 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.     (progn
  26.       (setq i -1)
  27.       (setq j -1)
  28.       (setq r 0)
  29.       (foreach e (car m)
  30.         (setq i (1+ i))
  31.         (setq j (* j (- 1)))
  32.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
  33.       )
  34.       r
  35.     )
  36.     (caar m)
  37.   )
  38. )
  39.  
« Last Edit: June 13, 2015, 11:52:02 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

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

  • Water Moccasin
  • Posts: 2335
  • 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.     (progn
  26.       (setq i -1)
  27.       (setq j -1)
  28.       (setq r 0)
  29.       (foreach e (car m)
  30.         (setq i (1+ i))
  31.         (setq j (* j (- 1)))
  32.         (setq r (+ r (* j e (if (listp (d m i)) (detm (d m i)) (d m i)))))
  33.       )
  34.       r
  35.     )
  36.     (caar m)
  37.   )
  38. )
  39.  
  40. ;;;***********************************************************************************;;;
  41. ;;; (mmin m) function calculates matrix of minors of square martix                    ;;;
  42. ;;; Marko Ribar, d.i.a.                                                               ;;;
  43. ;;; Args: m - nxn matrix                                                              ;;;
  44. ;;; (mmin '((0 1) (1 0)))                                                             ;;;
  45. ;;; (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))) ;;;
  46. ;;;***********************************************************************************;;;
  47. (defun mmin ( m / i j r rr )
  48.  
  49.   (defun dd ( r c m )
  50.     (setq m (vl-remove (nth r m) m))
  51.     (setq m (apply 'mapcar (cons 'list m)))
  52.     (setq m (vl-remove (nth c m) m))
  53.     (setq m (apply 'mapcar (cons 'list m)))
  54.     (detm m)
  55.   )
  56.  
  57.   (setq i -1)
  58.   (mapcar '(lambda ( x )
  59.     (setq j -1)
  60.     (mapcar '(lambda ( y )
  61.       (setq r (cons (dd (1+ i) (setq j (1+ j)) m) r))) x
  62.     )
  63.     (setq i (1+ i))
  64.     (setq r (reverse r))
  65.     (setq rr (cons r rr))
  66.     (setq r nil)
  67.     ) m
  68.   )
  69.   (reverse rr)
  70. )
  71.  
  72. ;;;***********************************************************************************;;;
  73. ;;; (cofm m) function calculates cofactor matrix of square martix                     ;;;
  74. ;;; Marko Ribar, d.i.a.                                                               ;;;
  75. ;;; Args: m - nxn matrix                                                              ;;;
  76. ;;; (cofm '((0 1) (1 0)))                                                             ;;;
  77. ;;; (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))) ;;;
  78. ;;;***********************************************************************************;;;
  79. (defun cofm ( m / i j r rr )
  80.  
  81.   (setq i -1)
  82.   (mapcar '(lambda ( x )
  83.     (setq j -1)
  84.     (mapcar '(lambda ( y )
  85.       (setq r (cons (if (equal (rem (float (+ (1+ i) (setq j (1+ j)))) 2.0) 1.0) (- y) y) r))) x
  86.     )
  87.     (setq i (1+ i))
  88.     (setq r (reverse r))
  89.     (setq rr (cons r rr))
  90.     (setq r nil)
  91.     ) m
  92.   )
  93.   (reverse rr)
  94. )
  95.  
  96. ;;;***********************************************************************************;;;
  97. ;;; (adjm m) function calculates adjugate matrix of square martix                     ;;;
  98. ;;; Marko Ribar, d.i.a.                                                               ;;;
  99. ;;; Args: m - nxn matrix                                                              ;;;
  100. ;;; (adjm '((0 1) (1 0)))                                                             ;;;
  101. ;;; (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))) ;;;
  102. ;;;***********************************************************************************;;;
  103. (defun adjm ( m )
  104.   (apply 'mapcar (cons 'list m))
  105. )
  106.  
  107. ;;;***********************************************************************************;;;
  108. ;;; (invm m) function calculates inverse matrix of square martix                      ;;;
  109. ;;; or returns nil if matrix is singular                                              ;;;
  110. ;;; Marko Ribar, d.i.a.                                                               ;;;
  111. ;;; Args: m - nxn matrix                                                              ;;;
  112. ;;; (invm '((0 1) (1 0)))                                                             ;;;
  113. ;;; (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))) ;;;
  114. ;;;***********************************************************************************;;;
  115. (defun invm ( m / k i j r rr )
  116.  
  117.   (if (and (listp m) (vl-every '(lambda ( x ) (eq (length x) (length m))) m) (/= (detm m) 0.0))
  118.     (progn
  119.       (setq k (/ 1.0 (detm m)))
  120.       (setq i -1)
  121.       (mapcar '(lambda ( x )
  122.         (setq j -1)
  123.         (mapcar '(lambda ( y )
  124.           (setq r (cons (* k y) r))) x
  125.         )
  126.         (setq i (1+ i))
  127.         (setq r (reverse r))
  128.         (setq rr (cons r rr))
  129.         (setq r nil)
  130.         ) (adjm (cofm (mmin m)))
  131.       )
  132.       (reverse rr)
  133.     )
  134.     (if (not (listp m))
  135.       (prompt "\nSupplied argument isn't matrix list")
  136.       (if (not (vl-every '(lambda ( x ) (eq (length x) (length m))) m))
  137.         (prompt "\nSupplied argument list isn't square matrix")
  138.         nil
  139.       )
  140.     )
  141.   )
  142. )
  143.  

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

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2335
  • 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.       (progn
  46.         (setq i -1)
  47.         (setq j -1)
  48.         (setq r (list 0 0))
  49.         (foreach e (car q)
  50.           (setq i (1+ i))
  51.           (setq j (* j (- 1)))
  52.           (setq r (mapcar '+ r (cxc (mapcar '* (list j j) e) (det (d q i)))))
  53.         )
  54.         r
  55.       )
  56.       q
  57.     )
  58.   )
  59.  
  60.   (det m)
  61. )
  62.  

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)

:)

M.R. on Youtube

dgpuertas

  • Newt
  • Posts: 52
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: 448
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.