我正在尝试在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.任何其他值都会吐出“有缺陷”的情况。知道这里有什么问题吗?
答案 0 :(得分:6)
您正在测试多维数据集是否等于提供的双倍。
因此,对于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
答案 1 :(得分:3)
@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亿立方)。那时我停止走高,因为测试需要很长时间才能运行,到那时你可能已经超出了合理需要准确的范围。
答案 2 :(得分:2)
修复了@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
答案 3 :(得分:2)
为了好玩,以下是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