VBA: testing perfect cubes

Question

I am trying to write a simple function in VBA that will check the real value and print the result of the string if it is a perfect cube. Here is 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 use a simple if statement to check if the root of the cube is equal to the value of its integer part (i.e. no remainder). I tried to test the function with some perfect cubes (1, 8, 27, 64, 125), but this only works for the number 1. Any other value spits out the “wrong” case. Any idea what's wrong here?

Answer 1

You check if the cube is equal to double.

So for 8 you will test, 2 = 8.

EDIT: also found a floating point question. To solve the problem, we will round up the tithes a bit to try to solve the problem.

Change 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 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 

Answer 2

@ScottCraner correctly explains why you were getting the wrong results, but there are a couple of other things here. First, I assume that you accept Double as input, because the range of valid numbers is higher. However, according to your purported definition of a perfect cube, only numbers with an integer cubic root need to be evaluated (i.e. exclude 3.375). I would just check this to allow an early exit.

The next problem you are facing is that 1/3 cannot be represented exactly by Double . As you increase the retroactive force to get your cube root, you also exacerbate the floating point error. There is a very simple way to avoid this - take the cube root, cube it and see if it matches the input. You will go around the rest of the floating point errors by returning to defining the ideal cube as an integer value - just around the root of the cube for both the next highest and the next lower integer before you cubate 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 to 1E + 27 (1 billion cubic meters) when I tested it. I stayed higher at this point because the test lasted so long, and by that time you are probably out of the range that you would reasonably need to be precise.

Answer 3

Fixed integer division error thanks to @Comintern. Seems correct until 208064 ^ 3 - 2

 Function isPerfectCube(n As Double) As Boolean n = Abs(n) isPerfectCube = n = Int(n ^ (1 / 3) - (n > 27)) ^ 3 End Function 

Answer 4

For fun, here is an implementation of the number theory based method described here . It defines a Boolean (rather than string) function called PerfectCube() , which checks if the integer input (represented as long) is an ideal cube. First, he runs a quick test that drops a lot of numbers. If a quick test does not allow classification, it calls a factoring method. Number coefficient and check if the multiplicity of each simple factor is a multiple of 3. I could probably optimize this step without bothering to find the full factorization when a bad factor is detected, but I already had a VBA factorization algorithm:

 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