VBA：testing完美的立方体

我想在VBA中编写一个简单的函数，它将testing一个真实的值，并输出一个string结果，如果它是一个完美的立方体。 这是我的代码：

Function PerfectCubeTest(x as Double) If (x) ^ (1 / 3) = Int(x) Then PerfectCubeTest = "Perfect" Else PerfectCubeTest = "Flawed" End If End Function 

正如你所看到的，我使用一个简单的if语句来testing一个值的立方根是否等于它的整数部分（即没有余数）。 我尝试用一​​些完美的立方体（1,8,27,64,125）testing函数，但它只适用于数字1.任何其他值吐出“有缺陷”的情况。 任何想法这里有什么问题？

Answer 1

您正在testing多维数据集是否等于提供的double。

所以对于8你会testing是否2 = 8。

编辑：也发现了一个浮点问题。 为了解决这个问题，我们将小数点小数点，以尝试解决这个问题。

更改为以下内容：

 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 

或者（感谢罗恩）

 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正确地解释了为什么你得到不正确的结果，但还有其他一些事情要指出这里。 首先，我假定您正在input一个Double作为input，因为可接受的数字范围较高。 但是，通过对完美立方体的隐含定义，只有具有整数立方根的数字（即它将排除3.375）才需要进行评估。 我只是在这个前面testing，以便提前退出​​。

你遇到的下一个问题是，1/3不能用Double来表示。 由于你正在提高反向力量来获得你的立方体根，你也复合了浮点错误。 有一个非常简单的方法来避免这种情况 – 采取立方体根，立方体，看看它是否符合input。 通过返回一个完美立方体的整数值的定义，您可以解决浮点错误的其余部分 – 只需将立方体根部四舍五入到下一个较高和下一个较低的整数，然后重新对它进行立方体化即可：

 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 

当我testing它时，返回正确的结果高达1E + 27（10亿立方）。 在这一点上，我停止了进一步提高，因为testing花了这么长时间才能运行，到那时你可能超出了你所需要的准确范围。

Answer 3

为了好玩，下面是这里描述的基于数论的方法的实现。 它定义了一个名为PerfectCube()的布尔值（而不是string值）函数，用于testing整数input（表示为Long）是否是一个完美的立方体。 它首先运行一个快速testing，抛出许多数字。 如果快速testing未能对其进行分类，则会调用基于分解的方法。 对数字进行因式分解，并检查每个素数因子的重数是否是3的倍数。当find一个不好的因子时，我可能会优化这个阶段，而不是find完整的因式分解，但是我已经有了一个VBA分解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 

Answer 4

修复了@Comintern的整数除法错误。 似乎是正确的208064 ^ 3 - 2

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