Méthodes moindres carrés et résolution équation 3eme degré selon algorythme de cardan

Télécharger le projet
Commenter

Description

Un petit module qui peut servir aux matheux!
Se trouvent dans le module :
1- compilation de petites fonctions sur les matrices (repris d'une source existante)
2- lissage par la méthode des moindres carrés
3- résolution analytique d'une équation du 3eme degré selon l'algorythme de cardan.

Source / Exemple : 


Sub MoindreCarre(X(), Y(), p, C())
'X : Tableau des abscisses
'y : Tableau des ordonnées
'p : Dégre de la régression
'C : Tableau des coefficients du polynome calcul (doit contenir p+1 termes)
'
'le polynome genere est de la forme : Y = C(0)+ C(1)*X + C(2)* X^2 + ....
Dim A(), S() As Double
'Nombre de points
'N = 7
'plage des X
'X(1) = -3: X(2) = -2: X(3) = 1: X(4) = 2: X(5) = 3: X(6) = 4: X(7) = 5
'plage des Y
'Y(1) = 2: Y(2) = 0.5: Y(3) = -1: Y(4) = -1: Y(5) = 0: Y(6) = 2: Y(7) = 4
' Solution : c(2) = 0.2698761, c(1) = -0.304307, c(0) = -1.258357.

'Nombre de points
n = UBound(X)

ReDim A(1 To p + 1, 1 To p + 1), S(0 To 2 * p), W(1 To p + 1, 1 To 1), Sol(1 To p + 1, 1 To 1)   'dimensions de la matrice du système

'calcul des Sk
For k = 0 To 2 * p: S(k) = 0
  For i = 1 To n
    S(k) = S(k) + X(i) ^ k
  Next i
Next k
'calcul des Wk
For k = 0 To p: W(k + 1, 1) = 0
  For i = 1 To n
    W(k + 1, 1) = W(k + 1, 1) + Y(i) * X(i) ^ k
  Next i
Next k
'coefficients de la matrice du système
For i = 1 To p + 1
  For j = 1 To p + 1
   If i = 1 And j = 1 Then A(1, 1) = n Else A(i, j) = S(i + j - 2)
  Next j
Next i

Call MAT_GAUSS(A(), W(), Sol())
For k = 0 To p
 C(k + 1) = Sol(k + 1, 1) 'matrice colonne du second membre
Next k
End Sub

'----------------------------------------------------------------------------------

Function Solvdeg3(A, B, C, D, X)
'Resolution d'une équation du troisieme degre selon l'algorithme de Cadran
'f(x)= A x^3 + B x^2 + C x +  D = 0

Dim q, del

ReDim X(0 To 2)

vt = -B / (3 * A)
mvt = -vt

p = C / A - B ^ 2 / (3 * A ^ 2)
q = B ^ 3 / (A ^ 3 * 13.5) + (D / A) - B * C / (3 * A ^ 2)
del = (q ^ 2 / 4) + (p ^ 3 / 27)

If (Abs(p) < 0.000000000001) Then p = 0
If (Abs(del) < 0.000000000001) Then del = 0

If (del <= 0) Then
    If (p <> 0) Then
     kos = -q / 2 / Sqr(-p ^ 3 / 27)
     If (Abs(kos) > 1) Then kos = Sgn(kos)
    End If
    If (Abs(kos) = 1) Then
      alpha = -Pi * (kos - 1) / 2
    Else
      alpha = Acos(kos)
    End If
    R = Sqr(-p / 3)
    For k = 0 To 2
      X(k) = 2 * R * Cos((alpha + 2 * k * Pi) / 3) + vt
    Next k
    Solvdeg3 = 3 '3 solutions  (peut etre 2 double)
Else
    R = Sqr(del)
    sg = 1
    z = -q / 2 + sg * R
    uv1 = Sgn(z) * Abs(z) ^ (1 / 3)
    
    sg = -1
    z = -q / 2 + sg * R
    uv2 = Sgn(z) * Abs(z) ^ (1 / 3)
    
    xuni = uv1 + uv2 + vt
    For k = 0 To 2
      X(k) = xuni
    Next k
    
    Solvdeg3 = 1 '1 solution unique (les 2 autres sont complexes)
End If

End Function

Conclusion :


telecharger le zip pour avoir le module complet
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.