VBA：测试完美立方体答案

【问题标题】：VBA: Testing for perfect cubesVBA：测试完美立方体
【发布时间】：2017-07-29 11:41:06
【问题描述】：

我正在尝试在 VBA 中编写一个简单的函数，该函数将测试一个真实值并在它是一个完美的立方体时输出一个字符串结果。这是我的代码：

Function PerfectCubeTest(x as Double)

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

End Function

如您所见，我使用一个简单的 if 语句来测试一个值的立方根是否等于其整数部分（即没有余数）。我尝试使用一些完美的立方体（1、8、27、64、125）测试该函数，但它仅适用于数字 1。任何其他值都会吐出“有缺陷”的情况。知道这里有什么问题吗？

【问题讨论】：

标签： vba excel user-defined-functions

【解决方案1】：

您正在测试立方体是否等于提供的双精度数。

因此，对于 8，您将测试 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

【讨论】：

...哇，我是个白痴。非常感谢，这正是我的问题。
64 失败
@ScottCraner 还有CDec(x ^ (1 / 3)) = Int(CDec(x ^ (1 / 3)))
@ScottCraner 不幸的是，它似乎以728,757,026,999 或更大的值（8999^3）失败。所以我想你仍然需要使用 Rounding。
不知何故，包括我的第一个版本在内的所有版本都给了我带有负变量的 Run-time error '5': Invalid procedure call or argument，但对于负常量则很好

【解决方案2】：

@ScottCraner 正确解释了为什么你得到不正确的结果，但这里还有一些其他的事情需要指出。首先，我假设您将Double 作为输入，因为可接受的数字范围更高。但是，根据您对完美立方体的隐含定义，仅需要评估具有整数立方根的数字（即它将排除 3.375）。我只是预先测试一下，以便提前退出。

您遇到的下一个问题是 1 / 3 不能完全由 Double 表示。由于您要提高逆幂以获取立方根，因此您也在加剧浮点错误。有一个真正简单的方法可以避免这种情况 - 取立方根，立方，看看它是否与输入匹配。您可以通过返回将完美立方体定义为整数值来解决其余的浮点错误 - 只需将立方体根四舍五入到 both 下一个更高和下一个更低的整数，然后再重新 -立方体：

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

当我测试它时，这返回了高达 1E+27（10 亿立方）的正确结果。在那一点上我停止了更高的测试，因为测试需要很长时间才能运行，到那时你可能已经超出了你合理需要它准确的范围。

【讨论】：

没关系..限制似乎在208064 ^ 3 - 1
@Slai - 这是有道理的 - 这大致是 Double 的 integer 精度。
所以我使用 Double 作为输入的唯一原因是因为我的这个 VBA 课程的讲师建议在处理可以由电子表格用户。感谢您提供的信息丰富且有点过头的代码（Fix() 到底在做什么？）。另外，什么是浮点错误？
@heygivethatback - Fix() 基本上与Int() 做同样的事情，但对负数的行为略有不同。浮点错误指的是how non-integers are stored internally。归根结底，irrational numbers 无法准确地用二进制表示。

【解决方案3】：

为了好玩，这里是一个基于数论的方法的实现，描述为here。它定义了一个名为 PerfectCube() 的布尔值（而不是字符串值）函数，用于测试整数输入（表示为 Long）是否是完美立方体。它首先运行一个快速测试，该测试会丢弃许多数字。如果快速测试未能对其进行分类，它会调用基于因式分解的方法。对数字进行分解并检查每个质因数的多重性是否是 3 的倍数。我可能会优化这个阶段，在找到坏因子时不用费心去寻找完整的分解，但是我已经有一个 VBA 分解算法了：

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

【讨论】：

【解决方案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

【讨论】：