[269] | 1 | 'Classes/ActiveBasic/Math/Math.ab
|
---|
| 2 |
|
---|
| 3 | Namespace ActiveBasic
|
---|
| 4 | Namespace Math
|
---|
| 5 |
|
---|
| 6 | 'xの符号だけをyのものにした値を返す。
|
---|
| 7 | '引数 x 元となる絶対値
|
---|
| 8 | '引数 y 元となる符号
|
---|
| 9 | Function CopySign(x As Double, y As Double) As Double
|
---|
| 10 | SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))
|
---|
| 11 | End Function
|
---|
| 12 |
|
---|
| 13 | Function CopySign(x As Single, y As Single) As Single
|
---|
| 14 | SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))
|
---|
| 15 | End Function
|
---|
| 16 |
|
---|
[285] | 17 | Function Hypot(x As Double, y As Double) As Double
|
---|
| 18 | If x = 0 Then
|
---|
| 19 | Hypot = Abs(y)
|
---|
| 20 | Else If y = 0 Then
|
---|
| 21 | Hypot = Abs(x)
|
---|
| 22 | Else
|
---|
| 23 | Dim ax = Abs(x)
|
---|
| 24 | Dim ay = Abs(y)
|
---|
| 25 | If ay > ax Then
|
---|
| 26 | Dim t = x / y
|
---|
| 27 | Hypot = ay * Sqr(1 + t * t)
|
---|
| 28 | Else
|
---|
| 29 | Dim t = y / x
|
---|
| 30 | Hypot = ax * Sqr(1 + t * t)
|
---|
| 31 | End If
|
---|
| 32 | End If
|
---|
| 33 | End Function
|
---|
| 34 |
|
---|
[269] | 35 | Function Log1p(x As Double) As Double
|
---|
| 36 | If x < -1 Or IsNaN(x) Then
|
---|
| 37 | Log1p = ActiveBasic.Math.Detail.GetNaN()
|
---|
| 38 | ElseIf x = 0 Then
|
---|
| 39 | x = 0
|
---|
| 40 | ElseIf IsInf(x) Then
|
---|
| 41 | Log1p = x
|
---|
| 42 | Else
|
---|
| 43 | Log1p = ActiveBasic.Math.Detail.Log1p(x)
|
---|
| 44 | End If
|
---|
| 45 | End Function
|
---|
| 46 |
|
---|
| 47 | Function IsNaN(ByVal x As Double) As Boolean
|
---|
| 48 | Dim p As *DWord
|
---|
| 49 | p = VarPtr(x) As *DWord
|
---|
| 50 | IsNaN = False
|
---|
| 51 | If (p[1] And &H7FF00000) = &H7FF00000 Then
|
---|
| 52 | If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
|
---|
| 53 | IsNaN = True
|
---|
| 54 | End If
|
---|
| 55 | End If
|
---|
| 56 | End Function
|
---|
| 57 |
|
---|
| 58 | Function IsInf(x As Double) As Boolean
|
---|
[285] | 59 | Dim p = VarPtr(x) As *DWord
|
---|
[269] | 60 | p[1] And= &h7fffffff
|
---|
[285] | 61 | Dim inf = ActiveBasic.Math.Detail.GetInf(False)
|
---|
| 62 | IsInf = (memcmp(p As *Byte, VarPtr(inf), SizeOf (Double)) = 0)
|
---|
[269] | 63 | End Function
|
---|
| 64 |
|
---|
| 65 | Function IsFinite(x As Double) As Boolean
|
---|
[285] | 66 | Dim p = VarPtr(x) As *DWord
|
---|
[269] | 67 | p[1] And= &H7FF00000
|
---|
[289] | 68 | IsFinite = ( p[1] And &H7FF00000 ) = &H7FF00000
|
---|
[269] | 69 | End Function
|
---|
| 70 |
|
---|
| 71 | Namespace Detail
|
---|
| 72 |
|
---|
| 73 | Function SetSign(x As Double, isNegative As Long) As Double
|
---|
| 74 | #ifdef _WIN64
|
---|
| 75 | SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
|
---|
| 76 | #else
|
---|
| 77 | SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))
|
---|
| 78 | SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
|
---|
| 79 | #endif
|
---|
| 80 | End Function
|
---|
| 81 |
|
---|
| 82 | #ifdef _WIN64
|
---|
| 83 |
|
---|
| 84 | Function GetNaN() As Double
|
---|
[276] | 85 | SetQWord(VarPtr(GetNaN) As *QWord, &H7FF8000000000000)
|
---|
[269] | 86 | End Function
|
---|
| 87 |
|
---|
| 88 | Function GetInf(sign As Boolean) As Double
|
---|
| 89 | Dim s = 0 As QWord
|
---|
| 90 | If sign Then s = 1 << 63
|
---|
[276] | 91 | SetQWord(VarPtr(GetInf) As *QWord, &h7FF0000000000000 Or s)
|
---|
[269] | 92 | End Function
|
---|
| 93 |
|
---|
| 94 | #else
|
---|
| 95 |
|
---|
| 96 | Function GetNaN() As Double
|
---|
[285] | 97 | Dim p = VarPtr(GetNaN) As *DWord
|
---|
[269] | 98 | p[0] = 0
|
---|
| 99 | p[1] = &H7FF80000
|
---|
| 100 | End Function
|
---|
| 101 |
|
---|
| 102 | Function GetInf(sign As Boolean) As Double
|
---|
| 103 | Dim s = 0 As DWord
|
---|
| 104 | If sign Then s = (1 As DWord) << 31
|
---|
| 105 | Dim p As *DWord
|
---|
| 106 | p = VarPtr(GetInf) As *DWord
|
---|
| 107 | p[0] = 0
|
---|
| 108 | p[1] = &h7FF00000 Or s
|
---|
| 109 | End Function
|
---|
| 110 |
|
---|
| 111 | #endif
|
---|
| 112 |
|
---|
| 113 | Function Log1p(x As Double) As Double
|
---|
| 114 | Dim s = 0 As Double
|
---|
| 115 | Dim i = 7 As Long
|
---|
| 116 | While i >= 1
|
---|
| 117 | Dim t = (i * x) As Double
|
---|
[285] | 118 | s = t * (2 * i + 1 + s) / (2 + t)
|
---|
[269] | 119 | i--
|
---|
| 120 | Wend
|
---|
| 121 | Return x / (1 + s)
|
---|
| 122 | End Function
|
---|
| 123 |
|
---|
| 124 | Function _Support_tan(x As Double, ByRef k As Long) As Double
|
---|
| 125 | If x>=0 Then
|
---|
| 126 | k=Fix(x/(_System_PI/2)+0.5)
|
---|
| 127 | Else
|
---|
| 128 | k=Fix(x/(_System_PI/2)-0.5)
|
---|
| 129 | End If
|
---|
| 130 |
|
---|
| 131 | x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k
|
---|
| 132 |
|
---|
[285] | 133 | Dim x2 = x * x
|
---|
| 134 | Dim t = 0 As Double
|
---|
[269] | 135 |
|
---|
[285] | 136 | Dim i As Long
|
---|
[269] | 137 | For i=19 To 3 Step -2
|
---|
| 138 | t=x2/(i-t)
|
---|
| 139 | Next
|
---|
| 140 |
|
---|
| 141 | _Support_tan=x/(1-t)
|
---|
| 142 | End Function
|
---|
| 143 |
|
---|
| 144 | End Namespace 'Detail
|
---|
| 145 | End Namespace 'Math
|
---|
| 146 | End Namespace 'ActiveBasic
|
---|