[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 |
|
---|
| 17 | Function Log1p(x As Double) As Double
|
---|
| 18 | If x < -1 Or IsNaN(x) Then
|
---|
| 19 | Log1p = ActiveBasic.Math.Detail.GetNaN()
|
---|
| 20 | ElseIf x = 0 Then
|
---|
| 21 | x = 0
|
---|
| 22 | ElseIf IsInf(x) Then
|
---|
| 23 | Log1p = x
|
---|
| 24 | Else
|
---|
| 25 | Log1p = ActiveBasic.Math.Detail.Log1p(x)
|
---|
| 26 | End If
|
---|
| 27 | End Function
|
---|
| 28 |
|
---|
| 29 | Function IsNaN(ByVal x As Double) As Boolean
|
---|
| 30 | Dim p As *DWord
|
---|
| 31 | p = VarPtr(x) As *DWord
|
---|
| 32 | IsNaN = False
|
---|
| 33 | If (p[1] And &H7FF00000) = &H7FF00000 Then
|
---|
| 34 | If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
|
---|
| 35 | IsNaN = True
|
---|
| 36 | End If
|
---|
| 37 | End If
|
---|
| 38 | End Function
|
---|
| 39 |
|
---|
| 40 | Function IsInf(x As Double) As Boolean
|
---|
| 41 | Dim p As *DWord, nan As Double
|
---|
| 42 | p = VarPtr(x) As *DWord
|
---|
| 43 | p[1] And= &h7fffffff
|
---|
| 44 | nan = ActiveBasic.Math.Detail.GetInf(False)
|
---|
| 45 | IsInf = (memcmp(p As *Byte, VarPtr(nan), SizeOf (Double)) = 0)
|
---|
| 46 | End Function
|
---|
| 47 |
|
---|
| 48 | Function IsFinite(x As Double) As Boolean
|
---|
| 49 | Dim p As *DWord, nan As Double
|
---|
| 50 | p = VarPtr(x) As *DWord
|
---|
| 51 | ' p[1] And= &h7ffe0000
|
---|
| 52 | p[1] And= &H7FF00000
|
---|
| 53 | p[0] = 0
|
---|
| 54 | nan = ActiveBasic.Math.Detail.GetInf(/*x,*/ False)
|
---|
| 55 | IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0)
|
---|
| 56 | End Function
|
---|
| 57 |
|
---|
| 58 | Namespace Detail
|
---|
| 59 |
|
---|
| 60 | Function SetSign(x As Double, isNegative As Long) As Double
|
---|
| 61 | #ifdef _WIN64
|
---|
| 62 | SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
|
---|
| 63 | #else
|
---|
| 64 | SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))
|
---|
| 65 | SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
|
---|
| 66 | #endif
|
---|
| 67 | End Function
|
---|
| 68 |
|
---|
| 69 | #ifdef _WIN64
|
---|
| 70 |
|
---|
| 71 | Function GetNaN() As Double
|
---|
| 72 | SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000)
|
---|
| 73 | End Function
|
---|
| 74 |
|
---|
| 75 | Function GetInf(sign As Boolean) As Double
|
---|
| 76 | Dim s = 0 As QWord
|
---|
| 77 | If sign Then s = 1 << 63
|
---|
| 78 | SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s)
|
---|
| 79 | End Function
|
---|
| 80 |
|
---|
| 81 | #else
|
---|
| 82 |
|
---|
| 83 | Function GetNaN() As Double
|
---|
| 84 | Dim p As *DWord
|
---|
| 85 | p = VarPtr(GetNaN) As *DWord
|
---|
| 86 | p[0] = 0
|
---|
| 87 | p[1] = &H7FF80000
|
---|
| 88 | End Function
|
---|
| 89 |
|
---|
| 90 | Function GetInf(sign As Boolean) As Double
|
---|
| 91 | Dim s = 0 As DWord
|
---|
| 92 | If sign Then s = (1 As DWord) << 31
|
---|
| 93 | Dim p As *DWord
|
---|
| 94 | p = VarPtr(GetInf) As *DWord
|
---|
| 95 | p[0] = 0
|
---|
| 96 | p[1] = &h7FF00000 Or s
|
---|
| 97 | End Function
|
---|
| 98 |
|
---|
| 99 | #endif
|
---|
| 100 |
|
---|
| 101 | Function Log1p(x As Double) As Double
|
---|
| 102 | Dim s = 0 As Double
|
---|
| 103 | Dim i = 7 As Long
|
---|
| 104 | While i >= 1
|
---|
| 105 | Dim t = (i * x) As Double
|
---|
| 106 | s = t / (2 + t / (2 * i + 1 + s))
|
---|
| 107 | i--
|
---|
| 108 | Wend
|
---|
| 109 | Return x / (1 + s)
|
---|
| 110 | End Function
|
---|
| 111 |
|
---|
| 112 | Function _Support_tan(x As Double, ByRef k As Long) As Double
|
---|
| 113 | Dim i As Long
|
---|
| 114 | Dim t As Double, x2 As Double
|
---|
| 115 |
|
---|
| 116 | If x>=0 Then
|
---|
| 117 | k=Fix(x/(_System_PI/2)+0.5)
|
---|
| 118 | Else
|
---|
| 119 | k=Fix(x/(_System_PI/2)-0.5)
|
---|
| 120 | End If
|
---|
| 121 |
|
---|
| 122 | x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k
|
---|
| 123 |
|
---|
| 124 | x2=x*x
|
---|
| 125 | t=0
|
---|
| 126 |
|
---|
| 127 | For i=19 To 3 Step -2
|
---|
| 128 | t=x2/(i-t)
|
---|
| 129 | Next
|
---|
| 130 |
|
---|
| 131 | _Support_tan=x/(1-t)
|
---|
| 132 | End Function
|
---|
| 133 |
|
---|
| 134 | End Namespace 'Detail
|
---|
| 135 | End Namespace 'Math
|
---|
| 136 | End Namespace 'ActiveBasic
|
---|