MÉTHODES MOINDRES CARRÉS ET RÉSOLUTION ÉQUATION 3EME DEGRÉ SELON ALGORYTHME DE CARDAN

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

Télécharger le zip