Calcul de la matrice inverse (code qui marche ! ) :: par souhail & safae ::

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 823 fois - Téléchargée 36 fois

Contenu du snippet

ce code permet de retourner la matrice inverse d'une matrice donnée en paramètre en utilisant la méthode des déterminant.

Source / Exemple :


Public Sub Inverse(ma() As Double, mb() As Double, Erreur As Boolean)
Dim m1() As Double, m2() As Double, d As Double
ReDim m1(UBound(ma, 1), UBound(ma, 2))
ReDim m2(UBound(ma, 1), UBound(ma, 2))
If ((Not (UBound(ma, 1) = UBound(ma, 2))) Or (Determinant(ma, UBound(ma, 1)) = 0)) Then
                                Erreur = True
Else
    d = (1 / Determinant(ma, UBound(ma, 1)))
    Transpose ma, m2
    Coffacteur m2, m1
    ProduitScalaire d, m1, mb
    Erreur = False
End If
End Sub

Public Sub ProduitScalaire(a As Double, ma() As Double, mb() As Double)
Dim i As Integer, j As Integer
ReDim mb(UBound(ma, 1), UBound(ma, 2))
For i = 0 To (UBound(ma, 1) - 1)
  For j = 0 To (UBound(ma, 2) - 1)
    mb(i, j) = ma(i, j) * a
  Next
Next
End Sub

Public Sub Det_aux(ma() As Double, mb() As Double, l As Integer, c As Integer)
Dim i As Integer, j As Integer, d As Integer, E As Integer
  E = 0
  ReDim mb(UBound(ma, 1) - 1, UBound(ma, 2) - 1)
  For i = 0 To (UBound(ma, 1) - 1)
   d = 0
    If (i <> l) Then
                  For j = 0 To (UBound(ma, 2) - 1)
                    If (j <> c) Then
                                  mb(E, d) = ma(i, j)
                                  d = d + 1
                                End If
                  Next
                   E = E + 1
                End If
  Next
End Sub

Public Function Expo(n As Integer) As Double
   If ((n Mod 2) = 0) Then
                        Expo = 1
                      Else
                        Expo = -1
   End If
End Function

Public Function Determinant(m() As Double, l As Integer) As Double
Dim i As Integer, j As Integer, ii As Integer, jj As Integer
Dim m2() As Double, X As Double, Y As Double

X = 0
If (l = 2) Then
            Determinant = (m(0, 0) * m(1, 1)) - (m(0, 1) * m(1, 0))
          Else
            For i = 0 To (l - 1)
               Det_aux m, m2, 0, i
               Y = Determinant(m2, (l - 1))
               X = X + (Expo(i) * m(0, i) * Y)
            Next
            Determinant = X
End If
End Function

Public Sub Coffacteur(MatD() As Double, MatR() As Double)
Dim i As Integer, j As Integer, Temp() As Double, Det As Double
ReDim MatR(UBound(MatD, 1), UBound(MatD, 2))
If ((UBound(MatD, 1) = 2) And (UBound(MatD, 1) = 2)) Then
            MatR(0, 0) = Expo(0) * (MatD(1, 1))
            MatR(0, 1) = Expo(1) * (MatD(0, 1))
            MatR(1, 0) = Expo(1) * (MatD(1, 0))
            MatR(1, 1) = Expo(0) * (MatD(0, 0))
Else
     For i = 0 To (UBound(MatD, 1) - 1)
        For j = 0 To (UBound(MatD, 2) - 1)
            Det_aux MatD, Temp, i, j
            MatR(i, j) = Expo(i + j) * Determinant(Temp, UBound(Temp, 1))
        Next
    Next
End If
End Sub

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
mercredi 20 décembre 2006
Statut
Membre
Dernière intervention
20 décembre 2006

salut vous auriez une version compilée qui marche ?
merci d'avence
Messages postés
345
Date d'inscription
mardi 3 juin 2003
Statut
Membre
Dernière intervention
21 mars 2008
1
Sauf erreur de ma part ....

Code qui marche PAS car manque subroutine transpose ??
Messages postés
5
Date d'inscription
jeudi 21 juillet 2005
Statut
Membre
Dernière intervention
26 juillet 2005

Merci pour ton code, hélas, celui ci est beaucoup trop couteux en temps de calcul. Il convient pour les matrices de petites tailles. J'ai essayé avec une matrice 60x60, et j'ai coupé le calcul apres quelques minutes.
Si tu connais une source qui fait les memes opérations en un temps de calcul correct, je suis preneur
@+
Messages postés
9
Date d'inscription
samedi 19 juin 2004
Statut
Membre
Dernière intervention
9 mai 2005

Je pense que vous devez vérifier les résultats, avant l'utilisation d'eux...
N'importe quel la méthode vous utilise...
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
"... en plus la méthode de Gauss-Jordan ne donne pas toujours le bon résultat, et ce, sur papier !... "

Hum...hum....hum..... Y'a des mathématiciens qui doivent se retourner dans leur tombe...



Us.
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.