MATRIX

[Bred]

Salut, et encore merci !!!!

J'avais bien compris le remplacement de l'axe par un autre, mais je me trouvais à un moment avec un problème se signe (+ ou -), et je ne sais plus pourquoi...

encore merci en tous cas !

 

PS : attention, dans ta correction tu fais une récupération du SCU (setq scu_init (vla-get-ActiveUCS AcDoc)) alors qu'il n'est pas forcément nommé, donc il y a une erreur.

.. mais je pense que c'est un oubli de ta part....

[(gile)]

Salut,

 

J'ai modifié la routine GaussJordan suie à la correction d'un bug rapporté par Tim Willey (TheSwamp).

[(gile)]

Salut,

 

Suite à la correction du bug dans la routine GaussJordan, j'ai cherché à optimiser celle-ci tant du point de vue de la précision du résultat (choix plus judicieux du "pivot") que de la rapidité d'exécution.

 

Étant donné qu'en DAO la principale utilité de cette méthode est le calcul des matrices de transformation inverse, j'en ai fait une routine spécifique.

 

;; INVERSEMATRIX
;; Inverse une matrice carrée (méthode Gauss-Jordan)
;;
;; Argument: la matrice
;; Retour : la matrice inverse ou nil (si non inversible)

(defun InverseMatrix (mat / col piv row res)
 (setq	mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat))))
 (while mat
   (setq col (mapcar '(lambda (x) (abs (car x))) mat))
   (repeat (vl-position (apply 'max col) col)
     (setq mat (append (cdr mat) (list (car mat))))
   )
   (if	(equal (setq piv (caar mat)) 0.0 1e-14)
     (setq mat	nil
    res	nil
     )
     (setq piv	(/ 1.0 piv)
    row	(mapcar '(lambda (x) (* x piv)) (car mat))
    mat	(mapcar
	  '(lambda (r / e)
	     (setq e (car r))
	     (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
	   )
	  (cdr mat)
	)
    res	(cons
	  (cdr row)
	  (mapcar
	    '(lambda (r / e)
	       (setq e (car r))
	       (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
	     )
	    res
	  )
	)
     )
   )
 )
 (reverse res)
)

;; IMAT
;; Crée une matrice d'identité de dimension n
;;
;; Argument
;; d : la dimension de la matrice

(defun Imat (d / i n r m)
 (setq i d)
 (while (    (setq n d r nil)
   (while (      (setq r (cons (if (= i n) 1.0 0.0) r))
   )
   (setq m (cons r m))
 )
)