I have this code from an old book that does not work in my Excel. It is supposed to calculate the slope and intercept of a Deming regression from a range of numbers, x and y
Function Deming(XValues, YValues)
Dim MeanX(), MeanY()
Ncells = XValues.Count
ReDim MeanX(Ncells / 2), MeanY(Ncells / 2)
For x = 2 To Ncells Step 2
MeanX(x / 2) = (XValues(x - 1) + XValues(x)) / 2
MeanY(x / 2) = (YValues(x - 1) + YValues(x)) / 2
SumX = SumX + MeanX(x / 2): SumY = SumY + MeanY(x / 2)
SumX2 = SumX2 + (MeanX(x / 2)) ^ 2
SumY2 = SumY2 + (MeanY(x / 2)) ^ 2
SumXY = SumXY + MeanX(x / 2) * MeanY(x / 2)
SumDeltaX2 = SumDeltaX2 + (XValues(x - 1) - XValues(x)) ^ 2
SumDeltaY2 = SumDeltaY2 + (YValues(x - 1) - YValues(x)) ^ 2
Next
XBar = SumX / N: YBar = SumY / N
Sx2 = (N * SumX2 - SumX ^ 2) / (N * (N - 1))
Sy2 = (N * SumY2 - SumY ^ 2) / (N * (N - 1))
Sdx2 = SumDeltaX2 / (2 * N)
Sdy2 = SumDeltaY2 / (2 * N)
rPearson = (N * SumXY - SumX * SumY) / Sqr((N * SumX2 - SumX ^ 2) * (N *
SumY2 - SumY ^ 2))
lambda = Sdx2 / Sdy2
U = (Sy2 - Sx2 / lambda) / (2 * rPearson * Sqr(Sx2) * Sqr(Sy2))
Slope = U + Sqr(U ^ 2 + 1 / lambda)
Intercept = YBar - Slope * XBar
Deming = Array(Slope, Intercept)
End Function
Does this have a bad syntax or not?
First this is not old code, this is simply bad code.
Anything in VBA, which does not compile, when someone writes Option Explicit on the top of the Module/Worksheet is a bad syntax. This is a rule of a thumb. And in the case of the code, if this one is pasted to the editor the following line is red:
rPearson = (N * SumXY - SumX * SumY) / Sqr((N * SumX2 - SumX ^ 2) * (N *
SumY2 - SumY ^ 2))
This is because it should be in 1 line, and not in 2.
So, concerning the question - how to update it - as a first step, make sure the code compiles with Option Explicit on top (Option Explicit statement). So, write Option Explicit and then go to Debug>Compile on the VBEditor's ribbon. VBeditor will highlight the problem. The first one is that Ncell is not defined:
Then find a way to define it, e.g. write Dim Ncells as Variant or as anything else you may consider useful on the top of the highligted line. It could be that just declaring a variable is not enough, as there is a calculation XBar = SumX / N in the code. There, N should be declared and assigned to a value. If it is only declared, it will be 0, and then a division by 0 will be an error. Thus, probably something like this should be written, depending on the logic: Dim N as Double: N = 1
Related
I just wrote this code to perform an iterative calculation. It finds the X,Y coordinates where an unknown parabola is tangent to a known circle. It is based on other iterative functions I've written that have worked flawlessly. I'm stumped as to what the issue is. Here is the code:
Public Function Jext(PA As Double, Xcl As Double, Ycl As Double, Ctr As Double, Rnl As Double, Finl As Double) As Double
Pi = 3.14159265358979
tol = 0.00000001
Dim x(20) As Double
Dim Yc(20) As Double
Dim Yp(20) As Double
Dim A(20) As Double
Dim Diff(20) As Double
Dim It As Integer
Dim hF As Double
Dim Sf As Double
'Xcl is the horizontal position of the root radius center line
'Ycl is the vertical position of the root radius center line
'Ctr is root radius. It's an approximation of the trochoid and is typically the cutter tip radius
'Rnl is the radius to the point where the load line intersects the tooth centerline. It is the apex of the parabola
'x is the horizontal position that is common to the parabola and circle. It is the independent variable
'Yc is the vertical position on the circle at point x
'Yp is the vertical position on the parabola at point x
'A is the leading term of the parabolic equation
'Diff is the calculated difference in vertical positions of circle and parabola
'Set initial guess values. x(0) is 5% of the radius (left edge of circle) and x(1) is 95% of the radius(bottom of the circle)
x(0) = (Xcl - Ctr) + 0.05 * Ctr
x(1) = (Xcl - Ctr) + 0.95 * Ctr
Yc(0) = Ycl - (Ctr ^ 2 - (x(0) - Xcl) ^ 2) ^ 0.5
Yc(1) = Ycl - (Ctr ^ 2 - (x(1) - Xcl) ^ 2) ^ 0.5
A(0) = Tan(WorksheetFunction.Acos((Xcl - x(0)) / Ctr) + Pi / 2) / (2 * x(0))
A(1) = Tan(WorksheetFunction.Acos((Xcl - x(1)) / Ctr) + Pi / 2) / (2 * x(1))
Yp(0) = A(0) * x(0) ^ 2 + Rnl
Yp(1) = A(1) * x(1) ^ 2 + Rnl
Diff(0) = Yp(0) - Yc(0)
Diff(1) = Yp(1) - Yc(1)
For It = 1 To 19 Step 1
x(It + 1) = x(It) - (Diff(It) - 0) * (x(It - 1) - x(It)) / (Diff(It - 1) - Diff(It))
Yc(It + 1) = Ycl - (Ctr ^ 2 - (x(It + 1) - Xcl) ^ 2) ^ 0.5
A(It + 1) = Tan(WorksheetFunction.Acos((Xcl - x(It + 1)) / Ctr) + Pi / 2) / (2 * x(It + 1))
Yp(It + 1) = A(It + 1) * x(It + 1) ^ 2 + Rnl
Diff(It + 1) = Yp(It + 1) - Yc(It + 1)
If Abs(Diff(It + 1)) < tol Then Exit For
Debug.Print Diff(It + 1)
Next It
hF = Rnl - Yp(t + 1)
Sf = 2 * x(t + 1)
Jext = 1 / (Cos(Finl) / Cos(PA) * (6 * hF / Sf ^ 2 - Tan(Finl) / Sf))
End Function
I put a stop at the "Next It" line to check the values as it went through the iterative loops. When I execute the code, all of the values are as expected and the value of Abs(Diff(It+1)) is not small enough to exit the for loop in the IF statement. I put the Debug.Print statement in there to make sure it was getting that far in the code and it did print Diff(It+1). So it executes everything to that point. Then when I continue the function it just stops and returns a #VALUE error in the spreadsheet. I've no idea why it won't continue the for loop. Anyone see something I've missed?
I am looking at VBA code (function) written by someone else.
Here is the code:
Function EuropeanDelta(StrikePrice, MarketPrice, Volatility, InterestRate As Double, PC As String, ValueDate, ExpiryDate As Date, Optional PriceOrYield As String = "P") As Double
Rem Declare our working variables
Dim r As Double
Dim d1 As Double
Dim d2 As Double
Dim t As Double
Dim SqT As Double
Rem End of variable declaration
If PriceOrYield = "Y" Then
MarketPrice = 100 - MarketPrice
StrikePrice = 100 - StrikePrice
If PC = "C" Then
PC = "P"
Else
PC = "C"
End If
End If
Rem Initiase our working variables
t = (ExpiryDate - ValueDate) / 365
SqT = Sqr(t)
r = Application.WorksheetFunction.Ln(1 + InterestRate)
d1 = (Application.WorksheetFunction.Ln(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * SqT)
Rem Quick logic to deal with Calls or Puts
If PC = "C" Then
EuropeanDelta = Exp(-r * t) * Application.WorksheetFunction.NormSDist(d1)
Else
EuropeanDelta = -Exp(-r * t) * Application.WorksheetFunction.NormSDist(-d1)
End If
If PriceOrYield = "Y" Then
EuropeanDelta = EuropeanDelta * -1
End If
End Function
The whole problem is based around the line for "d1". I would like to re-organise to solve for "StrikePrice". I have tried writing it out mathematically and then re-arranging, then swapping back to VBA.
#duffymo is correct, but am giving the answer directly in terms of VBA code
' d1 = (Log(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * Sqr(t))
'
' Volatility * Sqr(t) * d1 = Log(MarketPrice / StrikePrice) + Volatility^2 * t/2
'
' Log(MarketPrice / StrikePrice) = Volatility * Sqr(t) * d1 - Volatility^2 * t/2
'
' MarketPrice / StrikePrice = Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
'
StrikePrice = MarketPrice / Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
Other Notes :
For brevity replace Application.WorksheetFunction.Ln() with Log()
There is no need cache SqT = Sqr(t) since it is only used once.
For clarity replace Volatility*Volatility with Volatility^2 as internally it does the same thing.
This is just algebra - high school math.
Take it in steps. Make sure you do the same operation to both sides to make sure that equality still holds.
Here's your starting equation:
d = {ln(m/s) + v*v*t/2}/(v*sqrt(t))
Multiply both sides by the denominator of the RHS:
d*v*sqrt(t) = ln(m/s) + v*v*t/2
Subtract v*v*t/2 from both sides:
(d*v*sqrt(t) - v*v*t/2) = ln(m/s)
Apply the exponential function to both sides, noting that exp(ln(x)) = x:
exp(d*v*sqrt(t) - v*v*t/2) = m/s
Multiply both sides by s:
s*exp(d*v*sqrt(t) - v*v*t/2) = m
Divide both sides by exp(d*v*sqrt(t) - v*v*t/2) to get the desired result:
s = m/exp(d*v*sqrt(t) - v*v*t/2)
Let's see if this function makes sense.
At t = 0 the denominator exp(0) = 1, so the strike price is equal to the market price.
As t -> infinity, we hope that the denominator gets large so s -> zero. L'Hospital's Rule will help here.
I tried to use erfc but it says argument not optional.
An example is given below
For j = 0 To 150
f = 1
For m = 1 To j
f = f * m
Next
Application.WorksheetFunction.Erf = (Application.WorksheetFunction.Erf) + (-1) ^ j * b ^ (2 * j + 1) / ((2 * j + 1) * f)
Next
Application.WorksheetFunction.ErfC = 1 - 2 / Sqr(3.14) * Application.WorksheetFunction.Erf
MsgBox (Application.WorksheetFunction.ErfC)
xf1 = (wa + 2 * sp) * q / (4 * cl ^ 2 * 3.14 * hf)
xf2 = Exp(b ^ 2) * Application.WorksheetFunction.ErfC
xf3 = 2 * b / Sqr(3.14) - 1
xf = xf1 * (xf2 + xf3)
According to the MSDN documentation at least one parameter needs to be passed to the Erf method:
Name Required/Optional Data Type Description
Arg1 Required Variant Lower_limit - the lower bound for integrating ERF.
Arg2 Optional Variant Upper_limit - the upper bound for integrating ERF.
If omitted, ERF integrates between zero and
lower_limit.
Therefore, calling it with zero parameters (e.g. Application.WorksheetFunction.Erf) will give you an "argument not optional" error.
You also won't be able to set Erf to a value, i.e.
Application.WorksheetFunction.Erf = ...
is invalid.
I have created a function via vba and I have used this function to make an iterative table. I have set the workbook calculation to automatic and it all works fine but when I open the excel file, the cells that contain the mentioned function, give me #name error and everytime I need to recalculate. Is there a way to fix this?
Public Function FrictionFactor(relativeroughness, reynoldsnumber)
'Dim relativeroughness, reynoldsnumber As Double
fNext = 0.005 ' initial value for f
fIncrement = 0.005 ' initial step size
Convergence = 0.000001 ' sets the decimal place accuracy of the result
Do
fStart = fNext
LHSColebrookStart = 1 / (fStart ^ 0.5)
RHSColebrookStart = -2 * (Log((relativeroughness / 3.7) + (2.51 / (reynoldsnumber * (fStart ^ 0.5)))) / Log(10))
DifferenceStart = LHSColebrookStart - RHSColebrookStart
fNext = fStart + fIncrement
LHSColebrookNext = 1 / (fNext ^ 0.5)
RHSColebrookNext = -2 * (Log((relativeroughness / 3.7) + (2.51 / (reynoldsnumber * (fNext ^ 0.5)))) / Log(10))
DifferenceNext = LHSColebrookNext - RHSColebrookNext
If DifferenceStart * DifferenceNext < 0 Then ' march f in opposite direction and more slowly
fIncrement = fIncrement / -10
ElseIf DifferenceStart * DifferenceNext = 0 Then ' done
fIncrement = 0
End If ' keep marching f in same direction and at same rate
Loop While Abs(fStart - fNext) > Convergence
FrictionFactor = fStart
End Function
The usual reason this happens is that macros are not enabled when the workbook is opened. Check your Security settings.
I'm writing a simple 2D top-down game in Python 3 using tkinter. All the collidable objects are either circles/arcs or lines. I wrote the following method to detect when a circle hits a line:
I am using the formulas y = mx + b and r^2 = (x-h)^2 + (y-k)^2
def CheckHitCToL(self, LX0, LY0, LX1, LY1, CX0, CX1, Tab):
try:
H = self.Creatures[Tab].X
K = self.Creatures[Tab].Y
R = abs((CX0 - CX1) / 2)
M = (LY0 - LY1) / (LX0 - LX1)
B = M * (-LX1) + LY1
QA = (M * M) + 1
QB = (-H - H) + (((B - K) * M) * 2)
QC = (H * H) + ((B - K) * (B - K)) - (R * R)
X = (- QB + sqrt((QB * QB) - (4 * QA * QC))) / (2 * QA)
Y = (M * X) + B
if ((X <= LX0 and X >= LX1) or (X >= LX0 and X <= LX1)) and ((Y <= LY0 and Y >= LY1) or (Y >= LY0 and Y <= LY1)):
return True
else:
return False
except:
return False
My problem is when you have a vertical line, M (Or the slope) is (LY0 - LY1) / 0. (This is because the slope is equal to rise/run, and vertical lines don't have a run, just a rise) Which of course returns an error, caught by try except, which then informs my movement method that no collision has taken place. Of course I can simply move the "try:" down a few lines, but it's still going to throw an error. How can I adapt this program to not throw an error when working with a vertical line?
Well, the most obvious method would involve using if( (LX0 - LX1)==0 ) and doing this case separately. In such cases, you need to check whether distance between LX0 and CX0 is equal to the radius of circle.
You can use another forms of line equation -
implicit A*x + B*y + C = 0
or parametric x = LX0 + t * (LX1 - LX0), y = LY0 + t *(LY1 - LY0)
with appropriate modification of calculations