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