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
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.