是否可以在VBA中执行一次* Newton的方法？

Question

我需要在关闭时使用牛顿的方法。

Function f (x as Double, y as Double) as Double 
    f = x^3-y 
End Function 

我从一个细胞得到的y值，然后我想找出时f为零。在上面的玩具例子中，如果单元格包含y=8，那么我希望牛顿的方法找到接近x=2的解决方案。

我的解决办法是让一个newton_solve_f功能：

Function newton_solve_f (y as Double as Double) as Double 
    Dim x as Double 
    x = 0 'initial guess for x 
    'do Newton's method to find x 
    ... 
    newton_solve_f = x 
End Function 

因此，实际上，我复制粘贴我的牛顿法（taken from here）到newton_solve_f代码。

问题是我有几个这样的f（有些具有两个以上的参数），并且如果我不必为每个参数制作单独的几乎相同的newton_solve_f，那将会非常整齐。

你会如何在VBA中解决这个问题？

在Python，例如，有可能按如下方式解决此问题：

def f(y): 
    def g(x): 
     return x^3-y 
    return g 

def newton_solve(f): 
    #do newton's method on f(x) 

newton_solve(f(3)) 

这里f(3)是一个函数，一个变量的closure。 （维基百科的封闭示例几乎与此相同。）

ps。我知道牛顿的方法也需要f的（部分）导数，我实际上做的更像是割线方法，但这与我所询问的不相关

Answer 1

所以首先要总结一下：这个函数将会找到（使用牛顿 - 拉夫逊方法）函数的根。您已经编写了这些代码并为某些功能工作，但希望能够帮助您扩展代码，以便它能够处理具有不同参数数量的各种功能。

我认为你首先需要考虑你想要覆盖哪些输入函数。如果你只处理多项式（如你的例子所示），这应该是相当简单的。

你可以有一般功能：

Function fnGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double 
    fnGeneralCase = a1*x^3 + a2*x^2 + a3*x + b1*y^3 + b2*y^2 + b3*y + c1*z^3 + c2*z^2 + c3*z + w 
End Function 

Function fnDerivGeneralCase (x, y, z, w, a1, a2, a3, b1, b2, b3, c1, c2, c3 as Double) as Double 
    fnDerivGeneralCase = a1*3*x^2 + a2*2*x + a3 + b1*3*y^2 + b2*2*y + b3 + c1*3*z^2 + c2*2*z + c3 
End Function 

而刚刚成立的投入为零，当你不需要他们（这将是大部分时间）。

因此，对于您的示例调用：

answer = fnGeneralCase(guess, 0, 0, -8, 1, 0, 0, 0, 0, 0, 0, 0, 0) 

基本上给：

function = x^3-8 

如果要包括比多项式更多，这会变得更加复杂，但你仍然可以使用上面的方法。 ..

Answer 2

闭包不是VBA的一部分。但是你可以在方法范围内使用静态变量。它们不能在该方法之外使用。如果你想要一个变量在外面可见，那么你必须使用全局变量。最好在一个模块中声明它。

我们不能在VB中定义函数里面的函数。试图转换您提到的链接中给出的代码。我希望它能帮助你。不熟悉PHP，但你可以看到下面的方法，并相应地做出改变。

Sub Test() 
    Dim x As Double 
    Dim y As Double 
    Dim z As Double 

    x = Cells(1, 1).Value 
    y = Cells(1, 2).Value 
    z = NewtRap("Fun1", "dFun1", x, y) 
    Cells(1, 3).Value = z 
End Sub 

Private Function NewtRap(fname As String, dfname As String, x_guess As Double, y_value As Double) As Double 
    Dim cur_x As Double 
    Dim Maxiter As Double 
    Dim Eps As Double 

    Maxiter = 500 
    Eps = 0.00001 
    cur_x = x_guess 
    For i = 1 To Maxiter 
    If (fname = "Fun1") Then 
     fx = Fun1(cur_x) 
    ElseIf (fname = "dFun1") Then 
     fx = dFun1(cur_x) 
    ElseIf (fname = "f") Then 
     fx = f(cur_x, y_value) 
    End If 
    If (dfname = "Fun1") Then 
     fx = Fun1(cur_x) 
    ElseIf (dfname = "dFun1") Then 
     fx = dFun1(cur_x) 
    ElseIf (dfname = "f") Then 
     fx = f(cur_x, y_value) 
    End If 
    If (Abs(dx) < Eps) Then Exit For 
    cur_x = cur_x - (fx/dx) 
    Next i 
    NewtRap = cur_x 
End Function 

Function f(x As Double, y As Double) As Double 
    f = x^3 - y 
End Function 

Function Fun1(x As Double) As Double 
    Fun1 = x^2 - 7 * x + 10 
End Function 

Function dFun1(x As Double) As Double 
    dFun1 = 2 * x - 7 
End Function 

Answer 3

这好像是问2个相关的问题：

1. 如何传递函数，如在VBA参数。
2. 如何从现有函数创建闭包。

可惜这些都不是真正的支持，然而，

• 1，你通常可以解决此通过传递一个字符串函数的名称，并使用“Application.Run”要调用的函数。
• 如果您有许多具有不同数量参数的函数，但是对于一定数量的参数，您可以为newton_solve函数添加额外参数，或者可能使用全局变量，则更为复杂。

例如

Public Function f(x as Double, y as Double) as Double 
    f = x^3-y 
End Function 


Function newton_solve_f (function_name as String, y as Double) as Double 
    Dim x as Double 
    x = 0 'initial guess for x 
    'do Newton's method to find x 

    ... 
     ' invoke function_name 
     x = Application.Run(function_name, x, y) 
    ... 
    newton_solve_f = x 
End Function 

假设f是一个名为“模块1”模块中，你可以调用这个：

x = newton_solve('Module1.f', 3) 

需要注意的是要调用的函数必须是公开的。