100 puntos. Ayúdenme a escribir el código VB para la interpolación de Newton y la interpolación spline. ¡Lo necesito con urgencia! ! !
Lo he compilado yo mismo, pero carece de interpolación spline. Aquí solo hay funciones. Puedes programar cualquier control tú mismo, es demasiado simple.
Dim aa As Double, bb As Double 'Recibe las variables en ambos extremos del intervalo raíz de Findway respectivamente
Dim x(1) As Double 'Recibe las raíces de ercigenway respectivamente p >
'1.0 ercigenway Encuentra las raíces reales de ecuaciones cuadráticas - probadas
Private Sub ercigenway(a As Single, b As Single, c As Single) 'a, b, c corresponden a ecuaciones cuadráticas Coeficiente de
Dim d As Double
d = b ^ 2 - 4 * a * c
Si d lt 0 Entonces
MsgBox "Δ es menor que 0 y no tiene raíces reales", , "Mensaje"
x(0) = 0: x(1) = 0
ElseIf d = 0 Entonces p>
x(0) = -b / (2 * a): x(1) = x(0)
Si no
x(0) = (- b - Sgn(b) * Sqr(d)) / (2 * a): x(1) = c / (a * x(0))
End If p>
End Sub
'2.1 escaneo de pasos iguales de findway con intervalo de raíz - probado
Private Sub findway(ByVal a As Single, ByVal b As Single, h As Double ) 'a, b son los puntos finales del intervalo a escanear, h es el tamaño del paso
Dim a1 As Double
a1 = a
Do
Si f (a1) * f(a1 h) lt; = 0 Entonces
aa = a1: bb = a1 h
Salir de Sub
Finalizar si
a1 = a1 h
Bucle mientras a1 lt;
Si a1 gt b Entonces
MsgBox; "No se encontró ningún intervalo raíz, intente cambiar a un tamaño de paso más pequeño"
Salir de Sub
End If
End Sub
' 2.2 Método de bisección erfenfun para encontrar la raíz -Probado
Función privada erfenfun(ByVal a As Single, ByVal b As Single, eps As Double) 'a y b son los puntos finales del intervalo raíz, eps es el error
Dim x0 como doble, x1 como doble, x2 como doble, f0 como doble, f1 como doble, f2 como doble
e
x1 = a: x2 = b
Hacer
x0 = (x1 x2) / 2
f0 = f(x0 )
Si f0 = 0 Entonces
Salir Hacer
Si no
f1 = f(x1): f2 = f(x2)
Si f0 * f1 lt 0 Entonces
x2 = x0
De lo contrario
x1 = x0
Finalizar si
Finalizar si
Bucle mientras Abs(x1 - x2) gt; eps
x0 = (x1 x2) / 2
erfenfun = x0
Función final
'2.4 newtonfxfun Método tangente de Newton - probado
Función privada newtonfxfun(ByVal x0 As Double, eps As Double) As Double 'x0 es la raíz cercana, eps es el error
Dim x1 As Double, f0 As Double, f1 As Double
x1 = x0
Do p >
x0 = x1
f0 = f(x0): f1 = fd(x0) 'fd representa la función derivada de f
If Abs(f1) lt; eps Entonces
x1 = x0: Salir Do
Finalizar si
x1 = x0 - f0 / f1
Bucle hasta Abs(x1 - x0 ) lt; eps
newtonfxfun = x1
Función final
'2.3 stediedaifun Método de iteración acelerada de Seffensen (la forma de la ecuación es x-f(x)=0 ) - Ya estoy probando
Función privada stediedaifun(ByVal x0 As Double, eps1 As Double, eps2 As Double) Como Double 'x0 es la raíz cerca de la solución analítica, eps1 es el error del resultado de salida, eps2 es el Criterio para juzgar si la iteración puede continuar
Dim y As Double, z As Double, x1 As Double
x1 = x0
Do
x0 = x1
y = f(x0): z = f(y)
If Abs(z - 2 * y x0) lt; eps2 Entonces
MsgBox "Para satisfacer la condición eps2, la iteración no puede continuar"
Función de salida
Finalizar si
x1 = x0 - (y - x0) ^ 2 / (z - 2 * y x0)
Bucle hasta Abs(x1 - x0) lt; eps1
stediedaifun = x1
Función final
'2.5 newtonfxnfun Ecuación algebraica de n-ésimo grado Método de la tangente de Newton - probado
Función privada newtonfxnfun(a() As Single, eps As Double, x0 As Double) As Double 'a() almacena n coeficientes de la ecuación ordenados en potencia descendente, eps es el error, x0 es la raíz cercana p >
Dim k Como entero, n Como entero, f0 Como doble, f1 Como doble, x1 Como doble
n = UBound(a)
x1 = x0 p >
Hacer
x0 = x1
f0 = a(0): f1 = f0
Para k = 1 To n - 1 p >
f0 = a(k) f0 * x0
f1 = f0 f1 * x0
Siguiente k
f0 = a(n) f0 * x0
x1 = x0 - f0 / f1
Bucle hasta Abs(x1 - x0) lt; eps
newtonfxnfun = x1
Función final
'2.6 método de interceptación de cadenas linecutfun - probado
Función privada linecutfun(ByVal x0 As Double, ByVal x1 As Double, eps As Double, n As Long) As Double ' n es el límite del número de iteraciones, x0 y x1 son los puntos finales del intervalo raíz, eps es el error
Dim f0 As Double, f1 As Double, f2 As Double
Atenuar x2 como doble, i mientras
f0 = f(x0): f1 = f(x1)
Para i = 1 a n
x2 = x1 - (x1 - x0 ) * f1 / (f1 - f0)
f2 = f(x2)
Si Abs(f2) lt entonces
Salir para
Finalizar si
x0 = x1: x1 = x2: f0 = f1: f1 = f2
Siguiente i<
/p>
Si i = n 1 Entonces
MsgBox "El número requerido de cálculos es demasiado bajo y no se cumplen los requisitos de precisión"
Fin si
linecutfun = x2
Función final
'4.1 lagrangeczfun Método de interpolación de Lagrange - probado
Función privada lagrangeczfun(a() As Double, ByVal u As Double) Como Double 'a(1, n) almacena n 1 nodos, u es el punto de interpolación
Dim i As Integer, j As Integer, n As Integer
Dim l As Doble, v Como Doble
v = 0
n = UBound(a, 2)
Para j = 0 To n
l = 1#
Para i = 0 To n
Si i = j Entonces GoTo hulue
l = l * (u - a(0, i )) / (a(0, j) - a(0, i))
hulue:
Siguiente i
v = v l * a(1 , j)
Siguiente j
lagrangeczfun = v
Función final
'4.2 newtonczfun método de interpolación de newton - probado
Función privada newtonczfun(a() As Double, u As Double) As Double 'a(1, n) almacena n 1 nodos, u es el punto de interpolación
Dim n As Integer, i As Entero, j Como entero, k Como entero
Dim z() Como doble, f() Como doble, v Como doble
n = UBound(a, 2) p >
ReDim z(n), f(n)
Para i = 0 To n
z(i) = a(1, i)
Siguiente i
Para i = 1 A n
k = k 1
Para j = i A n
f ( j) = (z(j) - z(j - 1)) / (a(0, j) - a(0, j - k))
Siguiente j
Para j = i To n
z(j) = f(j)
Siguiente j
Siguiente i
f( 0 ) = un(
1, 0)
v = 0
Para i = n a 0 Paso -1
v = v * (u - a(0, i) ) f(i)
Siguiente i
newtonczfun = v
Función final
'4.3 hermiteczfun Método de interpolación de Hermite - probado
p>
Función privada hermiteczfun(a() As Double, fd() As Double, u As Double) As Double 'a(1, n) almacena n 1 nodos, fd(n) almacena n 1 nodos El valor derivado en, u es el punto de interpolación
Dim l() Como doble, ld() Como doble, g() Como doble, h() Como doble, apuntado como doble
Dim n como entero, i como entero, j como entero
n = UBound(a)
ReDim l(n), ld(n), g(n), h( n )
objetivo = 0
Para i = 0 a n
l(i) = 1: ld(i) = 0
Para j = 0 To n
Si j = i Entonces GoTo hulue
l(i) = l(i) * (u - a(0, j)) / ( a(0, i) - a(0, j))
ld(i) = ld(i) 1 / (a(0, i) - a(0, j)) p >
hulue:
Siguiente j
g(i) = (1 2 * (a(0, i) - u) * ld(i)) * l ( i) * l(i)
h(i) = (u - a(0, i)) * l(i) * l(i)
objetivo = objetivo g (i) * a(1, i) h(i) * fd(i)
Siguiente i
hermiteczfun = aim
Función final p >
'5.2.1 método de integración trapezoidal de tamaño de paso variable tixingjffun - probado
Función privada tixingjffun(a As Single, b As Single, eps As Double, m As Long) As Double 'a, b son los límites superior e inferior de integración respectivamente, eps es el error, m es el número máximo de cálculos
Dim h As Double, t1 As Double, t2 As Double, t As Double, hh As Double
Dim n Mientras: n = 1
<p> h = b - a: t1 = h * (f(a) f(b)) / 2
Hacer
t = 0
Para i = 1 To n
t = t f(a (i - 0.5) * h)
Siguiente i
hh = h * t
t2 = (t1 hh) / 2
Si Abs(t2 - t1) lt; eps Then Exit Do
t1 = t2: h = h / 2: n = 2 * n
Bucle hasta n gt; 2 * m
Si n gt; entonces
MsgBox "El número de cálculos es demasiado pequeño y no se puede alcanzar el requisito de error"
End If
tixingjffun = t2
End Function
'5.2.2 simpsonjffun paso variable Integración de Simpson método- Probado
Función privada simpsonjffun(a As Single, b As Single, eps As Double, m As Long) Como Double 'a y b son los límites superior e inferior de integración respectivamente, eps es el error , y m es el número máximo de cálculos
Dim n As Long, i As Long
Dim h As Double, t1 As Double, t2 As Double, hh As Double, s1 As Doble, s2 Como Doble
n = 1: h = b - a: t1 = h * (f(a) f(b)) / 2
hh = h * ( f((a b) / 2)) : s1 = (t1 2 * hh) / 3
Hacer
n = 2 * n: h = h / 2: t2 = ( t1 hh) / 2
t = 0
Para i = 1 To n
t = t f(a (i - 0.5) * h) p>
Siguiente i p>
hh = t * h
s2 = (t1 2 * hh) / 3
Si Abs(s2 - s1) lt; eps Luego salir Hacer
t1 = t2: s1 = s2
Bucle hasta n gt; de cálculos es demasiado pequeño para cumplir con los requisitos de error"
simpsonjffun = s2
Función final
'5.3 Rombergjffun Método integral de Romberg
Función privada rombergjffun(a Como soltero, b A
s Simple, eps Como Doble) Como Doble
Dim k Como Entero, n Como Entero, h Como Doble
k = 0: n = 1: h = b - a p>
Función final
'5.5.1 ds1fun Encuentra la primera derivada - probada
Función privada ds1fun(x0 como simple, eps como doble) Como doble 'x0 es encontrar el punto de la derivada, eps es el error
Dim h As Double, t1 As Double, t2 As Double
h = 1: t1 = (f(x0 h) - f(x0 - h)) / (2 * h)
h = h / 2: t2 = (f(x0 h) - f(x0 - h)) / (2 * h)
Hacer Mientras Abs(t2 - t1) gt; eps
t1 = t2
h = h / 2
t2 = (f(x0 h) - f(x0 - h)) / (2 * h)
Bucle
ds1fun = t2
Función final
'5.5 2 ds2fun Encuentra la segunda derivada - probada
Función privada ds2fun(x0 como simple, eps como doble) Como doble 'x0 es el punto de la derivada, eps es el error
Dim h. Como Doble, t1 Como Doble, t2 Como Doble
h = 1: t1 = (f(x0 h) f(x0 - h) - 2 * f(x0)) / (h * h)
h = h/2: t2 = (f(x0 h) f(x0 - h) - 2 * f(x0)) / (h * h)
Hacer mientras abdominales ( t2 - t1) gt; eps
t1 = t2
h = h / 2
t2 = (f(x0 h) f(x0 - h ) - 2 * f(x0)) / (h * h)
Bucle
ds2fun = t2
Función final