' Classes/System/Math.ab #ifndef __SYSTEM_MATH_AB__ #define __SYSTEM_MATH_AB__ Const _System_EPS5 = 0.001 Class Math Public Static Function E() As Double return 2.7182818284590452354 End Function Static Function PI() As Double return _System_PI End Function Static Function Abs(value As Double) As Double SetQWord(VarPtr(value), GetQWord(VarPtr(value)) And &h7fffffffffffffff) End Function Static Function Abs(value As Single) As Single SetDWord(VarPtr(value), GetDWord(VarPtr(value)) And &h7fffffff) End Function Static Function Abs(value As SByte) As SByte If value<0 then return -value Else return value End If End Function Static Function Abs(value As Integer) As Integer If value<0 then return -value Else return value End If End Function Static Function Abs(value As Long) As Long If value<0 then return -value Else return value End If End Function Static Function Abs(value As Int64) As Int64 If value<0 then return -value Else return value End If End Function Static Function Acos(x As Double) As Double If x < -1 Or x > 1 Then Acos = _System_GetNaN() Else Acos = _System_HalfPI - Asin(x) End If End Function Static Function Asin(x As Double) As Double If x < -1 Or x > 1 Then Asin = _System_GetNaN() Else Asin = Math.Atan(x / Sqrt(1 - x * x)) End If End Function Static Function Atan(x As Double) As Double If IsNaN(x) Then Atan = x Exit Function ElseIf IsInf(x) Then Atan = CopySign(_System_PI, x) Exit Function End If Dim i As Long Dim sgn As Long Dim dbl = 0 As Double If x > 1 Then sgn = 1 x = 1 / x ElseIf x < -1 Then sgn = -1 x = 1 / x Else sgn = 0 End If For i = _System_Atan_N To 1 Step -1 Dim t As Double t = i * x dbl = (t * t) / (2 * i + 1 + dbl) Next If sgn > 0 Then Atan = _System_HalfPI - x / (1 + dbl) ElseIf sgn < 0 Then Atan = -_System_HalfPI - x / (1 + dbl) Else Atan = x / (1 + dbl) End If End Function Static Function Atan2(y As Double, x As Double) As Double If x = 0 Then Atan2 = Sgn(y) * _System_HalfPI Else Atan2 = Atn(y / x) If x < 0 Then Atan2 += CopySign(_System_PI, y) End If End If End Function Static Function BigMul(x As Long, y As Long) As Int64 Return (x As Int64) * y End Function Static Function Ceiling(x As Double) As Long If Floor(x) = x then Return x As Long Else Return Floor(x) + 1 End If End Function Static Function Cos(x As Double) As Double If IsNaN(x) Then Return x ElseIf IsInf(x) Then Return _System_GetNaN() End If Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double) End Function Static Function Cosh(value As Double) As Double Dim t As Double t = Math.Exp(value) return (t + 1 / t) * 0.5 End Function Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long ret = x Mod y return x \ y End Function Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64 ret = x - (x \ y) * y return x \ y End Function 'Equals Static Function Exp(x As Double) As Double If IsNaN(x) Then Return x Else If IsInf(x) Then If 0 > x Then Return 0 Else Return x End If End If Dim i As Long, k As Long Dim x2 As Double, w As Double If x >= 0 Then k = Fix(x / _System_LOG2 + 0.5) Else k = Fix(x / _System_LOG2 - 0.5) End If x -= k * _System_LOG2 x2 = x * x w = x2 / 22 i = 18 While i >= 6 w = x2 / (w + i) i -= 4 Wend Return ldexp((2 + w + x) / (2 + w - x), k) End Function Static Function Floor(value As Double) As Long Return Int(value) End Function 'GetHashCode 'GetType Static Function IEEERemainder(x As Double, y As Double) As Double If y = 0 Then Return _System_GetNaN() Dim q = x / y If q <> Int(q) Then If q + 0.5 <> Int(q + 0.5) Then q = Int(q + 0.5) ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then q = Int(q + 0.5) Else q = Int(q - 0.5) End If End If If x - y * q = 0 Then If x > 0 Then Return +0 Else Return -0 End If Else Return x-y*q End If End Function Static Function Log(x As Double) As Double If x = 0 Then Log = _System_GetInf(TRUE) ElseIf x < 0 Or IsNaN(x) Then Log = _System_GetNaN() ElseIf IsInf(x) Then Log = x Else Dim i As Long, k As Long Dim s As Double, t As Double frexp(x / _System_SQRT2, k) x /= ldexp(1, k) x-- s = 0 i = _System_Log_N While i >= 1 t = i * x s = t / (2 + t / (2 * i + 1 + s)) i-- Wend Log = _System_LOG2 * k + x / (1 + s) End If End Function Static Function Log10(x As Double) As Double Return Math.Log(x) / _System_Ln10 End Function Static Function Max(value1 As Byte,value2 As Byte) As Byte If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As SByte,value2 As SByte) As SByte If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Word,value2 As Word) As Word If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Integer,value2 As Integer) As Integer If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As DWord,value2 As DWord) As DWord If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Long,value2 As Long) As Long If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As QWord,value2 As QWord) As QWord If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Int64,value2 As Int64) As Int64 If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Single,value2 As Single) As Single If value1>value2 then return value1 Else return value2 End If End Function Static Function Max(value1 As Double,value2 As Double) As Double If value1>value2 then return value1 Else return value2 End If End Function Static Function Min(value1 As Byte,value2 As Byte) As Byte If value1Int(value+0.5) then value=Int(value+0.5) ElseIf Int(value+0.5)=Int(value*2+1)/2 then value=Int(value+0.5) Else value=Int(value-0.5) End If End Function Static Function Sign(value As Double) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sign(value As SByte) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sign(value As Integer) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sign(value As Long) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sign(value As Int64) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sign(value As Single) As Long If value = 0 then return 0 ElseIf value > 0 then return 1 Else return -1 End If End Function Static Function Sin(value As Double) As Double If IsNaN(value) Then Return value ElseIf IsInf(value) Then Return _System_GetNaN() Exit Function End If Dim k As Long Dim t As Double t = urTan((value * 0.5) As Double, k) t = 2 * t / (1 + t * t) If (k And 1) = 0 Then 'k mod 2 = 0 Then Return t Else Return -t End If End Function Static Function Sinh(x As Double) As Double If Math.Abs(x) > _System_EPS5 Then Dim t As Double t = Math.Exp(x) Return (t - 1 / t) * 0.5 Else Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6) End If End Function Static Function Sqrt(x As Double) As Double Dim s As Double, last As Double Dim i As *Word, j As Long, jj As Long, k As Long If x > 0 Then If IsInf(x) Then Sqrt = x Else Sqrt = x i = (VarPtr(Sqrt) + 6) As *Word jj = GetWord(i) j = jj >> 5 k = jj And &h0000001f j = (j+ 511) << 4 + k SetWord(i, j) Do last = Sqrt Sqrt = (x /Sqrt + Sqrt) * 0.5 Loop While Sqrt <> last End If ElseIf x < 0 Then Sqrt = _System_GetNaN() Else 'x = 0 Or NaN Sqrt = x End If End Function Static Function Tan(x As Double) As Double If IsNaN(x) Then Tan = x Exit Function ElseIf IsInf(x) Then Tan = _System_GetNaN() Exit Function End If Dim k As Long Dim t As Double t = urTan(x, k) If (k And 1) = 0 Then 'k mod 2 = 0 Then Return t ElseIf t <> 0 Then Return -1 / t Else Return CopySign(_System_GetInf(FALSE), -t) End If End Function Static Function Tanh(x As Double) As Double If x > _System_EPS5 Then Return 2 / (1 + Math.Exp(-2 * x)) - 1 ElseIf x < -_System_EPS5 Then Return 1 - 2 / (Math.Exp(2 * x) + 1) Else Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3) End If End Function 'ToString Static Function Truncate(x As Double) As Double Return Fix(x) End Function 'Private Static Function urTan(x As Double, ByRef k As Long) As Double Dim i As Long Dim t As Double, x2 As Double If x >= 0 Then k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long Else k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long End If x = (x - (3217.0 / 2048.0) * k) + _System_D * k x2 = x * x t = 0 For i = _System_UrTan_N To 3 Step -2 t = x2 / (i - t) Next i urTan = x / (1 - t) End Function End Class Const _System_Log_N = 7 Const _System_Atan_N = 20 Const _System_UrTan_N = 17 Const _System_D = 4.4544551033807686783083602485579e-6 Const _System_HalfPI = (_System_PI * 0.5) Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2) Const _System_Ln10 = 2.3025850929940456840179914546844 '10の自然対数 #endif '__SYSTEM_MATH_AB__