VBA：测试完美的立方体

Question

我正在尝试在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.任何其他值都会吐出“有缺陷”的情况。知道这里有什么问题吗？

Answer 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

或（感谢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正确地解释了为什么你得到的结果不正确，但还有其他一些事情要指出。首先，我假设您输入Double作为输入，因为可接受数字的范围更高。但是，通过隐含的完美立方体定义，只需要对具有整数立方根的数字（即它将排除3.375）进行求值。我只是先测试一下，以便提前退出​​。

您遇到的下一个问题是1/3无法完全由Double表示。由于您正在提高反向功率以获得立方根，因此您还会复合浮点错误。有一个真正的简单方法可以避免这种情况 - 取出立方根，立方体，然后查看它是否与输入匹配。您可以通过回到完美多维数据集的定义作为整数值来绕过剩余的浮点错误 - 只需将多维数据集根定义为两者下一个更高和下一个更低的整数立方体：

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亿立方）。那时我停止走高，因为测试需要很长时间才能运行，到那时你可能已经超出了合理需要准确的范围。

Answer 3

修复了@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

Answer 4

为了好玩，以下是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