I am trying to check whether a given number is cuberoot or not in VBA.
The following code works only for 2 and 3 as answers, it does not work after that.
I am trying to figure out what is wrong in the code.
Sub cuberoot()
Dim n As Long, p As Long, x As Long, y As Long
x = InputBox("x= ")
If Iscube(x) Then
MsgBox ("Is cube")
Else
MsgBox ("No cube")
End If
End Sub
Private Function Iscube(a As Long) As Boolean
b = a ^ (1 / 3)
If b = Int(b) Then
Iscube = True
Else
Iscube = False
End If
End Function
Since you are passing in a Long I'll assume that you won't have a number bigger than roughly 2*10^9 so this should always work. It's a slight variation where you truncate the double and then compare to the two nearest integers to make sure you catch any rounding errors.
Edit: In VBA the truncating would always round so it's only neccessary to check the 3rd root value:
Public Function Iscube(a As Long) As Boolean
Dim b As Integer
b = CInt(a ^ (1# / 3#))
If (b ^ 3 = a) Then
Iscube = True
Else
Iscube = False
End If
End Function
If you need a number larger than a Long you'll need to change your input type and you might want to consider an iterative method like a binary search or a Newton-Raphson solver instead.
Existing Code
Your code will work if you add a
dim b as long
If you debug your code you will see that feeding in 125 gives you
b = 5
Int(b) = 4
Updated Code
You can shorten your boolean test to this
Function Iscube(lngIn As Long) As Boolean
Iscube = (Val(lngIn ^ (1 / 3)) = Int(Val(lngIn ^ (1 / 3))))
End Function
Note that if you call it with a double, it will opearte on the long portion only (so it would see IsCube(64.01)as IsCube(64))
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 3 years ago.
Improve this question
Here is my code for a bisection method. If I input 4 and 5 the program loops infinitely. There is a problem with it running.
Sub TheBisectionMethod1()
Dim a, b As Double 'Taking two variables, A and B
Console.Write(vbLf & "Input A: ")
a = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for A
Console.Write(vbLf & "Input B: ")
b = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for B
line1:
Dim c As Double
c = (a + b) / 2 'declearing variable c for the sum of half of the user entered values
If ((Math.Abs(func(c))) < 0.0001) Then 'in flow chart the value of C remians unchange so the program will not run, so it will run if i is >0.0001
Console.Write(vbLf & "C : {0}", c)
ElseIf (Math.Sign(func(c)) = Math.Sign(func(a))) Then
Console.WriteLine("Hello")
a = c
GoTo line1
ElseIf (Math.Sign(func(c)) <> Math.Sign(func(a))) Then
b = c
GoTo line1
End If
End Sub
Function func(x As Double) As Double
Dim y As Double
y = x ^ 2 - 2
Return y
End Function
Don't use a GoTo. There's no need. Also, remove the user interaction from the method that does the actual work. Read the data in one place, pass it to a method (usually a Function rather than a Sub) that does the work and returns a result, and then show the result to the user after the function ends.
That makes this question tricky, because the only result we see in the original code is writing "Hello" to the Console, and that's clearly just a debugging statement. What do you want this code to do? (I'm gonna assume you mean this)
Function Bisect(a as Double, b As Double) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = func(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(func(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = func(c)
End While
Return c
End Function
Function func(x As Double) As Double
Return x ^ 2 - 2
End Function
And really, it should look like this:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = f(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = f(c)
End While
Return c
End Function
and be called like this:
Bisect(a, b, Function(x) x ^ 2 - 2)
Also, the algorithm here is slightly off based the wikipedia article. This is more precise:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim TOL As Double = 0.0001
Dim MaxSteps As Integer = 1000
Dim c As Double = (a + b) / 2
While Math.Abs(f(c)) >= TOL AndAlso (b-a)/2 >= TOL AndAlso MaxSteps > 0
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
MaxSteps -= 1
c = (a + b) / 2
End While
If MaxSteps = 0 Then
Throw New ArgumentException("The bisection fails to converge within the allowed time for the supplied arguments.")
End If
Return c
End Function
I bring it up, because the complaint in the original question is this:
the program loops infinently[sic]
and one of the tenants of the algorithm is it's not guaranteed to converge, hence the step counter.
Finally, this looks to me like it might do well as a recursive function. Recursion can improve things here because we can rely on the call stack overflowing rather than needing to implement a step counter:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
If Math.Abs(f(c)) < TOL OrElse (b-a)/2 < TOL Then Return c
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
Return Bisect(c, b, f)
Else
Return Bisect(a, c, f)
End If
End Function
Of course, catching that StackOverflowException is a trick in itself, so you may still want that step counter. But I need to leave something for you to do yourself.
This also helps demonstrate part of why I recommend removing all user I/O from the Bisect() method. If this method were also responsible for talking to the end user, it would not be possible to even consider the recursive option, where the code is clearly far shorter and simpler than any of the others.
I have a 32-bit value that is stored in the VB.Net type Integer (i.e. Int32.) I am only interested in the bits - not the numerical value. Sometimes the 32nd bit is a one which is interpreted as a negative number. My goal is to reverse the actual bits. My original data is encoded into bits right-to-left (LSB right-most) and is read back in left-to-right (MSB left-most.) I am adapting someone else's code and design. One thought I had was maybe to convert to a long temporarily but I don't know how to do that and preserve the 32nd bit correctly.
Public Shared Function ReverseBits32(ByVal n As Integer) As Integer
Dim result As Integer = 0
For i As Integer = 0 To 32 - 1
result = result * 2 + n Mod 2
n = n >> 1 'n Or 2
Next
Return result
End Function
If you had a method to reverse the bits of a byte you could apply it four times to the bytes of an integer. A little research finds Bit Twiddling Hacks.
Module Module1
Sub ShowBits(a As Integer)
Dim aa = BitConverter.GetBytes(a)
Console.WriteLine(String.Join(" ", aa.Select(Function(b) Convert.ToString(b, 2).PadLeft(8, "0"c))))
End Sub
Function ReverseBits(b As Byte) As Byte
' From https://graphics.stanford.edu/~seander/bithacks.html#ReverseByteWith32Bits
Dim c = CULng(b)
Return CByte((((c * &H802UL And &H22110UL) Or (c * &H8020UL And &H88440UL)) * &H10101UL >> 16) And &HFFUL)
End Function
Function ReverseBits(a As Integer) As Integer
Dim bb = BitConverter.GetBytes(a)
Dim cc(3) As Byte
For i = 0 To 3
cc(3 - i) = ReverseBits(bb(i))
Next
Return BitConverter.ToInt32(cc, 0)
End Function
Sub Main()
Dim y = -762334566
ShowBits(y)
y = ReverseBits(y)
ShowBits(y)
Console.ReadLine()
End Sub
End Module
Output from test value:
10011010 10110010 10001111 11010010
01001011 11110001 01001101 01011001
I used the "no 64-bit" method because it is written for a language where arithmetic overflow is ignored - the methods using 64-bit operations rely on that but it is not the default for VB.NET.
I'm trying to write a program which will find all the values of x and y which will satisfy the condition of x + 2*y equalling say 5. I've given this simple example for the sake of clarity.
Note: I've used nested calls successfully but the program to me looks messy and ill-structured.
In an effort to clean up the structure of my coding I've tried to code the following without much success. Is there any way the following can be done in VBA and how is it done? I have my back against the wall and am hoping that you can help, please.
Please note that the following is not meant to be code but a way of explaining my query. So here is what I envisage to clean up the structure (Simplified for clarity):
Sub sbCaller()
Call sbForLoop()
Call sbMakeEquation()
Call sbTestEquation()
Call sbTabulate()
End Sub
from sbCaller() execute Call sbForLoop()
'simplified for the sake of clarity:-
For x = 1 To 4
For y = 1 To 4
'Go back to Sub sbCaller() to execute sbMakeEquation()
Result = x + 2*y
'back in sbTestEquation()
If Result = 5 Then go back to Sub sbCaller() to execute sbTabulate()
if Result<> 5 Then go back to Sub sbForLoop to resume execution at
'point HERE to execute the next iteration.
I believe the approach you propose is too complicated. Especially if you intend to stick with "Sub" instead of "Function".
The following separates the steps, which is what I understand you to want, without needing to jump back-and-forth within the same procedure.
Sub sbCaller()
sbForLoop
End Sub
Sub sbForLoop()
Dim result As Long
Dim x As Long
Dim y As Long
For x = 1 To 4
For y = 1 To 4
result = x + 2 * y
sbTestEquation result, x, y
Next y
Next x
End Sub
Function sbTestEquation(result As Long, x As Long, y As Long) As Boolean
Dim bOK As Boolean
If result = 5 Then
sbTabulate result, x, y
bOK = True
Else
bOK = False
End If
sbTestEquation = bOK
End Function
Sub sbTabulate(result As Long, x As Long, y As Long)
Debug.Print result, x, y
End Sub
I am very new to VBA. I am sorry if my question is very easy. I have a question. When I run the following code, I get the following error message:
Compiler Error: Ambiguous Name Detected: faren
Can anyone please explain what part of my code is wrong?
Option Explicit
Dim n As Double
Private faren As Integer
Dim result As Double
Function faren(n)
faren = (9 / 5) * (n + 32)
End Function
Function c(n)
Dim c As Long
c = (5 / 9) * (n - 32)
End Function
Sub test()
result = faren(32)
MsgBox "the degree in farenheit is " & result & "Farenheit."
End Sub
You declare faren two times. First one Private faren As Integer and second one Function faren(n)
To avoid ambiguous names you can delete Private faren As Integer and amend the function line like this: Function faren(n) As Integer
Edit: I don't know if you declare faren intentionally as Integer instead of Double, but I want you to see the following results to compare the difference:
When Function faren(n) As Integer is used n = 32 --> result = 115
When Function faren(n) As Double is used n = 32 --> result = 115.2
You might want to consider declaring c as double in the same way because it affects the result as well.
Am I doing something wrong or does the VBA Mod operator actually not work with floating point values like Doubles?
So I've always sort of assumed that the VBA Mod operator would work with Doubles based on the VB documentation, but in trying to figure out why my rounding function doesn't work, I found some unexpected Mod behavior.
Here is my code:
Public Function RoundUp(num As Double, Optional nearest As Double = 1)
RoundUp = ((num \ nearest) - ((num Mod nearest) > 0)) * nearest
End Function
RoundUp(12.34) returns 12 instead of 13 so I dug a little deeper and found that:
12.5 Mod 1 returns 0 with the return type of Long, whereas I had expected 0.5 with a type of Double.
Conclusion
As #ckuhn203 points out in his answer, according to the VBA specification,
The modulus, or remainder, operator divides number1 by number2
(rounding floating-point numbers to integers) and returns only the
remainder as result.
And
Usually, the data type of result is a Byte, Byte variant, Integer,
Integer variant, Long, or Variant containing a Long, regardless of
whether or not result is a whole number. Any fractional portion is
truncated.
For my purposes, I need a floating point modulo and so I have decided to use the following:
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function
Here are some examples:
FMod(12.5, 1) = 0.5
FMod(5.3, 2) = 1.3
FMod(18.5, 4.2) = 1.7
Using this in my rounding function solves my particular issue.
According to the VB6/VBA documentation
The modulus, or remainder, operator divides number1 by number2
(rounding floating-point numbers to integers) and returns only the
remainder as result. For example, in the following expression, A
(result) equals 5. A = 19 Mod 6.7 Usually, the data type of result is
a Byte, Byte variant, Integer, Integer variant, Long, or Variant
containing a Long, regardless of whether or not result is a whole
number. Any fractional portion is truncated. However, if any
expression is Null, result is Null. Any expression that is Empty is
treated as 0.
Remember, mod returns the remainder of the division. Any integer mod 1 = 0.
debug.print 12 mod 1
'12/1 = 12 r 0
The real culprit here though is that vba truncates (rounds down) the double to an integer before performing the modulo.
?13 mod 10
'==>3
?12.5 mod 10
'==>2
debug.print 12.5 mod 1
'vba truncates 12.5 to 12
debug.print 12 mod 1
'==> 0
I believe that the Mod operator calculates with long type only. The link that you provided is for VB.Net, which is not the same as the VBA you use in MSAccess.
The operator in VBA appears to accept a double type, but simply converts it to a long internally.
This test yielded a result of 1.
9 Mod 4.5
This test yielded a result of 0.
8 Mod 4.5
As a work around your can do some simple math on the values. To get two decimal of precision just multiply the input values by 100 and then divide the result by 100.
result = (123.45*100 Mod 1*100)/100
result = (12345 Mod 100)/100
result = 0.45
I'm late to the party, but just incase this answer is still helpful to someone.
Try This in VBS:
Option Explicit
Call Main()
Sub Main()
WScript.Echo CStr(Is_Rest_Of_Divide_Equal_To_Zero(506.25, 1.5625))
End Sub
Function Is_Rest_Of_Divide_Equal_To_Zero(Divident, Divisor)
Dim Result
Dim DivideResult
If Divident > Divisor Then
DivideResult = Round(Divident/Divisor, 0)
If (DivideResult * Divisor) > Divident Then
Result = False
ElseIf (DivideResult * Divisor) = Divident Then
Result = True
ElseIf (DivideResult * Divisor) < Divident Then
Result = False
End If
ElseIf Divident = Divisor Then
Result = True
ElseIf Divident < Divisor Then
Result = False
End If
Is_Rest_Of_Divide_Equal_To_Zero = Result
End Function
Public Function Modi(d as double) as double
Modi = d - Int(d)
End Function
Dim myDoule as Double
myDoule = 1.99999
Debug.Print Modi(myDoule)
0.99999