Imports ggCoreLib
Imports BV.Math
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.ComponentModel
''' <summary>
''' Permite mediante diversos m�todos hallar Raices de funciones
''' que pueden ser de variable compleja
''' </summary>
''' <remarks></remarks>
Public Class FindRootUtil
Implements IIconnable
Const Factor As Single = 1.6
Const Ntry As Integer = 50
Private ErrorType As TypeOfError
Private NroIterations As Integer
Private intIterations As Integer 'cantidad de iteraciones realizadas para llegar a encontrar la raiz
Private intEnableAnimation As Boolean
Private intEnableStepping As Boolean
Private StepGo As Boolean
Private intAccuracy As Single
Private intDefaultRange As RangeF
Private intRootValue As Single
Private intRootFound As Boolean
Private intIcon As Icon
Private ARanges() As RangeF 'Array de rangos donde hay al menos una singularidad
Private intBracketIterations As Integer
Private intBracketSteps As Integer
Public Event RootFound(ByVal sender As Object, ByVal e As EventArgs)
Public Event RangeChange(ByVal sender As Object, ByVal e As EventArgs)
#Region "Delegates Types"
'dibuja un punto y un label en la coordenada especificada
Public Delegate Sub DrawPoint(ByVal g As Graphics, ByVal x As Single, ByVal y As Single, ByVal Label As String, ByVal ptColor As Color)
'dibuja una linea recta entre las coordenadas especificadas
'en el grafico de funciones
Public Delegate Sub DrawLine(ByVal g As Graphics, ByVal x1 As Single, ByVal x2 As Single, ByVal y1 As Single, ByVal y2 As Single)
'dibuja la recta tangente a partir de la coordenada dada
'hasta Y=0
Public Delegate Sub DrawTangent(ByVal g As Graphics, ByVal x1 As Single, ByVal y1 As Single, ByVal Pend As Single, ByVal blnNoEnd As Boolean)
Public DrawPointMethod As DrawPoint
Public DrawLineMethod As DrawLine
Public DrawTangentMethod As DrawTangent
#End Region
#Region "Constructor"
Public Sub New()
NroIterations = 50
intAccuracy = 0.005
ErrorType = TypeOfError.ENone
intEnableAnimation = False
StepGo = False
intEnableStepping = False
intDefaultRange.Min = -10
intDefaultRange.Max = 10
intRootValue = 0
intRootFound = False
Me.intIcon = New Icon([GetType], "FRFalseP.ico")
intBracketIterations = 50
Me.intBracketSteps = 50 'Me.Range.dx / intBracketIterations
End Sub
#End Region
#Region "Properties"
#Region "Animation"
'para que pueda animarse deben estar seteados todos los metodos de graficado
'<Category("Animation")> _
<Browsable(False)> _
Public Property EnableAnimation() As Boolean
Get
Return intEnableAnimation
End Get
Set(ByVal Value As Boolean)
If Value Then
If Not DrawPointMethod Is Nothing Then
If Not DrawLineMethod Is Nothing Then
If Not DrawTangentMethod Is Nothing Then
intEnableAnimation = Value
Return
End If
End If
End If
End If
intEnableAnimation = False
End Set
End Property
' <Category("Animation")> _
<Browsable(False)> _
Public Property EnableStepping() As Boolean
Get
Return intEnableStepping
End Get
Set(ByVal Value As Boolean)
intEnableStepping = Value
End Set
End Property
#End Region
#Region "Value"
''' <summary>
''' Nivel de exactitud utilizado para el c�lculo de la ra�z
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Value"), Description("Nivel de exactitud utilizado para el c�lculo de la ra�z")> _
Public Property Accuracy() As Single
Get
Return intAccuracy
End Get
Set(ByVal Value As Single)
If Value > 0 Then
intAccuracy = Value
End If
End Set
End Property
''' <summary>
''' N�mero de iteraciones realizadas para obtener el valor deseado de la ra�z
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Value"), Description("N�mero de iteraciones realizadas para obtener el valor deseado de la ra�z")> _
Public ReadOnly Property Iterations() As Integer
Get
Return Me.intIterations
End Get
End Property
''' <summary>
''' Valor encontrado de la Ra�z
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Value"), Description("Valor encontrado de la Ra�z")> _
Public ReadOnly Property RootValue() As Single
Get
Return intRootValue
End Get
End Property
''' <summary>
''' Es True si la ra�z fue encontrada en el intervalo dado
''' con las condiciones dadas
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Value"), Description("Es True si la ra�z fue encontrada en el " & _
"")> _
Public ReadOnly Property RootFounded() As Boolean
Get
Return intRootFound
End Get
End Property
''' <summary>
''' L�mites entre los cuales se buscar� la ra�z de la funci�n especificada
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Value"), Description("L�mites entre los cuales se buscar� la" & _
"ra�z de la funci�n especificada")> _
Public Property Range() As RangeF
Get
Return intDefaultRange
End Get
Set(ByVal Value As RangeF)
intDefaultRange = Value
RaiseEvent RangeChange(Me, New EventArgs)
End Set
End Property
#End Region
#Region "Ranges"
''' <summary>
''' Intervalos conocidos donde al menos hay una ra�z
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Ranges"), Description("Intervalos conocidos donde al menos hay una ra�z")> _
Public ReadOnly Property KnownRanges() As RangeF()
Get
Return Me.ARanges
End Get
End Property
''' <summary>
''' N�mero de intervalos conocidos donde al menos hay una ra�z
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Ranges"), Description("N�mero de intervalos conocidos donde al menos hay una ra�z")> _
Public ReadOnly Property KnownRangesCount() As Integer
Get
If ARanges Is Nothing Then
Return 0
End If
Return Me.ARanges.GetUpperBound(0) + 1
End Get
End Property
''' <summary>
''' M�ximo numero de iteraciones permitidas en la b�squeda de intervalos con raices
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Ranges"), Description("M�ximo numero de iteraciones permitidas en la" & _
" b�squeda de intervalos con raices")> _
Public Property BracketIterations() As Integer
Get
Return Me.intBracketIterations
End Get
Set(ByVal Value As Integer)
If Value > 0 Then
intBracketIterations = Value
Else
MessageManager.Send(Me, New MessageEventArgs("Bracket Iteration number " & _
"must be greater than 0", MessageEventArgs.EMessageType.Warning))
End If
End Set
End Property
''' <summary>
''' N�mero de intervalos con ra�ces a buscar
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Ranges"), Description("N�mero de intervalos con ra�ces a buscar")> _
Public Property BracketsNumber() As Integer
Get
Return Me.intBracketSteps
End Get
Set(ByVal Value As Integer)
If Value < Me.Range.dx AndAlso intBracketSteps > 0 Then
Me.intBracketSteps = Value
Else
MessageManager.Send(Me, New MessageEventArgs("Bracket Step must be lower than finding Range", MessageEventArgs.EMessageType.Warning))
End If
End Set
End Property
''' <summary>
''' Paso utilizado en la determinaci�n de los intervalos que contienen raices
''' </summary>
''' <value></value>
''' <returns></returns>
''' <remarks></remarks>
<Category("Ranges"), Description("Paso utilizado en la determinaci�n de los intervalos que contienen raices")> _
Public ReadOnly Property BracketStep() As Single
Get
Return Me.intDefaultRange.dx / Me.intBracketSteps
End Get
End Property
#End Region
#Region "Browsable(False)"
<Browsable(False)> _
Public Property Min() As Single
Get
Return intDefaultRange.Min
End Get
Set(ByVal Value As Single)
intDefaultRange.Min = Value
RaiseEvent RangeChange(Me, New EventArgs)
End Set
End Property
<Browsable(False)> _
Public Property Max() As Single
Get
Return intDefaultRange.Max
End Get
Set(ByVal Value As Single)
intDefaultRange.Max = Value
RaiseEvent RangeChange(Me, New EventArgs)
End Set
End Property
<Browsable(False)> _
Public Property Icon() As System.Drawing.Icon Implements IIconnable.Icon
Get
Return intIcon
End Get
Set(ByVal Value As System.Drawing.Icon)
If Not Value Is Nothing Then
intIcon = Value
End If
End Set
End Property
#End Region
#End Region
#Region "Steps methods"
Public Sub NextStep()
StepGo = True
End Sub
Private Sub WaitStepping()
Do While intEnableStepping
'se queda esperando hasta el proximo stepgo
If StepGo Then
StepGo = False
Exit Do
End If
System.Windows.Forms.Application.DoEvents()
Loop
End Sub
#End Region
#Region "Find Roots methods"
#Region "False Position methods"
'Utiliza el rango predeterminado de la clase para buscar la raiz
Public Function FRFalsePosition(ByVal Calc As OperSingleDelegate) As Single
Return FRFalsePosition(Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
Public Function FRFalsePosition(ByVal g As Graphics, ByVal Calc As OperSingleDelegate) As Single
Return FRFalsePosition(g, Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
'solo busca la raiz. pero no dibuja nada
Public Function FRFalsePosition(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl As Single, f As Single, fl As Single
Dim xh As Single, fh As Single, del As Single
Dim Swap As Single, dx As Single
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
If fl * fh > 0 Then
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection in rtbis", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If fl < 0 Then
xl = X1 'xl al contiene al f(x) negativo
xh = X2
Else
xl = X2
xh = X1
Swap = fl
fl = fh
fh = Swap
End If
dx = xh - xl
For intIterations = 1 To NroIterations
intRootValue = xl + dx * fl / (fl - fh) 'pendiente de la secante
f = Calc(intRootValue)
If f < 0 Then
del = xl - intRootValue
xl = intRootValue
fl = f
Else
del = xh - intRootValue
xh = intRootValue
fh = f
End If
dx = xh - xl
If Math.Abs(del) < intAccuracy Or f = 0 Then
FRFalsePosition = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection in rtbis", MessageEventArgs.EMessageType.[Error]))
End Function
'False Position method
'1/8/03
Public Function FRFalsePosition(ByVal g As Graphics, ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl As Single, f As Single, fl As Single
Dim xh As Single, fh As Single, del As Single
Dim Swap As Single, dx As Single
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
If fl * fh > 0 Then
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection in rtbis", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If fl < 0 Then
xl = X1 'xl al contiene al f(x) negativo
xh = X2
Else
xl = X2
xh = X1
Swap = fl
fl = fh
fh = Swap
End If
dx = xh - xl
If intEnableAnimation Then
DrawPointMethod(g, xl, fl, intIterations, Color.Green)
End If
For intIterations = 1 To NroIterations
WaitStepping()
intRootValue = xl + dx * fl / (fl - fh) 'pendiente de la secante
f = Calc(intRootValue)
If f < 0 Then
If intEnableAnimation Then 'ahora cambia de pivot si los dos f tienen el mismo signo
DrawPointMethod(g, xl, fl, intIterations, Color.GreenYellow)
DrawPointMethod(g, xh, fh, "", Color.Red)
DrawLineMethod(g, xl, xh, fl, fh)
End If
del = xl - intRootValue
xl = intRootValue
fl = f
Else
If intEnableAnimation Then
DrawPointMethod(g, xl, fl, intIterations, Color.Green)
DrawPointMethod(g, xh, fh, intIterations, Color.Green)
DrawLineMethod(g, xh, xl, fh, fl)
End If
del = xh - intRootValue
xh = intRootValue
fh = f
End If
dx = xh - xl
If Math.Abs(del) < intAccuracy Or f = 0 Then
FRFalsePosition = intRootValue
intRootFound = True
If intEnableAnimation Then
DrawPointMethod(g, intRootValue, f, intIterations, Color.Blue)
End If
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection in rtbis", MessageEventArgs.EMessageType.[Error]))
End Function
#End Region
#Region "Secant methods"
Public Function FRSecant(ByVal Calc As OperSingleDelegate) As Single
Return FRSecant(Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
Public Function FRSecant(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl, f, fl As Single
Dim Swap, dx As Single
Me.intRootFound = False
f = Calc(X1)
fl = Calc(X2)
If Math.Abs(fl) < Math.Abs(f) Then 'intRootValue guarda el x con f de mayor modulo
intRootValue = X1
xl = X2
Swap = fl
fl = f
f = Swap 'f guarda el menor
ElseIf Math.Abs(fl) > Math.Abs(f) Then
intRootValue = X2
xl = X1
Else
MessageManager.Send(Me, New MessageEventArgs("Secant was to the infinite" & vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
For intIterations = 1 To NroIterations
WaitStepping()
If f = fl Then
MessageManager.Send(Me, New MessageEventArgs("Secant was to the infinite" & vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.[Error]))
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
dx = (xl - intRootValue) * f / (f - fl)
xl = intRootValue
fl = f
intRootValue = intRootValue + dx
f = Calc(intRootValue)
If Math.Abs(dx) < intAccuracy Or f = 0 Then
FRSecant = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.[Error]))
End Function
Public Function FRSecant(ByVal g As Graphics, ByVal Calc As OperSingleDelegate) As Single
Return Me.FRSecant(g, Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
'FRSecant method
'1/8/03
Public Function FRSecant(ByVal g As Graphics, ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl As Single, f As Single, fl As Single
Dim Swap As Single, dx As Single
Me.intRootFound = False
f = Calc(X1)
fl = Calc(X2)
If Math.Abs(fl) < Math.Abs(f) Then 'intRootValue guarda el x con f de mayor modulo
intRootValue = X1
xl = X2
Swap = fl
fl = f
f = Swap 'f guarda el menor
ElseIf Math.Abs(fl) > Math.Abs(f) Then
intRootValue = X2
xl = X1
Else
MessageManager.Send(Me, New MessageEventArgs("Secant was to the infinite" & vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
For intIterations = 1 To NroIterations
WaitStepping()
If intEnableAnimation Then
DrawPointMethod(g, intRootValue, f, intIterations, Color.GreenYellow)
DrawPointMethod(g, xl, fl, "", Color.Blue)
DrawLineMethod(g, intRootValue, xl, f, fl)
End If
If f = fl Then
MsgBox("Secant go to infinite", vbCritical, "Error")
Exit Function
End If
dx = (xl - intRootValue) * f / (f - fl)
xl = intRootValue
fl = f
intRootValue = intRootValue + dx
f = Calc(intRootValue)
If Math.Abs(dx) < intAccuracy Or f = 0 Then
FRSecant = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.[Error]))
End Function
#End Region
#Region "Newton Raphson methods"
Public Function FRNewtonRaphson(ByVal Calc As OperSingleDelegate, ByVal Derivade As OperBinDelegate) As Single
Return FRNewtonRaphson(Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc, Derivade)
End Function
Public Function FRNewtonRaphson(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate, ByVal Derivade As OperBinDelegate) As Single
Dim f As Single
Dim df, dx As Single
Me.intRootFound = False
intRootValue = 0.5 * (X1 + X2)
For intIterations = 1 To NroIterations
df = Derivade(intRootValue, intAccuracy)
If df = 0 Then
MessageManager.Send(Me, New MessageEventArgs("A point have 0 as derivade" & vbCr & "The tangent line go to infinite" & _
vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
WaitStepping()
f = Calc(intRootValue)
dx = f / df
intRootValue = intRootValue - dx
If (X1 - intRootValue) * (intRootValue - X2) < 0 Then
MessageManager.Send(Me, New MessageEventArgs("Jumped out of brackets in rtnewt", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
If Math.Abs(dx) < intAccuracy Then
Me.intRootFound = True
FRNewtonRaphson = intRootValue
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
End Function
Public Function FRNewtonRaphson(ByVal g As Graphics, ByVal Calc As OperSingleDelegate, ByVal Derivade As OperBinDelegate) As Single
Return FRNewtonRaphson(g, Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc, Derivade)
End Function
'Newton Raphson method
'1/8/03
Public Function FRNewtonRaphson(ByVal g As Graphics, ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate, ByVal Derivade As OperBinDelegate) As Single
Dim f As Single
Dim df, dx As Single
Me.intRootFound = False
intRootValue = 0.5 * (X1 + X2)
For intIterations = 1 To NroIterations
df = Derivade(intRootValue, intAccuracy)
If df = 0 Then
MessageManager.Send(Me, New MessageEventArgs("A point have 0 as derivade" & vbCr & "The tangent line go to infinite" & _
vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
WaitStepping()
f = Calc(intRootValue)
If intEnableAnimation Then
DrawTangentMethod(g, intRootValue, f, df, False)
DrawPointMethod(g, intRootValue, f, intIterations, Color.GreenYellow)
End If
dx = f / df
intRootValue = intRootValue - dx
If (X1 - intRootValue) * (intRootValue - X2) < 0 Then
MessageManager.Send(Me, New MessageEventArgs("Jumped out of brackets in rtnewt", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
If Math.Abs(dx) < intAccuracy Then
Me.intRootFound = True
FRNewtonRaphson = intRootValue
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
End Function
#End Region
#Region "Newton Raphson Safe Method"
Public Function FRNewtonRaphsonSafe(ByVal Calc As OperSingleDelegate, _
ByVal Derivade As OperBinDelegate) As Single
Return FRNewtonRaphsonSafe(Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc, Derivade)
End Function
Public Function FRNewtonRaphsonSafe(ByVal X1 As Single, _
ByVal X2 As Single, _
ByVal Calc As OperSingleDelegate, _
ByVal Derivade As OperBinDelegate) As Single
Dim f As Single, fl As Single, fh As Single
Dim temp As Single, xl As Single, xh As Single
Dim df As Single, dx As Single, dXOld As Single
intIterations = 0
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
If (fl > 0 And fh > 0) Or (fl < 0 And fh < 0) Then
MessageManager.Send(Me, New MessageEventArgs("Jumped out of brackets in rtnewt", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
If fl = 0 Then
FRNewtonRaphsonSafe = X1
Exit Function
End If
If fh = 0 Then
FRNewtonRaphsonSafe = X2
Exit Function
End If
If fl < 0 Then
xl = X1
xh = X2
Else
xh = X1
xl = X2
End If
intRootValue = 0.5 * (X1 + X2)
dXOld = Math.Abs(X2 - X1)
dx = dXOld
df = Derivade(intRootValue, intAccuracy)
f = Calc(intRootValue)
For intIterations = 1 To NroIterations
If ((intRootValue - xh) * df - f) * ((intRootValue - xl) * df - f) > 0 Or Math.Abs(2 * f) > Math.Abs(dXOld * df) Then
dXOld = dx
dx = 0.5 * (xh - xl)
intRootValue = xl + dx
If xl = intRootValue Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
ElseIf df = 0 Then
MessageManager.Send(Me, New MessageEventArgs("A point have 0 as derivade" & vbCr & "The tangent line go to infinite" & _
vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.Info))
Exit Function
Else
dXOld = dx
dx = f / df
temp = intRootValue
intRootValue = intRootValue - dx
If temp = intRootValue Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
End If
If Math.Abs(dx) < intAccuracy Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
df = Derivade(intRootValue, intAccuracy)
f = Calc(intRootValue)
If f < 0 Then
xl = intRootValue
Else
xh = intRootValue
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
End Function
Public Function FRNewtonRaphsonSafe(ByVal g As Graphics, _
ByVal Calc As OperSingleDelegate, _
ByVal Derivade As OperBinDelegate) As Single
Return FRNewtonRaphsonSafe(g, Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc, Derivade)
End Function
'Newton Raphson and bisection Safe method
'1/8/03
'2/8/03
Public Function FRNewtonRaphsonSafe(ByVal g As Graphics, _
ByVal X1 As Single, _
ByVal X2 As Single, _
ByVal Calc As OperSingleDelegate, _
ByVal Derivade As OperBinDelegate) As Single
Dim f As Single, fl As Single, fh As Single
Dim temp As Single, xl As Single, xh As Single
Dim df As Single, dx As Single, dXOld As Single
intIterations = 0
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
If (fl > 0 And fh > 0) Or (fl < 0 And fh < 0) Then
MessageManager.Send(Me, New MessageEventArgs("Jumped out of brackets in rtnewt", MessageEventArgs.EMessageType.Warning))
Exit Function
End If
If fl = 0 Then
FRNewtonRaphsonSafe = X1
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
If fh = 0 Then
FRNewtonRaphsonSafe = X2
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
If fl < 0 Then
xl = X1
xh = X2
Else
xh = X1
xl = X2
End If
intRootValue = 0.5 * (X1 + X2)
dXOld = Math.Abs(X2 - X1)
dx = dXOld
df = Derivade(intRootValue, intAccuracy)
f = Calc(intRootValue)
For intIterations = 1 To NroIterations
WaitStepping()
If intEnableAnimation Then
DrawPointMethod(g, intRootValue, f, intIterations, Color.Green)
DrawTangentMethod(g, intRootValue, f, df, False)
End If
If ((intRootValue - xh) * df - f) * ((intRootValue - xl) * df - f) > 0 Or Math.Abs(2 * f) > Math.Abs(dXOld * df) Then
dXOld = dx
dx = 0.5 * (xh - xl)
intRootValue = xl + dx
If xl = intRootValue Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
If EnableAnimation Then
DrawPointMethod(g, xl, fl, intIterations, Color.Blue)
End If
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
ElseIf df = 0 Then
MessageManager.Send(Me, New MessageEventArgs("A point have 0 as derivade" & vbCr & "The tangent line go to infinite" & _
vbCr & "Change the limits and try again", MessageEventArgs.EMessageType.Info))
Exit Function
Else
dXOld = dx
dx = f / df
temp = intRootValue
intRootValue = intRootValue - dx
If temp = intRootValue Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
If intEnableAnimation Then
DrawPointMethod(g, xl, fl, intIterations, Color.Blue)
End If
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
End If
If Math.Abs(dx) < intAccuracy Then
FRNewtonRaphsonSafe = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
df = Derivade(intRootValue, intAccuracy)
f = Calc(intRootValue)
If f < 0 Then
xl = intRootValue
Else
xh = intRootValue
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
End Function
#End Region
#Region "Ridders methods"
Public Function FRRidders(ByVal Calc As OperSingleDelegate) As Single
Return Me.FRRidders(Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc)
End Function
Public Function FRRidders(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl, fl As Single
Dim xh, fh As Single
Dim xm, xnew As Single
Dim s, fm, fnew As Single
Const Unused As Single = -1.11E+30
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
intIterations = 0
If ((fl > 0 And fh < 0) Or (fl < 0 And fh > 0)) Then
xl = X1
xh = X2
intRootValue = Unused
For intIterations = 1 To NroIterations
xm = 0.5 * (xl + xh)
fm = Calc(xm)
s = fm * fm - fl * fh
If s < 0 Then
s = -s
End If
s = Math.Sqrt(s)
If s = 0 Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
If fl >= fh Then
xnew = xm + (xm - xl) * fm / s
Else
xnew = xm - (xm - xl) * fm / s
End If
If Math.Abs(xnew - intRootValue) <= intAccuracy Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
intRootValue = xnew
fnew = Calc(intRootValue)
If fnew = 0 Then
FRRidders = intRootValue
Me.intRootFound = True
Exit Function
End If
If Math.Sign(fnew) <> Math.Sign(fm) Then
xl = xm
fl = fm
xh = intRootValue
fh = fnew
ElseIf Math.Sign(fnew) <> Math.Sign(fl) Then
xh = intRootValue
fh = fnew
ElseIf Math.Sign(fnew) <> Math.Sign(fh) Then
xl = intRootValue
fl = fnew
Else
MessageManager.Send(Me, New MessageEventArgs("Never get here", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If Math.Abs(xh - xl) <= intAccuracy Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
Else
If fl = 0 Then
FRRidders = X1
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
ElseIf fh = 0 Then
FRRidders = X2
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
Else
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
End If
End Function
Public Function FRRidders(ByVal g As Graphics, ByVal Calc As OperSingleDelegate) As Single
Return FRRidders(g, Me.intDefaultRange.Min, Me.intDefaultRange.Max, Calc)
End Function
'Ridders method
'1/8/03
Public Function FRRidders(ByVal g As Graphics, ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim xl, fl As Single
Dim xh, fh As Single
Dim xm, xnew As Single
Dim s, fm, fnew As Single
Const Unused As Single = -1.11E+30
intIterations = 0
Me.intRootFound = False
fl = Calc(X1)
fh = Calc(X2)
If ((fl > 0 And fh < 0) Or (fl < 0 And fh > 0)) Then
xl = X1
xh = X2
intRootValue = Unused
For intIterations = 1 To NroIterations
WaitStepping()
xm = 0.5 * (xl + xh)
fm = Calc(xm)
s = fm * fm - fl * fh
If s < 0 Then
s = -s
End If
s = Math.Sqrt(s)
If s = 0 Then
FRRidders = intRootValue
Me.intRootFound = True
If intEnableAnimation Then
DrawPointMethod(g, xl, fl, intIterations, Color.Blue)
End If
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
If fl >= fh Then
xnew = xm + (xm - xl) * fm / s
Else
xnew = xm - (xm - xl) * fm / s
End If
If Math.Abs(xnew - intRootValue) <= intAccuracy Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
intRootValue = xnew
fnew = Calc(intRootValue)
If intEnableAnimation Then
DrawPointMethod(g, xnew, fnew, intIterations, Color.Green)
End If
If fnew = 0 Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
If Math.Sign(fnew) <> Math.Sign(fm) Then
xl = xm
fl = fm
xh = intRootValue
fh = fnew
ElseIf Math.Sign(fnew) <> Math.Sign(fl) Then
xh = intRootValue
fh = fnew
ElseIf Math.Sign(fnew) <> Math.Sign(fh) Then
xl = intRootValue
fl = fnew
Else
MessageManager.Send(Me, New MessageEventArgs("Never get here", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If Math.Abs(xh - xl) <= intAccuracy Then
FRRidders = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
MessageManager.Send(Me, New MessageEventArgs("Maximun number of iterations exceeded", MessageEventArgs.EMessageType.Warning))
Else
If fl = 0 Then
FRRidders = X1
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
ElseIf fh = 0 Then
FRRidders = X2
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
Else
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
End If
End Function
#End Region
#Region "Bisection methods"
Public Function FRbisection(ByVal Calc As OperSingleDelegate) As Single
Return FRbisection(Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
Public Function FRbisection(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim dx, f, fmid As Single
Dim xmid As Single
Me.intRootFound = False
intIterations = 0
f = Calc(X1)
fmid = Calc(X2)
If f * fmid >= 0 Then
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection Method", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If f < 0 Then
dx = X2 - X1
intRootValue = X1
Else
dx = X1 - X2
intRootValue = X2
End If
For intIterations = 0 To NroIterations
WaitStepping()
dx = dx * 0.5
xmid = intRootValue + dx
fmid = Calc(xmid)
If fmid <= 0 Then intRootValue = xmid
If Math.Abs(dx) < intAccuracy Or fmid = 0 Then
FRbisection = intRootValue
Me.intRootFound = True
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
End Function
Public Function FRbisection(ByVal g As Graphics, ByVal Calc As OperSingleDelegate) As Single
Return FRbisection(g, Me.intDefaultRange.Min, intDefaultRange.Max, Calc)
End Function
'bisection method
'1/8/03
Public Function FRbisection(ByVal g As Graphics, ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Single
Dim dx, f, fmid As Single
Dim xmid As Single
Me.intRootFound = False
intIterations = 0
f = Calc(X1)
fmid = Calc(X2)
If f * fmid >= 0 Then
MessageManager.Send(Me, New MessageEventArgs("Roots must be bracketed for bisection Method", MessageEventArgs.EMessageType.[Error]))
Exit Function
End If
If f < 0 Then
dx = X2 - X1
intRootValue = X1
Else
dx = X1 - X2
intRootValue = X2
End If
For intIterations = 0 To NroIterations
WaitStepping()
dx = dx * 0.5
xmid = intRootValue + dx
fmid = Calc(xmid)
If intEnableAnimation Then
DrawPointMethod(g, xmid, fmid, intIterations, Color.Green)
End If
If fmid <= 0 Then intRootValue = xmid
If Math.Abs(dx) < intAccuracy Or fmid = 0 Then
FRbisection = intRootValue
Me.intRootFound = True
If EnableAnimation Then
DrawPointMethod(g, intRootValue, fmid, intIterations, Color.Green)
End If
RaiseEvent RootFound(Me, New EventArgs)
Exit Function
End If
Next
End Function
#End Region
#End Region
#Region "Brackets Methods"
''' <summary>
''' Busca intervalos que contienen ra�ces en la funci�n dada, utilizando
''' el rango y especificaciones internas de la instancia
''' </summary>
''' <param name="Ranges"></param>
''' <param name="Calc"></param>
''' <remarks></remarks>
Public Sub BrackedIn(ByVal Ranges() As RangeF, ByVal Calc As OperSingleDelegate)
Me.BrackedIn(Ranges, Me.intBracketSteps, Me.intBracketIterations, Calc)
End Sub
''' <summary>
''' Given a function fx defined on the interval from x1-x2 subdivide the interval into n equally
''' spaced segments, and search for zero crossings of the function. nb is input as the maximum number
''' of roots sought, and is reset to the number of bracketing pairs xb1[1..nb], xb2[1..nb]
''' that are found.
''' retorna 1 si acota a la singularidad
''' </summary>
''' <param name="Ranges"></param>
''' <param name="Steps"></param>
''' <param name="MaxIterations"></param>
''' <param name="Calc"></param>
''' <remarks></remarks>
Public Sub BrackedIn(ByVal Ranges() As RangeF, _
ByVal Steps As Integer, _
ByVal MaxIterations As Integer, _
ByVal Calc As OperSingleDelegate)
Dim j As Integer, dx As Single, nbb As Integer
Dim x As Single, fp As Single, fc As Single
nbb = 0
dx = Ranges(0).dx / Steps
x = Ranges(0).Min
fp = Calc(x)
For j = 1 To Steps
x = x + dx
fc = Calc(x)
If fc * fp <= 0 Then
ReDim Preserve ARanges(nbb)
ARanges(nbb).Min = x - dx
ARanges(nbb).Max = x
nbb = nbb + 1
If MaxIterations = nbb Then
Ranges = ARanges
Exit Sub
End If
End If
fp = fc
Next j
Ranges = ARanges
MaxIterations = nbb
End Sub
Public Function BrackedOut(ByVal R As RangeF, ByVal Calc As OperSingleDelegate) As Boolean
Return BrackedOut(R.Min, R.Max, Calc)
End Function
''' <summary>
''' Given a function func and an initial guessed range x1 to x2, the routine expands the range
''' geometrically until a root is bracketed by the returned values x1 and x2 (in which case zbrac
''' returns 1) or until the range becomes unacceptably large (in which case zbrac returns 0).
''' false si hay un error
''' </summary>
''' <param name="X1"></param>
''' <param name="X2"></param>
''' <param name="Calc"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function BrackedOut(ByVal X1 As Single, ByVal X2 As Single, ByVal Calc As OperSingleDelegate) As Boolean
If X1 = X2 Then
MessageManager.Send(Me, New MessageEventArgs("Bad Initial Range, Correct and try Again", MessageEventArgs.EMessageType.[Error]))
Return False
End If
Dim j As Integer, f1 As Single, f2 As Single
f1 = Calc(X1)
f2 = Calc(X2)
For j = 1 To Ntry
If f1 * f2 < 0 Then
ReDim ARanges(0)
ARanges(0) = New RangeF(X1, X2)
Return True
End If
If Math.Abs(f1) < Math.Abs(f2) Then
X1 = X1 + Factor * (X1 - X2)
f1 = Calc(X1)
Else
X2 = X2 + Factor * (X2 - X1)
f2 = Calc(X2)
End If
Next j
Return False
End Function
#End Region
End Class