'Classes/ActiveBasic/Math/Math.ab

Namespace ActiveBasic
Namespace Math

'xの符号だけをyのものにした値を返す。
'引数 x 元となる絶対値
'引数 y 元となる符号
Function CopySign(x As Double, y As Double) As Double
	SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000))
End Function

Function CopySign(x As Single, y As Single) As Single
	SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000))
End Function

Function Hypot(x As Double, y As Double) As Double
	If x = 0 Then
		Hypot = Abs(y)
	Else If y = 0 Then
		Hypot = Abs(x)
	Else
		Dim ax = Abs(x)
		Dim ay = Abs(y)
		If ay > ax Then
			Dim t = x / y
			Hypot = ay * Sqr(1 + t * t)
		Else
			Dim t = y / x
			Hypot = ax * Sqr(1 + t * t)
		End If
	End If
End Function

Function Log1p(x As Double) As Double
	If x < -1 Or IsNaN(x) Then
		Log1p = ActiveBasic.Math.Detail.GetNaN()
	ElseIf x = 0 Then
		x = 0
	ElseIf IsInf(x) Then
		Log1p = x
	Else
		Log1p = ActiveBasic.Math.Detail.Log1p(x)
	End If
End Function

Function IsNaN(ByVal x As Double) As Boolean
	Dim p As *DWord
	p = VarPtr(x) As *DWord
	IsNaN = False
	If (p[1] And &H7FF00000) = &H7FF00000 Then
		If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then
			IsNaN = True
		End If
	End If
End Function

Function IsInf(x As Double) As Boolean
	Dim p = VarPtr(x) As *DWord
	p[1] And= &h7fffffff
	Dim inf = ActiveBasic.Math.Detail.GetInf(False)
	IsInf = (memcmp(p As *Byte, VarPtr(inf), SizeOf (Double)) = 0)
End Function

Function IsFinite(x As Double) As Boolean
	Dim p = VarPtr(x) As *DWord
	p[1] And= &H7FF00000
	IsFinite = p[1] And &H7FF00000 = &H7FF00000
End Function

Namespace Detail

Function SetSign(x As Double, isNegative As Long) As Double
#ifdef _WIN64
	SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63))
#else
	SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x)))
	SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31))
#endif
End Function

#ifdef _WIN64

Function GetNaN() As Double
	SetQWord(VarPtr(GetNaN) As *QWord, &H7FF8000000000000)
End Function

Function GetInf(sign As Boolean) As Double
	Dim s = 0 As QWord
	If sign Then s = 1 << 63
	SetQWord(VarPtr(GetInf) As *QWord, &h7FF0000000000000 Or s)
End Function

#else

Function GetNaN() As Double
	Dim p = VarPtr(GetNaN) As *DWord
	p[0] = 0
	p[1] = &H7FF80000
End Function

Function GetInf(sign As Boolean) As Double
	Dim s = 0 As DWord
	If sign Then s = (1 As DWord) << 31
	Dim p As *DWord
	p = VarPtr(GetInf) As *DWord
	p[0] = 0
	p[1] = &h7FF00000 Or s
End Function

#endif

Function Log1p(x As Double) As Double
	Dim s = 0 As Double
	Dim i = 7 As Long
	While i >= 1
		Dim t = (i * x) As Double
		s = t * (2 * i + 1 + s) / (2 + t)
		i--
	Wend
	Return x / (1 + s)
End Function

Function _Support_tan(x As Double, ByRef k As Long) As Double
	If x>=0 Then
		k=Fix(x/(_System_PI/2)+0.5)
	Else
		k=Fix(x/(_System_PI/2)-0.5)
	End If

	x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k

	Dim x2 = x * x
	Dim t = 0 As Double

	Dim i As Long
	For i=19 To 3 Step -2
		t=x2/(i-t)
	Next

	_Support_tan=x/(1-t)
End Function

End Namespace 'Detail
End Namespace 'Math
End Namespace 'ActiveBasic