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

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (zegratman)