Context Navigation

Math.ab@ 244

Last change on this file since 244 was 244, checked in by イグトランス (egtra), 17 years ago
Math.Logでfrexp, ldexpを使わないようにした
File size: 12.5 KB

Rev	Line
[14]	1	' Classes/System/Math.ab
[1]	2
	3	#ifndef __SYSTEM_MATH_AB__
	4	#define __SYSTEM_MATH_AB__
	5
	6	Class Math
	7	Public
	8	Static Function E() As Double
	9	return 2.7182818284590452354
	10	End Function
	11
	12	Static Function PI() As Double
	13	return _System_PI
	14	End Function
	15
	16	Static Function Abs(value As Double) As Double
[239]	17	SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
[1]	18	End Function
	19
	20	Static Function Abs(value As Single) As Single
[239]	21	SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
[1]	22	End Function
	23
[162]	24	Static Function Abs(value As SByte) As SByte
[1]	25	If value<0 then
	26	return -value
	27	Else
	28	return value
	29	End If
	30	End Function
	31
	32	Static Function Abs(value As Integer) As Integer
	33	If value<0 then
	34	return -value
	35	Else
	36	return value
	37	End If
	38	End Function
	39
	40	Static Function Abs(value As Long) As Long
	41	If value<0 then
	42	return -value
	43	Else
	44	return value
	45	End If
	46	End Function
	47
	48	Static Function Abs(value As Int64) As Int64
	49	If value<0 then
	50	return -value
	51	Else
	52	return value
	53	End If
	54	End Function
	55
	56	Static Function Acos(x As Double) As Double
	57	If x < -1 Or x > 1 Then
	58	Acos = _System_GetNaN()
	59	Else
[232]	60	Acos = _System_HalfPI - Asin(x)
[1]	61	End If
	62	End Function
	63
	64	Static Function Asin(x As Double) As Double
	65	If x < -1 Or x > 1 Then
	66	Asin = _System_GetNaN()
	67	Else
[233]	68	Asin = Math.Atan(x / Sqrt(1 - x * x))
[1]	69	End If
	70	End Function
	71
	72	Static Function Atan(x As Double) As Double
	73	If IsNaN(x) Then
	74	Atan = x
	75	Exit Function
	76	ElseIf IsInf(x) Then
	77	Atan = CopySign(_System_PI, x)
	78	Exit Function
	79	End If
	80	Dim i As Long
	81	Dim sgn As Long
	82	Dim dbl = 0 As Double
	83
	84	If x > 1 Then
	85	sgn = 1
	86	x = 1 / x
	87	ElseIf x < -1 Then
	88	sgn = -1
	89	x = 1 / x
	90	Else
	91	sgn = 0
	92	End If
	93
	94	For i = _System_Atan_N To 1 Step -1
	95	Dim t As Double
[14]	96	t = i * x
[1]	97	dbl = (t * t) / (2 * i + 1 + dbl)
	98	Next
	99
	100	If sgn > 0 Then
	101	Atan = _System_HalfPI - x / (1 + dbl)
	102	ElseIf sgn < 0 Then
	103	Atan = -_System_HalfPI - x / (1 + dbl)
	104	Else
	105	Atan = x / (1 + dbl)
	106	End If
	107	End Function
	108
	109	Static Function Atan2(y As Double, x As Double) As Double
	110	If x = 0 Then
	111	Atan2 = Sgn(y) * _System_HalfPI
	112	Else
	113	Atan2 = Atn(y / x)
	114	If x < 0 Then
[91]	115	Atan2 += CopySign(_System_PI, y)
[1]	116	End If
	117	End If
	118	End Function
	119
[14]	120	Static Function BigMul(x As Long, y As Long) As Int64
	121	Return (x As Int64) * y
[1]	122	End Function
	123
	124	Static Function Ceiling(x As Double) As Long
	125	If Floor(x) = x then
[233]	126	Return x As Long
[1]	127	Else
	128	Return Floor(x) + 1
	129	End If
	130	End Function
	131
[14]	132	Static Function Cos(x As Double) As Double
	133	If IsNaN(x) Then
	134	Return x
[244]	135	ElseIf IsInf(x) Then
[1]	136	Return _System_GetNaN()
	137	End If
	138
[124]	139	Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
[1]	140	End Function
	141
	142	Static Function Cosh(value As Double) As Double
	143	Dim t As Double
[233]	144	t = Math.Exp(value)
[1]	145	return (t + 1 / t) * 0.5
	146	End Function
	147
[14]	148	Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long
	149	ret = x Mod y
	150	return x \ y
[1]	151	End Function
	152
[14]	153	Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64
	154	ret = x - (x \ y) * y
	155	return x \ y
[1]	156	End Function
	157
	158	'Equals
	159
[14]	160	Static Function Exp(x As Double) As Double
[1]	161	If IsNaN(x) Then
	162	Return x
	163	Else If IsInf(x) Then
	164	If 0 > x Then
	165	Return 0
	166	Else
	167	Return x
	168	End If
	169	End If
	170	Dim i As Long, k As Long
	171	Dim x2 As Double, w As Double
	172
	173	If x >= 0 Then
[14]	174	k = Fix(x / _System_LOG2 + 0.5)
[1]	175	Else
[14]	176	k = Fix(x / _System_LOG2 - 0.5)
[1]	177	End If
	178
	179	x -= k * _System_LOG2
	180
	181	x2 = x * x
	182	w = x2 / 22
	183
	184	i = 18
	185	While i >= 6
	186	w = x2 / (w + i)
	187	i -= 4
	188	Wend
	189
	190	Return ldexp((2 + w + x) / (2 + w - x), k)
	191	End Function
	192
	193	Static Function Floor(value As Double) As Long
[237]	194	Return Int(value)
[1]	195	End Function
	196
	197	'GetHashCode
	198
	199	'GetType
	200
[237]	201	Static Function IEEERemainder(x As Double, y As Double) As Double
	202	If y = 0 Then Return _System_GetNaN()
	203	Dim q = x / y
	204	If q <> Int(q) Then
	205	If q + 0.5 <> Int(q + 0.5) Then
	206	q = Int(q + 0.5)
	207	ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then
	208	q = Int(q + 0.5)
[1]	209	Else
[237]	210	q = Int(q - 0.5)
[1]	211	End If
	212	End If
[237]	213	If x - y * q = 0 Then
	214	If x > 0 Then
	215	Return +0
[1]	216	Else
[237]	217	Return -0
[1]	218	End If
	219	Else
[237]	220	Return x-y*q
[1]	221	End If
	222	End Function
	223
	224	Static Function Log(x As Double) As Double
	225	If x = 0 Then
[244]	226	Log = _System_GetInf(True)
[1]	227	ElseIf x < 0 Or IsNaN(x) Then
	228	Log = _System_GetNaN()
	229	ElseIf IsInf(x) Then
	230	Log = x
	231	Else
[244]	232	Dim tmp = x * _System_InverseSqrt2
	233	Dim p = VarPtr(tmp) As *QWord
	234	Dim m = p[0] And &h7FF0000000000000
	235	Dim k = ((m >> 52) As DWord) As Long - 1022
	236	p[0] = m + &h0010000000000000
	237	x /= tmp
[1]	238
	239	x--
[244]	240	Dim s = 0 As Double
	241	Dim i = _System_Log_N As Long
[1]	242	While i >= 1
[244]	243	Dim t = (i * x) As Double
[1]	244	s = t / (2 + t / (2 * i + 1 + s))
	245	i--
	246	Wend
	247	Log = _System_LOG2 * k + x / (1 + s)
	248	End If
	249	End Function
	250
	251	Static Function Log10(x As Double) As Double
[244]	252	Return Math.Log(x) * _System_InverseLn10
[1]	253	End Function
	254
[244]	255	Static Function Max(value1 As Byte, value2 As Byte) As Byte
[1]	256	If value1>value2 then
	257	return value1
	258	Else
	259	return value2
	260	End If
	261	End Function
	262
[244]	263	Static Function Max(value1 As SByte, value2 As SByte) As SByte
[1]	264	If value1>value2 then
	265	return value1
	266	Else
	267	return value2
	268	End If
	269	End Function
	270
[244]	271	Static Function Max(value1 As Word, value2 As Word) As Word
[1]	272	If value1>value2 then
	273	return value1
	274	Else
	275	return value2
	276	End If
	277	End Function
	278
[244]	279	Static Function Max(value1 As Integer, value2 As Integer) As Integer
[1]	280	If value1>value2 then
	281	return value1
	282	Else
	283	return value2
	284	End If
	285	End Function
	286
[244]	287	Static Function Max(value1 As DWord, value2 As DWord) As DWord
[1]	288	If value1>value2 then
	289	return value1
	290	Else
	291	return value2
	292	End If
	293	End Function
	294
[244]	295	Static Function Max(value1 As Long, value2 As Long) As Long
[1]	296	If value1>value2 then
	297	return value1
	298	Else
	299	return value2
	300	End If
	301	End Function
	302
[244]	303	Static Function Max(value1 As QWord, value2 As QWord) As QWord
[1]	304	If value1>value2 then
	305	return value1
	306	Else
	307	return value2
	308	End If
	309	End Function
	310
[244]	311	Static Function Max(value1 As Int64, value2 As Int64) As Int64
[1]	312	If value1>value2 then
	313	return value1
	314	Else
	315	return value2
	316	End If
	317	End Function
	318
[244]	319	Static Function Max(value1 As Single, value2 As Single) As Single
[1]	320	If value1>value2 then
	321	return value1
	322	Else
	323	return value2
	324	End If
	325	End Function
	326
[244]	327	Static Function Max(value1 As Double, value2 As Double) As Double
[1]	328	If value1>value2 then
	329	return value1
	330	Else
	331	return value2
	332	End If
	333	End Function
	334
[244]	335	Static Function Min(value1 As Byte, value2 As Byte) As Byte
[1]	336	If value1<value2 then
	337	return value1
	338	Else
	339	return value2
	340	End If
	341	End Function
	342
[244]	343	Static Function Min(value1 As SByte, value2 As SByte) As SByte
[1]	344	If value1<value2 then
	345	return value1
	346	Else
	347	return value2
	348	End If
	349	End Function
	350
[244]	351	Static Function Min(value1 As Word, value2 As Word) As Word
[1]	352	If value1<value2 then
	353	return value1
	354	Else
	355	return value2
	356	End If
	357	End Function
	358
[244]	359	Static Function Min(value1 As Integer, value2 As Integer) As Integer
[1]	360	If value1<value2 then
	361	return value1
	362	Else
	363	return value2
	364	End If
	365	End Function
	366
[244]	367	Static Function Min(value1 As DWord, value2 As DWord) As DWord
[1]	368	If value1<value2 then
	369	return value1
	370	Else
	371	return value2
	372	End If
	373	End Function
	374
[244]	375	Static Function Min(value1 As Long, value2 As Long) As Long
[1]	376	If value1<value2 then
	377	return value1
	378	Else
	379	return value2
	380	End If
	381	End Function
	382
[244]	383	Static Function Min(value1 As QWord, value2 As QWord) As QWord
[1]	384	If value1<value2 then
	385	return value1
	386	Else
	387	return value2
	388	End If
	389	End Function
	390
[244]	391	Static Function Min(value1 As Int64, value2 As Int64) As Int64
[1]	392	If value1<value2 then
	393	return value1
	394	Else
	395	return value2
	396	End If
	397	End Function
	398
[244]	399	Static Function Min(value1 As Single, value2 As Single) As Single
[1]	400	If value1<value2 then
	401	return value1
	402	Else
	403	return value2
	404	End If
	405	End Function
	406
[244]	407	Static Function Min(value1 As Double, value2 As Double) As Double
[1]	408	If value1<value2 then
	409	return value1
	410	Else
	411	return value2
	412	End If
	413	End Function
	414
[14]	415	Static Function Pow(x As Double, y As Double) As Double
	416	return pow(x, y)
[1]	417	End Function
	418
	419	'ReferenceEquals
	420
	421	Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
	422	If value+0.5<>Int(value+0.5) then
	423	value=Int(value+0.5)
	424	ElseIf Int(value+0.5)=Int(value*2+1)/2 then
	425	value=Int(value+0.5)
	426	Else
	427	value=Int(value-0.5)
	428	End If
	429	End Function
	430
	431	Static Function Sign(value As Double) As Long
	432	If value = 0 then
	433	return 0
	434	ElseIf value > 0 then
	435	return 1
	436	Else
	437	return -1
	438	End If
	439	End Function
	440
[162]	441	Static Function Sign(value As SByte) As Long
[1]	442	If value = 0 then
	443	return 0
	444	ElseIf value > 0 then
	445	return 1
	446	Else
	447	return -1
	448	End If
	449	End Function
	450
	451	Static Function Sign(value As Integer) As Long
	452	If value = 0 then
	453	return 0
	454	ElseIf value > 0 then
	455	return 1
	456	Else
	457	return -1
	458	End If
	459	End Function
	460
	461	Static Function Sign(value As Long) As Long
	462	If value = 0 then
	463	return 0
	464	ElseIf value > 0 then
	465	return 1
	466	Else
	467	return -1
	468	End If
	469	End Function
	470
	471	Static Function Sign(value As Int64) As Long
	472	If value = 0 then
	473	return 0
	474	ElseIf value > 0 then
	475	return 1
	476	Else
	477	return -1
	478	End If
	479	End Function
	480
	481	Static Function Sign(value As Single) As Long
	482	If value = 0 then
	483	return 0
	484	ElseIf value > 0 then
	485	return 1
	486	Else
	487	return -1
	488	End If
	489	End Function
	490
	491	Static Function Sin(value As Double) As Double
[53]	492	If IsNaN(value) Then
	493	Return value
	494	ElseIf IsInf(value) Then
[1]	495	Return _System_GetNaN()
	496	Exit Function
	497	End If
	498
[53]	499	Dim k As Long
[1]	500	Dim t As Double
	501
[92]	502	t = urTan((value * 0.5) As Double, k)
[1]	503	t = 2 * t / (1 + t * t)
	504	If (k And 1) = 0 Then 'k mod 2 = 0 Then
	505	Return t
	506	Else
	507	Return -t
	508	End If
	509	End Function
	510
	511	Static Function Sinh(x As Double) As Double
[124]	512	If Math.Abs(x) > _System_EPS5 Then
[1]	513	Dim t As Double
[233]	514	t = Math.Exp(x)
[1]	515	Return (t - 1 / t) * 0.5
	516	Else
	517	Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
	518	End If
	519	End Function
	520
	521	Static Function Sqrt(x As Double) As Double
	522	Dim s As Double, last As Double
	523	Dim i As *Word, j As Long, jj As Long, k As Long
[14]	524	If x > 0 Then
	525	If IsInf(x) Then
[1]	526	Sqrt = x
	527	Else
	528	Sqrt = x
	529	i = (VarPtr(Sqrt) + 6) As *Word
	530	jj = GetWord(i)
	531	j = jj >> 5
	532	k = jj And &h0000001f
	533	j = (j+ 511) << 4 + k
	534	SetWord(i, j)
	535	Do
	536	last = Sqrt
	537	Sqrt = (x /Sqrt + Sqrt) * 0.5
[23]	538	Loop While Sqrt <> last
[1]	539	End If
[14]	540	ElseIf x < 0 Then
[23]	541	Sqrt = _System_GetNaN()
[1]	542	Else
	543	'x = 0 Or NaN
	544	Sqrt = x
	545	End If
	546	End Function
	547
[14]	548	Static Function Tan(x As Double) As Double
	549	If IsNaN(x) Then
	550	Tan = x
[1]	551	Exit Function
[14]	552	ElseIf IsInf(x) Then
[1]	553	Tan = _System_GetNaN()
	554	Exit Function
	555	End If
	556
	557	Dim k As Long
	558	Dim t As Double
	559	t = urTan(x, k)
	560	If (k And 1) = 0 Then 'k mod 2 = 0 Then
	561	Return t
	562	ElseIf t <> 0 Then
	563	Return -1 / t
	564	Else
	565	Return CopySign(_System_GetInf(FALSE), -t)
	566	End If
	567	End Function
	568
	569	Static Function Tanh(x As Double) As Double
	570	If x > _System_EPS5 Then
[233]	571	Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]	572	ElseIf x < -_System_EPS5 Then
[233]	573	Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]	574	Else
	575	Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
	576	End If
	577	End Function
	578
[92]	579	'ToString
	580
[1]	581	Static Function Truncate(x As Double) As Double
[237]	582	Return Fix(x)
[1]	583	End Function
	584
[92]	585	'Private
[1]	586	Static Function urTan(x As Double, ByRef k As Long) As Double
	587	Dim i As Long
	588	Dim t As Double, x2 As Double
	589
	590	If x >= 0 Then
[233]	591	k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]	592	Else
[233]	593	k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]	594	End If
	595	x = (x - (3217.0 / 2048.0) * k) + _System_D * k
	596	x2 = x * x
	597	t = 0
	598	For i = _System_UrTan_N To 3 Step -2
	599	t = x2 / (i - t)
	600	Next i
	601	urTan = x / (1 - t)
	602	End Function
[238]	603	Private
	604	Static Const _System_Log_N = 7 As Long
	605	Static Const _System_Atan_N = 20 As Long
	606	Static Const _System_UrTan_N = 17 As Long
	607	Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
	608	Static Const _System_EPS5 = 0.001 As Double
[1]	609	End Class
	610
	611	Const _System_HalfPI = (_System_PI * 0.5)
	612	Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[244]	613	Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
	614	Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
[1]	615
[244]	616
[20]	617	#endif '__SYSTEM_MATH_AB__

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format