My cycle:
For n = 1 To 30000 Step 1
a = m * n
b = delta ^ a
c = f1 ^ (a - 1)
d = WorksheetFunction.Exp(-f1 * delta)
e = WorksheetFunction.Gamma_Dist(f1, a, 1, 1)
konvolucia = (b / e) * c * d
Next n
over the e is displaying
runtime error.'423' - Property or method not found
Can I ask you where the problem is?
As the error message
Property or method not found
tells you, the issue is there is no WorksheetFunction called Exp.
If you are looking for the exp function defined as:
Exp(n) = e raised to the nth power, where e = 2.71828183….
Then use d = Exp(-f1 * delta) instead.
Side note
Gamma_Dist awaits a Boolean as last argument:
Gamma_Dist(Arg1 as Double, Arg2 as Double, Arg3 as Double, Arg4 as Boolean)
So you should use True or False instead of 1 as last argument. In VBA True is -1 and False is 0 so don't use 1 even if anything beside 0 casts to True when converted to Boolean.
Related
I'm trying to write a simple function in VBA that will test a real value and output a string result if it's a perfect cube. Here's my code:
Function PerfectCubeTest(x as Double)
If (x) ^ (1 / 3) = Int(x) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
As you can see, I'm using a simple if statement to test if the cube root of a value is equal to its integer portion (i.e. no remainder). I tried testing the function with some perfect cubes (1, 8, 27, 64, 125), but it only works for the number 1. Any other value spits out the "Flawed" case. Any idea what's wrong here?
You are testing whether the cube is equal to the double supplied.
So for 8 you would be testing whether 2 = 8.
EDIT: Also found a floating point issue. To resolve we will round the decimals a little to try and overcome the issue.
Change to the following:
Function PerfectCubeTest(x As Double)
If Round((x) ^ (1 / 3), 10) = Round((x) ^ (1 / 3), 0) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
Or (Thanks to Ron)
Function PerfectCubeTest(x As Double)
If CDec(x ^ (1 / 3)) = Int(CDec(x ^ (1 / 3))) Then
PerfectCubeTest = "Perfect"
Else
PerfectCubeTest = "Flawed"
End If
End Function
#ScottCraner correctly explains why you were getting incorrect results, but there are a couple other things to point out here. First, I'm assuming that you are taking a Double as input because the range of acceptable numbers is higher. However, by your implied definition of a perfect cube only numbers with an integer cube root (i.e. it would exclude 3.375) need to be evaluated. I'd just test for this up front to allow an early exit.
The next issue you run into is that 1 / 3 can't be represented exactly by a Double. Since you're raising to the inverse power to get your cube root you're also compounding the floating point error. There's a really easy way to avoid this - take the cube root, cube it, and see if it matches the input. You get around the rest of the floating point errors by going back to your definition of a perfect cube as an integer value - just round the cube root to both the next higher and next lower integer before you re-cube it:
Public Function IsPerfectCube(test As Double) As Boolean
'By your definition, no non-integer can be a perfect cube.
Dim rounded As Double
rounded = Fix(test)
If rounded <> test Then Exit Function
Dim cubeRoot As Double
cubeRoot = rounded ^ (1 / 3)
'Round both ways, then test the cube for equity.
If Fix(cubeRoot) ^ 3 = rounded Then
IsPerfectCube = True
ElseIf (Fix(cubeRoot) + 1) ^ 3 = rounded Then
IsPerfectCube = True
End If
End Function
This returned the correct result up to 1E+27 (1 billion cubed) when I tested it. I stopped going higher at that point because the test was taking so long to run and by that point you're probably outside of the range that you would reasonably need it to be accurate.
For fun, here is an implementation of a number-theory based method described here . It defines a Boolean-valued (rather than string-valued) function called PerfectCube() that tests if an integer input (represented as a Long) is a perfect cube. It first runs a quick test which throws away many numbers. If the quick test fails to classify it, it invokes a factoring-based method. Factor the number and check if the multiplicity of each prime factor is a multiple of 3. I could probably optimize this stage by not bothering to find the complete factorization when a bad factor is found, but I had a VBA factoring algorithm already lying around:
Function DigitalRoot(n As Long) As Long
'assumes that n >= 0
Dim sum As Long, digits As String, i As Long
If n < 10 Then
DigitalRoot = n
Exit Function
Else
digits = Trim(Str(n))
For i = 1 To Len(digits)
sum = sum + Mid(digits, i, 1)
Next i
DigitalRoot = DigitalRoot(sum)
End If
End Function
Sub HelperFactor(ByVal n As Long, ByVal p As Long, factors As Collection)
'Takes a passed collection and adds to it an array of the form
'(q,k) where q >= p is the smallest prime divisor of n
'p is assumed to be odd
'The function is called in such a way that
'the first divisor found is automatically prime
Dim q As Long, k As Long
q = p
Do While q <= Sqr(n)
If n Mod q = 0 Then
k = 1
Do While n Mod q ^ k = 0
k = k + 1
Loop
k = k - 1 'went 1 step too far
factors.Add Array(q, k)
n = n / q ^ k
If n > 1 Then HelperFactor n, q + 2, factors
Exit Sub
End If
q = q + 2
Loop
'if we get here then n is prime - add it as a factor
factors.Add Array(n, 1)
End Sub
Function factor(ByVal n As Long) As Collection
Dim factors As New Collection
Dim k As Long
Do While n Mod 2 ^ k = 0
k = k + 1
Loop
k = k - 1
If k > 0 Then
n = n / 2 ^ k
factors.Add Array(2, k)
End If
If n > 1 Then HelperFactor n, 3, factors
Set factor = factors
End Function
Function PerfectCubeByFactors(n As Long) As Boolean
Dim factors As Collection
Dim f As Variant
Set factors = factor(n)
For Each f In factors
If f(1) Mod 3 > 0 Then
PerfectCubeByFactors = False
Exit Function
End If
Next f
'if we get here:
PerfectCubeByFactors = True
End Function
Function PerfectCube(n As Long) As Boolean
Dim d As Long
d = DigitalRoot(n)
If d = 0 Or d = 1 Or d = 8 Or d = 9 Then
PerfectCube = PerfectCubeByFactors(n)
Else
PerfectCube = False
End If
End Function
Fixed the integer division error thanks to #Comintern. Seems to be correct up to 208064 ^ 3 - 2
Function isPerfectCube(n As Double) As Boolean
n = Abs(n)
isPerfectCube = n = Int(n ^ (1 / 3) - (n > 27)) ^ 3
End Function
I am trying to find the x intercept of a 4th degree function by incrementing the x value. I feel like this way doesnt work always and isnt the most efficient way to do this, is there another way I am missing?
My code is:
Sub Findintercept()
Dim equation As Double, x As Double, A As Double, B As Double, C As Double, D As Double, E As Double
A = 0.000200878
B = -0.002203704
C = 0.0086
D = -0.02333
E = 0.02033
x = 0
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
While (equation > 0.00001 Or equation < -0.00001)
If (x > 5) Then
MsgBox "Could not find intercept"
equation = 0
Else
x = x + 0.0001
equation = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End If
Wend
MsgBox x
End Sub
Sometimes it fails to find the intercept hence the IF condition in the while loop. (Im always expecting the intercept to be less than 5!
Your method suffers from two problems:
You assume a step size to change x. The step could be too large, causing you to "walk past" the value your are looking for. To deal with this, you make a small step size, which can mean an excessively large number of iterations are needed to find the solution.
You always assume the same direction to change x. Even with seemingly small values for your step size, you could "walk past" the solution, and have no means to change direction. Or, your initial guess may be on the wrong side of the solution, and you never find an answer.
The Newton-Raphson method handles both of these issues neatly. You do still need to choose your initial guess somewhat close to the root you are looking for.
This method does have potential problems, but for polynomials such as the one you are dealing with, it is quite good.
Below is a simple VBA sub that implements this method. It solves your problem in 4 iterations. I recommend adjusting the initial guess (xii) a lot to see how it impacts the solution you get.
Sub SimpleNewtonRaphson()
Const Tol As Double = 1E-06
Const MaxIter As Long = 50
Dim xi As Double, xii As Double, deriv As Double
Dim IterCount As Long
' Initialize
xi = 0#
xii = 1#
IterCount = 0
' Method
Do While IterCount < MaxIter And Abs(xii - xi) > Tol
xi = xii
deriv = myDeriv(xi)
If deriv = 0# Then Exit Do
xii = xi - myFunc(xi) / deriv
IterCount = IterCount + 1
Loop
' Results
If deriv = 0 Then MsgBox "Ran into a 0 derivative, modify initial guess"
If IterCount >= MaxIter Then MsgBox "MaxIterations reached"
If Abs(xii - xi) <= Tol Then MsgBox "Solution found #" & vbCrLf & "F(" & xii & ") = " & myFunc(xii)
End Sub
... and two VBA functions for your equation and it's derivative ...
Function myFunc(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
Const E = 0.02033
myFunc = A * x ^ 4 + B * x ^ 3 + C * x ^ 2 + D * x + E
End Function
Function myDeriv(x As Double) As Double
Const A As Double = 0.000200878
Const B As Double = -0.002203704
Const C As Double = 0.0086
Const D As Double = -0.02333
myDeriv = 4 * A * x ^ 3 + 3 * B * x ^ 2 + 2 * C * x + D
End Function
I'm trying to create a code that uses the false position method to find the roots of an equation. The equation is as follows:
y = x^(1.5sin(x)) * e^(-x/7) + e^(x/10) - 4
I used a calculator to find the roots, and they are 6.9025, 8.8719, and 12.8079.
My VBA code is as follows:
Option Explicit
Function Func(x)
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1, Guess2)
Dim a, b, c As Single
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
i = 1001
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function
My problem is that when I call the function and use for example 4 and 8 as my two guesses, the number it returns is 5.29 instead of the root between 4 and 8 which is 6.9025.
Is there something wrong with my code or am I just not understanding the false position method correctly?
You should use Double for precision with Maths problems. Three other notes about coding that you may not be aware of:
dim a, b, c as Single
will dim a and b as Variants, and c as a Single, and you can use Exit For to escape from a for loop, rather than setting the control variable out of the bounds. Finally, you should define the outputs of a Function by specifying As ... after the closing parenthesis.
You should use breakpoints (press F9 with the carrot in a line of code to breakpoint that line), then step through the code by pressing F8 to advance line-by-line to see what is happening, and keep your eye on the Locals window (Go to View > Locals)
This is the code with the above changes:
Function Func(x As Double) As Double
Func = (x ^ (1.5 * Sin(x))) * Exp(-x / 7) + Exp(x / 10) - 4
End Function
Function FalsePos(Guess1 As Double, Guess2 As Double) As Double
Dim a As Double, b As Double, c As Double
Dim i As Integer
a = Guess1
b = Guess2
For i = 0 To 1000
c = a - Func(a) * (b - a) / (Func(b) - Func(a))
If (Func(c) < 0.00001) Then
Exit For
Else
If Func(a) * Func(c) < 0 Then
b = c
Else
a = c
End If
End If
Next
FalsePos = c
End Function
I have a sequence of numbers as follows:
1 , 1, 5, 13, 41, 121, 365, ....
The first two values are:
N(1) = 1 and N(2) = 1
As from 3rd value, N(i) = 2*N(i-1) + 3*N(i-2)
The issue I am facing with is: If I give an argument of p, it should return me the last values of the sequence < p (Using fortran77).
For instance, if p = 90, it should return the value 41.
a = 1
b = 1
while b < p:
c = 2 * b + 3 * a
a = b
b = c
return a
The Fortran equivalent is:
function fct(p) result(a)
integer, intent(in) :: p
integer :: a, b, c
a = 1
b = 1
do while (b < p)
c = 2 * b + 3 * a
a = b
b = c
enddo
end function
program test
integer :: fct
external fct
print *,fct(90)
end program
Assuming you already have the sequence in a variable lst, and p set,
max(filter(lambda x:x<=p, lst))
def get_last_element(p):
n1 = 1
n2 = 1
while True:
if n2 > p:
return n1
n1, n2 = n2, 2*n2 + 3 * n1
print(get_last_element(90))
I wrote a piece of code in Fortran 2003. I defined a type which has memory for two last parts of the sequence.The procedure is a recursive function. The type can be used standalone to get n-th part of the sequence or efficiently placed in a loop to find parts in a row (not necessarily beginning at 1) as it has memory of previous parts. (compiler: gfortran 4.8).
The type is defined in mymod.f90 file as
module mymod
implicit none
type seq_t
integer :: saved_i = 0, saved_val_i = 0, saved_val_i_1 = 0
contains
procedure :: getpart => getpart_seq
end type
contains
recursive function getpart_seq(this,i) result(r)
class(seq_t) :: this
integer, intent(in) :: i
integer :: r,r_1,r_2
if (i.eq.1.or.i.eq.2) then
r = 1
elseif(i.eq.this%saved_i) then
r = this%saved_val_i
elseif(i.eq.this%saved_i-1) then
r = this%saved_val_i_1
else
r_1 = this%getpart(i-1)
r_2 = this%getpart(i-2)
r = 2*r_1 + 3*r_2
this%saved_val_i_1 = r_1
end if
this%saved_i = i
this%saved_val_i = r
end function getpart_seq
end module mymod
The main program for the requested case is
program main
use mymod
implicit none
type (seq_t) :: seq
integer :: i,p,tmp_new,tmp_old,ans
! Set the threshold here
p = 90
! loop over parts of the sequence
i = 0
do
i = i + 1
tmp_new = seq%getpart(i)
print*,tmp_new
if (tmp_new>p) then
ans = tmp_old
exit
end if
tmp_old = tmp_new
end do
print*,"The last part of sequence less then",p," is equal to",ans
end program
The outcome is
1
1
5
13
41
121
The last part of sequence less then 90 is equal to 41.
I have a list of distances that I would like to display like you would read off a tape measure, for example 144.125 would display as 144 1/8". I have the following formula
=TEXT(A1,"0"&IF(ABS(A1-ROUND(A1,0))>1/32,"0/"&CHOOSE(ROUND(MOD(A1,1)*16,0),16,8,16,4,16,8,16,2,16,8,16,4,16,8,16),""))&""""
I'd like to simplify it to a 1 argument function (for A1) so I could use it throughout the workbook, but the amount of " quotes and vba keywords is causing problems. Is there an easier way to get a UDF to insert a complicated formula?
If you want to use a UDF with visual basic then try this:
Public Function Fraction(ByVal x As Double, Optional ByVal tol As Double = 1 / 64#) As String
Dim s As Long, w As Long, d As Long, n As Long, f As Double
s = Sgn(x): x = Abs(x)
If s = 0 Then
Fraction = "0"
Exit Function
End If
w = CInt(WorksheetFunction.Floor_Precise(x)): f = x - w
d = CInt(WorksheetFunction.Floor_Precise(1 / tol)): n = WorksheetFunction.Round(f * d, 0)
Dim g As Long
Do
g = WorksheetFunction.Gcd(n, d)
n = n / g
d = d / g
Loop While Abs(g) > 1
Fraction = Trim(IIf(s < 0, "-", vbNullString) + CStr(w) + IIf(n > 0, " " + CStr(n) + "/" + CStr(d), vbNullString))
End Function
With results:
The TEXT function can do this directly:
A B
1 144,1250 144 1/8 "
Formula in B1:
=TEXT(A1;"# ??/??\""")
Greetings
Axel