/***********************************************************
cuberoot.c -- 立方根
***********************************************************/

Function cuberoot(x As Double) As Double
Dim s, prev
Dim positive As Long

If x = 0 Then Exit Function
if x > 0 Then positive = 1 Else positive = 0:x = -x
If x > 1 Then s = x Else s = 1

Do
prev = s: s = (x / (s * s) + 2 * s) / 3
Loop while (s < prev)
If (positive) Then cuberoot = prev Else cuberoot = -prev
End Function

Function cuberoot2(x As Double) As Double
Dim s, t, prev
Dim positive As Long

If x = 0 Then Exit Function
if x > 0 Then positive = 1 Else positive = 0:x = -x
If x > 1 Then s = x Else s = 1

Do
prev = s: t = s * s: s = s + (x - t * s) / (2 * t + x / s)
Loop while (s < prev)
If (positive) Then cuberoot2 = prev Else cuberoot2 = -prev
End Function

'
Function lcuberoot(x As Double) As Double
Dim s

If x = 0 Then Exit Function
s = cuberoot(x)
lcuberoot = (x / (s * s) + 2 * s) / 3
End Function


#N88BASIC
Dim i As Long

For i=0 To 20
Print i, cuberoot(i), cuberoot2(i), lcuberoot(i)
Next

タグ:

+ タグ編集
  • タグ:

このサイトはreCAPTCHAによって保護されており、Googleの プライバシーポリシー利用規約 が適用されます。

最終更新:2010年07月15日 23:13