Maybe a simple question but I still need some help with a formula clarification:
Could somebody help me with this:
TempCalc = CInt(TextBox3.Value) * (16*POWER(SQRT(CInt(TextBox1.Value)*(1-CInt(Textbox1.Value)))/(CInt(TextBox1.Value)*CInt(TextBox2.Value);2))
what is wrong, is the syntax totally off?
Thanks in advance
The function POWER and SQRT do not exist in VBA.
Power(x, y) can be replaced with x ^ y
sqrt is sqr in VBA
So the following should work:
TempCalc = CLng(TextBox3.Value) * (16 * ((Sqr(CLng(TextBox1.Value) * 1 - CLng(TextBox1.Value))) / (CLng(TextBox1.Value) * CLng(TextBox2.Value))) ^ 2)
And I recommend to convert the integers to Long using CLng as there is no benefit in using Integer.
So to make it easier to debug I recommend to split the calculation:
Dim SqrtVal As Double
SqrtVal = Sqr(CLng(TextBox1.Value) * 1 - CLng(TextBox1.Value))
Dim DivVal As Double
DivVal = (CLng(TextBox1.Value) * CLng(TextBox2.Value))
Dim PowerVal As Double
PowerVal = (SqrtVal / DivVal) ^ 2
Dim TempCalc As Double
TempCalc = CLng(TextBox3.Value) * 16 * PowerVal
I've done some research and the general advice is changing the datatype of the variable holding the expression to Long or Ulong but in either case, I'm still getting the same error. I also tried enclosing the expression with CInt() (or CLong()) to force it to cut out it's decimal portion to reduce the length of the output of the expression but neither is working. It's all pretty confusing. Any help will be deeply appreciated. The code block triggering the error is as follows;
Vsf(i) = CInt((((0.91544 - 0.00166 * Angle(i) - 0.000002 * W - 0.054248 *
Superelevation(i) - Sidefrictionfactor) / 0.013939) * Radius(i)) ^ 0.5)
Vro(i) = CInt((((1.04136 - 0.004528 * Angle(i) - 0.000004 * W - 0.338711 * Superelevation(i) - rolloverthreshold) / 0.014578) * Radius(i)) ^ 0.5)
Vmin(i) = CInt(Math.Min(Vsf(i), Vro(i)))
I declared VSf(), Vro() and Vmin() all as integer arrays. I even enclosed the computation expression in a CInt() in hopes that it would convert the result of Vro (which was triggering the arithmetic overflow error) to an integer and hence not have to deal with decimals which would lead to more digits. Yet when I hover over Vro(i), I see a 4 digit integer with decimals. Not sure why that's happening.
I broke the formula down to try and see where the problem was occurring. Everything buzzed along until the very end. If the value to be raised to .5 is a negative number, the square root does not produce a number. I would perform the steps of the formula without the ^.5 and then check for a negative number.
Private Sub OPCode()
Dim Angle = 90.2
Dim Radius = 100.2
Dim Superelevation = 37.8
Dim Sidefrictionfactor = 0.003
Dim W = 0.00325
Dim Vsf As Double
Dim AngleMultiplication = 0.00166 * Angle
Dim WMultiplication = 0.000002 * W
Dim SuperelavationMultiplication = 0.054248 * Superelevation
Dim SubtractResult = 0.91544 - AngleMultiplication - WMultiplication - SuperelavationMultiplication - Sidefrictionfactor
Dim DivisionResult = SubtractResult / 0.013939
Dim MultiplyByRadius = DivisionResult * Radius
Debug.Print(MultiplyByRadius.ToString) 'With my made up values I get a negative number
Vsf = MultiplyByRadius ^ 0.5 'You cannot get the square root of a negative number
Debug.Print(Vsf.ToString) 'NaN
Dim intVsf = CInt(Vsf) 'The Arithematic overflow error occurs here
End Sub
Please bear with me I´m a newbie in programming and I´m trying to learn how to rotate a 3D point (XYZ) around 0,0,0 and later I´ll try to improve my code to allow rotation around an arbitrary point (XYZ).
I´m starting with VB and after extensive searches here and in the Web, I could not find an explanation for my problem. I´m an almost 40 years old trying to learn math and programming, so please bear with me because it will take time for me to digest all the math side for these problems.
Basically, I´m trying to write an algorithm to rotate a 3D point, however, while it seems that with some angles my code works, with some others I just get weird funky numbers that are probable correct in some aspect, but I can´t find the flaw in the code. I´ve been looking into this for days and tried multiple approaches, but I´m just not being able to spot the error.
This is the UI for my little app. The original coordinates are entered in the top of the form, and in the bottom of the form I show the rotated coordinates.
Notice that in the image below, a simple rotation of a coordinate of Y10.0 around Z axis by 90 degrees return a correct X value (-10), but Y shows a funky number (6.1230...)... However if I change the rotation angle around Z to 45, the results seems to be correct...
I don´t know what I´m doing wrong to get this weird Y. Because of this error, I´m not trusting in the results of this algorithm at all but I´m currently in a blindspot...
This is the code of the calculate button:
Private Sub BtnCompute_Click(sender As Object, e As EventArgs) Handles BtnCompute.Click
'Capture the values from the text boxes and parse then to doubles
ValidateAllFieldsWithDoubleValues()
'Rotate the coordinates
RotateXYZCoordinates(dblOriginalCoordX, dblOriginalCoordY, dblOriginalCoordZ, dblCurrentRotationAroundX, dblCurrentRotationAroundY, dblCurrentRotationAroundZ)
'Update the text boxes for the rotated coordinates for XYZ
txtResultX.Text = dblResultX.ToString
txtResultY.Text = dblResultY.ToString
txtResultZ.Text = dblResultZ.ToString
End Sub
And this is the code of the function that calculates the rotations:
Private Function RotateXYZCoordinates(ByVal XCoord As Double, ByVal YCoord As Double, ByVal ZCoord As Double, ByVal Pitch As Double, ByVal Roll As Double, ByVal Yaw As Double)
'X Rotation
Dim RadPitch As Double = 0
Dim CosPitch As Double = 0
Dim SinPitch As Double = 0
Dim XRotatedAroundX As Double = 0
Dim YRotatedAroundX As Double = 0
Dim ZRotatedAroundX As Double = 0
RadPitch = Pitch * Math.PI / 180
CosPitch = Math.Cos(RadPitch)
SinPitch = Math.Sin(RadPitch)
XRotatedAroundX = XCoord
YRotatedAroundX = YCoord * CosPitch - ZCoord * SinPitch
ZRotatedAroundX = YCoord * SinPitch + ZCoord * CosPitch
'Y Rotation
Dim RadRoll As Double = 0
Dim CosRoll As Double = 0
Dim SinRoll As Double = 0
Dim XRotatedAroundY As Double = 0
Dim YRotatedAroundY As Double = 0
Dim ZRotatedAroundY As Double = 0
RadRoll = Roll * Math.PI / 180
CosRoll = Math.Cos(RadRoll)
SinRoll = Math.Sin(RadRoll)
XRotatedAroundY = ZRotatedAroundX * CosRoll - XRotatedAroundX * SinRoll
YRotatedAroundY = YRotatedAroundX
ZRotatedAroundY = ZRotatedAroundX * SinRoll + XRotatedAroundX * CosRoll
'Z Rotation
Dim RadYaw As Double = 0
Dim CosYaw As Double = 0
Dim SinYaw As Double = 0
Dim XRotatedAroundZ As Double = 0
Dim YRotatedAroundZ As Double = 0
Dim ZRotatedAroundZ As Double = 0
RadYaw = Yaw * Math.PI / 180
CosYaw = Math.Cos(RadYaw)
SinYaw = Math.Sin(RadYaw)
XRotatedAroundZ = XRotatedAroundY * CosYaw - YRotatedAroundY * SinYaw
YRotatedAroundZ = XRotatedAroundY * SinYaw + YRotatedAroundY * CosYaw
ZRotatedAroundZ = ZRotatedAroundY
'Final result
dblResultX = XRotatedAroundZ
dblResultY = YRotatedAroundZ
dblResultZ = ZRotatedAroundZ
Return Nothing
End Function
I know this is not an elegant code but it is what I can code for now... I´d appreciate if someone could take a look at this and point me to the source of error... I´ve been watching videos and did an extensive search in this website before I posted... But it seems some things are still very advanced to me for now... I´m not lazy and I´m willing to learn if someone point me towards something I could digest for now...
If someone could share a hint about how to make this rotate function to support rotation around a point other than 0,0,0 I´d appreciate.
Thank you,
Daniel
The answer is correct. Due to double precision math and a 90 degree rotation there is a limit to the accuracy. The answer is really 6.12303176911189E-16 or .000000000000000612303176911189. Round the number off to a realistic value of decimal points. This is also why 1+1 is not equal to 2 but 1.999999999999999999999999999999 in floating point math.
I need to use Newton's method on closures.
Function f (x as Double, y as Double) as Double
f = x^3-y
End Function
I get the value of y from a cell and then I would like to find out when f is zero. In the toy example above, if the cell contains y=8, then I would expect Newton's method to find a solution close to x=2.
My solution was to make a newton_solve_f function:
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
so in effect, I copy paste my code for Newton's method (taken from here) into newton_solve_f.
The problem is that I have several such fs (some with more than two arguments), and it would be really neat if I didn't have to make a separate almost identical newton_solve_f for every one of them.
How would you solve this in VBA?
In Python, for example, it's possible to solve this problem as follows:
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))
Here f(3) is a function, a closure of one variable. (The closure example on wikipedia is almost identical to this one.)
ps. I know Newton's method also needs the (partial) derivative of f, I'm actually doing something that's more like the secant method, but that's irrelevant for what I'm asking about
Closures are not part of VBA. But you can use static variables within a method scope. They cannot be used outside the method. If you want a variable to visible outside, then you have to use global variable. Preferable declare it public in a module.
We cannot define function inside function in VB. Tried to convert the code given in the link you have mentioned. I hope it helps you. Not well versed with php, but you can see the approach below and make changes accordingly.
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
So to first summarise: You want to create a function that will find (using Newton-Raphson method) the roots of a function. You already have this written and working for certain functions but would like help expanding your code so it will work with a variety of functions with varying numbers of parameters?
I think you first need to think about what input functions you want it to cover. If you are only dealing with polynomials (as your example suggests), this should be fairly straightforward.
You could have general functions of:
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
And just set the inputs to zero when you don't need them (which will be for the majority of the time).
So for your example calling:
answer = fnGeneralCase(guess, 0, 0, -8, 1, 0, 0, 0, 0, 0, 0, 0, 0)
basically gives:
function = x^3-8
If you want to include more than polynomials, this will get more complicated but you could still use the above approach...
This seems to be asking 2 related questions:
how to pass a function as an argument in vba.
how to create a closure out of an existing function.
Unfortunately neither of these are really supported, however,
for 1 you can generally work around this by passing a string function name and using 'Application.Run' to invoke the function.
2 is trickier if you have lots of functions with different numbers of parameters, but for a set number of parameters you could add extra parameters to the newton_solve function or maybe use global variables.
e.g.
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
Assuming f is in a module called 'Module1' you can call this with:
x = newton_solve('Module1.f', 3)
Note that the function you want to call must be public.
VB.NET
My data is coming from an exported DXF file from various cad packages. When a circular arc (defined as a part of a true circle) is exported it is sometimes exported as a bunch of line segments rather than a circular arc.
I have a list of points and I am trying to guess if they were derived from the same circle. Basically I iterate through all the points and use a method to find the center point of a circle from three points. My intention was to compare all the calculated center points generated and make a determination if they are close to each other.
My first thought was that I could check to see if the center points are all equal but they have slight differences between them because of rounding and the underlying estimating routine that generates the point in the first place (I have no control over that).
MY second was to check the standard deviation of the x and y values of the circumference points and compare that against the standard deviation of the x,y of the centers and make some judgement from that. VB.net does not seem to have a native stdev function and I am sometimes a bit lazy.
Does anybody have a simple idea on how to determine if a list of points are all from the same circle?
Here are my functions:
To determine the center of a circle given three points:
Public Function getCenter(p1 As Point2D, p2 As Point2D, p3 As Point2D) As Point2D
Dim yDelta_a As Double = p2.Y - p1.Y
Dim xDelta_a As Double = p2.X - p1.X
Dim yDelta_b As Double = p3.Y - p2.Y
Dim xDelta_b = p3.X - p2.X
Dim center As New Point2D
Dim aSlope As Double = yDelta_a / xDelta_a
Dim bSlope As Double = yDelta_b / xDelta_b
center.X = (aSlope * bSlope * (p1.Y - p3.Y) + bSlope * (p1.X + p2.X) - aSlope * (p2.X + p3.X)) / (2 * (bSlope - aSlope))
center.Y = -1 * (center.X - (p1.X + p2.X) / 2) / aSlope + (p1.Y + p2.Y) / 2
Return center
End Function
And then to iterate the list of points and get a collection of centers. FYI...This function received a list of lines that have endpoints that are points so I do a bit of iterating to get all the correct points.
Public Function MakesCircle(lines As List(Of Line))
Dim points As New List(Of Point2D)
If lines.Count < 2 Then
Return False
Else
//Get points from lines
For i As Int16 = 0 To lines.Count - 2
points.Add(lines(i).StartPoint)
Next
points.Add(lines.Last.StartPoint)
End If
//"Prime the pump" for the center calculation loop
Dim centers As New List(Of Point2D)
Dim a As Point2D = points(0)
Dim b As Point2D = points(1)
Dim c As Point2D = points(2)
//Calc all the centers
For i As Int16 = 3 To lines.Count - 1
centers.Add(getCenter(a, b, c))
a = b
b = c
c = points(i)
Next
//This is where I need logic to determine if the points all actually belong to the same circle
Return True
End Function
You can use a GraphicsPath object to find this out. -not tested-
I figured you would be able to construct a Rectangle Structure based on the data coming in (x,y,w,h) then this make-shift algorithm would do for you.
Private Function areAllPointsInEllipsis(ellipsis As Rectangle, pts() As Point) As Boolean
Dim result As Boolean
Using gp As New System.Drawing.Drawing2D.GraphicsPath
gp.AddEllipsis(ellispsis)
result = pts.All(Function(pt) gp.IsVisible(pt))
End Using
Return result
End Function
What I did was generate all the distances from the average center point to each of the points that make up the circumference. Find the max and min distances. They you can use a threshold of a percentage of the radius - a kind of eccentricity measurement. If the difference between the max and min falls below 1% of the radius then I call it a circle.