Programme de résolution de n équations à n inconnues

Soyez le premier à donner votre avis sur cette source.

Vue 5 048 fois - Téléchargée 625 fois

Description

il sagit de transformer son système d'équations en matrices, que le programme transforme en matrice diagonale supérieure (donc résolvable) en gardant le pivot le plus grand (élimine les erreurs d'arrondi) on obtient alors le résultat par un dernier calcul rapide. Pour l'instant, toutes les opérations sont visualisables, ce qui ralenti le calcul... je vais changer ça et bientôt optimiser le code pour la rapidité ...

Source / Exemple :


Dim dec As Integer
Dim tabmat() As Double
Dim m As Integer
Dim var(), y(), temp(), ytemp() As Variant

Private Sub cmdgauss_Click()

m = Flexmat.Cols
ProgressBar1.Min = 0
ProgressBar1.Max = 100

If txtdec = "" Then dec = 20 Else dec = txtdec.Text

ReDim var(m), y(m), temp(m, m), ytemp(m)
Dim pgb As Double
ReDim tabmat(m, m) As Double
Dim a, maxp, maxs As Double

'a est le coeff de l'algorithme'
a = 1
colmax = 0
rowmax = 0
maxs = 0
maxp = 0
pgb = 99 / (7 * m - 5)

'remplissage du tableau'
For i = 0 To m - 1
flexvar.Row = i
Flexvarini.Row = i
flexvar.Text = Flexvarini.Text
    For j = 0 To m - 1
    Flexmat.Row = i
    Flexmat.Col = j
    tabmat(i, j) = Flexmat.Text
    Next j
Next i
ProgressBar1.Value = pgb

'''''''''''''''début de l'algorithme''''''''''''''''

'écriture dans flexresult'
For i = k To m - 1
    For j = k To m - 1
    temp(i, j) = tabmat(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'écriture dans var()'
For i = 0 To m - 1
Flexvarini.Row = i
var(i) = Flexvarini.Text
Next i

'écriture dans y()'
For i = 0 To m - 1
flex_yini.Row = i
y(i) = flex_yini.Text
Next i

For k = 0 To m - 2

'recherche du maximum'
maxp = 0
For i = k To m - 1
    For j = k To m - 2
    maxs = Max(tabmat(i, j), tabmat(i, j + 1))
    If maxs > maxp Then maxp = maxs
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'recherche de l'emplacement du maximum'
For i = k To m - 1
    For j = k To m - 1
        If temp(i, j) = maxp Then
        colmax = j
        rowmax = i
        End If
    Next j
Next i

suite:
ProgressBar1.Value = ProgressBar1.Value + pgb

'réécriture dans flexresult pour obtenir le pivot le plus grand'

'changement de la ligne'
For j = k To m - 1
    temp(k, j) = Round(tabmat(rowmax, j), dec)
    temp(rowmax, j) = Round(tabmat(k, j), dec)
Next j
ytemp(rowmax) = Round(y(k), dec)
ytemp(k) = Round(y(rowmax), dec)

ProgressBar1.Value = ProgressBar1.Value + pgb

'réécriture du tableau'
For i = k To m - 1
y(i) = ytemp(i)
    For j = k To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

'changement de colonne'
For i = k To m - 1
    temp(k, i) = Round(tabmat(i, colmax), dec)
    temp(colmax, i) = Round(tabmat(i, k), dec)
Next i
flexvar.Row = k
flexvar.Text = var(colmax)
flexvar.Row = colmax
flexvar.Text = var(k)
ProgressBar1.Value = ProgressBar1.Value + pgb

'réécriture du tableau'
For i = k To m - 1
flexvar.Row = i
var(i) = flexvar.Text
flex_y.Row = i
flex_y.Text = ytemp(i)
    For j = k To m - 1
    Flexresult.Row = i
    Flexresult.Col = j
    Flexresult.Text = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb

For i = k + 1 To m - 1
    If tabmat(k, k) <> 0 Then
    a = tabmat(i, k) / tabmat(k, k) 'calcul de a'
    Else
    MsgBox "les équations ne sont pas indépendantes !", vbOKOnly, "erreur"
    Cmdresult.Enabled = False
    GoTo break
    End If
    y(i) = y(i) - (y(k) * a)
    flex_y.Row = i
    flex_y.Text = Round(y(i), dec)
    For j = k To m - 1
        Flexresult.Row = i
        Flexresult.Col = j
        tabmat(i, j) = tabmat(i, j) - (tabmat(k, j) * a)
        Flexresult.Col = j
        Flexresult.Row = i
        Flexresult.Text = Round(tabmat(i, j), dec)
    Next j
Next i
For i = 0 To m - 1
flex_y.Row = i
y(i) = flex_y.Text
    For j = 0 To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
ProgressBar1.Value = ProgressBar1.Value + pgb
Next k
'fin de l'agorithme'
ProgressBar1.Value = 0
For i = 0 To m - 1
    For j = 0 To m - 1
    tabmat(i, j) = temp(i, j)
    Next j
Next i
Cmdresult.Enabled = True
If tabmat(m - 1, m - 1) = 0 Then
MsgBox "Les équations ne sont pas indépendantes !", vbExclamation, "Matrice 1.0.0."
Cmdresult.Enabled = False
End If
break:
MsgBox "La matrice à été simplifiée pour permettre le calcul du résultat. cliquez sur 'resultat final' pour calculer les inconnus !", vbInformation, "Matrice 1.0.0."
End Sub

Private Sub cmdmodif_Click()
Flexmat.Text = InputBox("Rentrez la nouvelle valeur :", "Matrice 1.0.0.", 0, 2000, 200)
End Sub

Private Sub cmdrandom_Click()
Randomize
For i = 0 To m - 1
flex_yini.Row = i
flex_yini.Text = Round(20 * Rnd(20), 0)
    For j = 0 To m - 1
    Flexmat.Col = j
    Flexmat.Row = i
    Flexmat.Text = Round(20 * Rnd(20), 0)
    Next j
Next i
cmdmodif.Enabled = True
cmdsecond.Enabled = True
cmdgauss.Enabled = True
End Sub

Private Sub cmdremp_Click()
For i = 0 To m - 1
    For j = 0 To m - 1
    Flexmat.Col = j
    Flexmat.Row = i
    Flexmat.Text = InputBox("Veuillez rentrer la valeur de a(" & i & "," & j & ") :", "Matrice 1.0.0.", 0, 2000, 200)
    Next j
Next i
cmdmodif.Enabled = True
cmdsecond.Enabled = True
End Sub

Private Sub Cmdresult_Click()
Dim res() As Double
ReDim res(m)
Dim somme, val As Double
Dim j, kinv As Integer

'initialisation de res()'
For i = 1 To m - 1
res(i) = 0
Next i

'début de l'algorithme'
For k = 0 To m - 1
kinv = m - 1 - k

'somme des coeff.'
somme = 0
val = 0
j = m - 1
Do While j > kinv
    val = tabmat(m - 1 - k, j) * res(j)
    somme = somme + val
    j = j - 1
Loop
res(kinv) = (y(kinv) - somme) / tabmat(kinv, kinv)
Next k

'écriture des résultats'
For i = 0 To m - 1
flex_y.Row = i
flex_y.Text = Round(res(i), dec)
Next i

MsgBox "c'est fini!", vbInformation, "matrice 1.0.0."

End Sub

Private Sub cmdsecond_Click()
For i = 0 To m - 1
    flex_yini.Row = i
    flex_yini.Text = InputBox("variable " & i, "Matrice 1.0.0.", 0)
Next i
Cmdresult.Enabled = True
cmdgauss.Enabled = True
End Sub

Private Sub cmdvar_Click()
For i = 0 To m - 1
    Flexvarini.Row = i
    Flexvarini.Text = InputBox("variable " & i, "Matrice 1.0.0.", "x" & i)
Next i
End Sub

Private Sub Description_Click()
MsgBox "Ce programme permet de résoudre n équations à n inconnues. Il nécessite cependant une bonne connaissance de l'utilisation des matrices. ", vbInformation, "Matrice 1.0.0."
End Sub

Private Sub Form_Load()
Flexmat.FixedCols = 0
Flexmat.FixedRows = 0
Flexresult.FixedRows = 0
Flexresult.FixedCols = 0
m = 3
cmdgauss.Enabled = False
cmdmodif.Enabled = False
Cmdresult.Enabled = False
cmdsecond.Enabled = False
Call Rang_Click
End Sub

Private Sub Newmat_Click()
Flexmat.Clear
Flexresult.Clear
flex_yini.Clear
flex_y.Clear
flexvar.Clear
txtdec.Text = ""
Label1.Caption = ""
Cmdresult.Enabled = False
cmdmodif.Enabled = False
cmdgauss.Enabled = False
cmdsecond.Enabled = False
Call Rang_Click
End Sub

Private Sub Quitter_Click()
End
End Sub

Private Sub Rang_Click()
m = InputBox("Rang de la matrice carrée :", "Matrice 1.0.0. ", 3, 100, 200)
Flexmat.Cols = m
Flexmat.Rows = m
Flexresult.Cols = m
Flexresult.Rows = m
Flexvarini.Rows = m
flex_yini.Rows = m
flexvar.Rows = m
flex_y.Rows = m
For i = 0 To m - 1
    Flexvarini.Row = i
    Flexvarini.Text = "x" & i
Next i
End Sub

Private Sub Rng_Click()
Call Rang_Click
End Sub

Conclusion :


bientôt la version 1.0.1 plus rapide !
e-mail: zegratman@caramail.com

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
lundi 24 juillet 2006
Statut
Membre
Dernière intervention
5 mars 2007

Salut, à quelques années de décalage
Tu dois avoir réussi ton logiciel à l'heure actuelle. Ton prog est super génial, il va m'aider à réaliser un prog de calcul de structures avec la méthode des déplacements. Merci beaucoup.
Messages postés
1
Date d'inscription
jeudi 24 octobre 2002
Statut
Membre
Dernière intervention
25 juillet 2004

et bien merci pour tout ... mais ça fait longtemps que j'ai tapé ce code lol et donc je serais incapable, après deux ans, de rajouter un commentaire qui apporterait qqchose. En tout cas, c'est vraiment bien de l'avoir repris et amélioré. A l'époque j'ai déposé ce code pour qu'il servent à d'autres personnes, et voilà enfin que c'est chose faite.... tant mieux ! mission accomplie ! Je ne fais plus de VB depuis, je n'ai plus le temps mais peut-être un jour ça me reprendra....
Messages postés
1
Date d'inscription
samedi 24 avril 2004
Statut
Membre
Dernière intervention
24 juillet 2004

Bravo pour la qualité (efficacité au niveau du calcul), permets moi quand même de faire quelques remarques que pourra contribuer à l'optimisation de ton soft:
1- Dans la partie evenement :cmdgauss_Click,il est conseillé de découper certains traitements en plusieurs fonctions générique (cela éviterait de surcharger le code donc plus facile à maintenir par la suite).Par exemple, tout ce qu'est boucle "for" on peut faire une fonction qu'alimente un objet, ensuite il n'y a que les bornes d'incrémentation qui changent !!
2- Il me semble que t'as oublié de préciser quelques détails( à moins que c'est une icompréhension de ma part !), la déclaration de certaines variables locales (temporaire de tavail) ou globales !. Exemple la matrice "tabmat";copier tel quel dans un autre evenement, elle n'est reconnue !donc pb!!!
Bientôt, je vous mettrai à disposition la totalité du code que je pensai optimiser !!si cela pourrai vous intérreser!!!je me suis permis même de rajouter quelques commentaires.
En résumé: encore bravo et merci pour ton programme,et il est vrai qu'il faut une certaine connaissance en maths qu'en programmation pour le comprendre!!!
Messages postés
14
Date d'inscription
jeudi 17 octobre 2002
Statut
Membre
Dernière intervention
15 novembre 2006

Putain, ca rappelle de droles de souvenirs de lycée......

vive les sources de jeux...
Messages postés
169
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
27 février 2009
1
Beau, car complexe, mais j'aurai classé ça en "Maths".
Et ça peut être utile (même si en bidouillant excel...)
Afficher les 6 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.