un code qui fait l'approximation polynomiale suivant des méthodes ;) c'est
du calcul numérique
Source / Exemple :
Option Explicit
Public Sub APPROX_Lagrang(ByVal Npts As Integer, _
ByRef TX() As Double, _
ByRef TY() As Double, _
ByVal xo As Double, _
ByRef yo As Double, _
ByRef err As Integer)
Dim j As Integer
Dim k As Integer
Dim h As Double
Dim ho As Double
If Npts < 0 Then err = -1: Exit Sub
yo = 0
For k = 1 To Npts
ho = 1
For j = 1 To Npts
If (j <> k) Then
h = TX(k) - TX(j)
If (h = 0) Then err = -2: Exit Sub
ho = ho * (xo - TX(j)) / h
End If
Next j
yo = yo + ho * TY(k)
Next k
err = 1
End Sub
Public Sub APPROX_Newton(ByVal Npts As Integer, _
ByRef TX() As Double, _
ByRef TY() As Double, _
ByVal xo As Double, _
ByRef yo As Double, _
ByRef err As Integer)
Dim m As Integer
Dim TCOEF() As Double
If (Npts < 0) Then err = -1: Exit Sub
ReDim TCOEF(Npts)
Call COEFF_Newton(Npts, TX(), TY(), TCOEF(), err)
yo = TCOEF(Npts)
For m = Npts - 1 To 1 Step -1
yo = yo * (xo - TX(m)) + TCOEF(m)
Next m
err = 1
End Sub
Public Sub APPROX_NEV(ByVal Npts As Integer, _
ByRef TX() As Double, _
ByRef TY() As Double, _
ByVal xo As Double, _
ByRef yo As Double, _
ByRef err As Integer)
Dim k As Integer, m As Integer
Dim h As Double
Dim w() As Double: ReDim w(Npts)
yo = 0
For k = 1 To Npts
w(k) = TY(k)
For m = k - 1 To 1 Step -1
h = TX(k) - TX(m)
w(m) = w(m + 1) + (w(m + 1) - w(m)) * (xo - TX(k)) / h
Next m
Next k
yo = w(1)
err = 1
End Sub
Public Sub APPROX_Hermite(ByVal Npts As Integer, _
ByRef TX() As Double, _
ByRef TY() As Double, _
ByRef d() As Double, _
ByVal xo As Double, _
ByRef yo As Double, _
ByRef err As Integer)
Dim j As Integer, k As Integer
Dim h As Double, g As Double, t As Double, h1 As Double, h2 As Double
If (Npts < 0) Then err = -1: Exit Sub
yo = 0
For k = 1 To Npts
g = 1
t = 0
For j = 1 To Npts
If (j <> k) Then
h = TX(k) - TX(j)
If (h = 0) Then err = -2: Exit Sub
g = g * (xo - TX(j)) / h
t = t + 1 / h
End If
Next j
h = g ^ 2
h1 = h * (1 - 2 * (xo - TX(k)) * t)
h2 = h * (xo - TX(k))
yo = yo + (TY(k) * h1) + (d(k) * h2)
Next k
err = 1
End Sub
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.