跪求拉格朗日插值算法事例

Question

请发往[email protected]或者留在此均可

Answer 1

'**********一元n点拉格朗日插值***********
function Lagrange3(inputx)
dim i,j
dim x,y
result=0
x=array("0","0.1","0.195","0.4","0.401","0.5")
y=array("0.39894","0.39695","0.39142","0.38138","0.36812","0.35206")for j=0 to 5 
t=1
for i=0 to 5
if i<>j then
t= t * (inputx-x(i))/(x(j)-x(i))
end if
next
result = result + t * y(j)
next
result= view(result,inputx)
end function

Answer 2

function view(result,inputx)'输出结果，同时如果<1 and >0,就在前面补0
if result<1 and result>0 then result=0&result
Response.Write "计算结果："&"<br>"
Response.Write "F("&inputx&")="& result
end function

Answer 3

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：InterpModule.bas
'  函数名：INLagrn
'  功能：  用拉格朗日插值公式进行一元全区间不等距插值
'  参数：  n     - Integer型变量，给定结点的点数
'          x     - Double型一维数组，长度为n，存放给定的n个结点的值x(i)，要求x(1)<x(2)<...<x(n)
'          y     - Double型一维数组，长度为n，存放给定的n个结点的函数值y(i)，y(i) = f(x(i)), i=1,2,...,n
'          t   - Double型变量，存放指定的插值点的值
'  返回值：Double型，指定的查指点t的函数近似值f(t)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function INLagrn(n As Integer, X() As Double, Y() As Double, t As Double) As Double
    Dim i As Integer, j As Integer, k As Integer, m As Integer
    Dim z As Double, s As Double
    z = 0
    If (n < 1) Then
        INLagrn = z
        Exit Function
    End If
    If (n = 1) Then
        z = Y(1)
        INLagrn = z
        Exit Function
    End If
    If (n = 2) Then
        z = (Y(1) * (t - X(2)) - Y(2) * (t - X(1))) / (X(1) - X(2))
        INLagrn = z
        Exit Function
    End If
    i = 1
    While ((X(i) < t) And (i < n))
        i = i + 1
    Wend
    k = i - 4
    If (k < 0) Then k = 0
    m = i + 3
    If (m > n - 1) Then m = n - 1    For i = k To m
        s = 1#
        For j = k To m
            If (j <> i) Then s = s * (t - X(j + 1)) / (X(i + 1) - X(j + 1))
        Next j
        z = z + s * Y(i + 1)
    Next i
    INLagrn = z
End Function

Answer 4

'测试了一下，OKOption Explicit'**********一元n点拉格朗日插值***********
Function Lagrange3(inputx)
Dim i, j
Dim x, y
Dim result, t
result = 0
x = Array("0", "0.1", "0.195", "0.4", "0.401", "0.5")
y = Array("0.39894", "0.39695", "0.39142", "0.38138", "0.36812", "0.35206")For j = 0 To 5
t = 1
For i = 0 To 5
If i <> j Then
t = t * (inputx - x(i)) / (x(j) - x(i))
End If
Next
result = result + t * y(j)
Next
result = view(result, inputx)
End FunctionFunction view(result, inputx) '输出结果，如果<1且>0,前面补0
If result < 1 And result > 0 Then result = 0 & result
Print "测试结果："
Print "F(" & inputx & ")=" & result
End FunctionPrivate Sub Command1_Click()
    Call Lagrange3(100)
End Sub

Answer 5

下载这个，里面应该有：
http://koolwg.idc99.cn/showdown.asp?soft_id=21