Class SurroundingClass
Public Const tol As Double = 0.001
Public Delegate Function fx(ByVal x As Double) As Double
Public Shared Function composeFunctions(ByVal f1 As fx, ByVal f2 As fx) As fx
Return Function(ByVal x As Double) f1(x) + f2(x)
End Function
Public Shared Function f_xirr(ByVal p As Double, ByVal dt As Double, ByVal dt0 As Double) As fx
Return Function(ByVal x As Double) p * Math.Pow((1.0 + x), ((dt0 - dt) / 365.0))
End Function
Public Shared Function df_xirr(ByVal p As Double, ByVal dt As Double, ByVal dt0 As Double) As fx
Return Function(ByVal x As Double) (1.0 / 365.0) * (dt0 - dt) * p * Math.Pow((x + 1.0), (((dt0 - dt) / 365.0) - 1.0))
End Function
Public Shared Function total_f_xirr(ByVal payments As Double(), ByVal days As Double()) As fx
Dim resf As fx = Function(ByVal x As Double) 0.0
For i As Integer = 0 To payments.Length - 1
resf = composeFunctions(resf, f_xirr(payments(i), days(i), days(0)))
Next
Return resf
End Function
Public Shared Function total_df_xirr(ByVal payments As Double(), ByVal days As Double()) As fx
Dim resf As fx = Function(ByVal x As Double) 0.0
For i As Integer = 0 To payments.Length - 1
resf = composeFunctions(resf, df_xirr(payments(i), days(i), days(0)))
Next
Return resf
End Function
Public Shared Function Newtons_method(ByVal guess As Double, ByVal f As fx, ByVal df As fx) As Double
Dim x0 As Double = guess
Dim x1 As Double = 0.0
Dim err As Double = 1.0E+100
While err > tol
x1 = x0 - f(x0) / df(x0)
err = Math.Abs(x1 - x0)
x0 = x1
End While
Return x0
End Function
End Class
测试代码
Dim val1() As Double = {4166.67, -4166.67, -4166.67, -4166.67}
Dim val2() As Double = {New Date(2014, 9, 1).DayOfYear, New Date(2014, 10, 1).DayOfYear, New Date(2014, 11, 1).DayOfYear, New Date(2014, 12, 1).DayOfYear}
Dim xirr = SurroundingClass.Newtons_method(0.1, SurroundingClass.total_f_xirr(val1, val2),SurroundingClass.total_df_xirr(val1, val2))
MsgBox(xirr)
加好友 
发短信
Post By：2020/1/9 9:41:00 [只看该作者]
