Context Navigation

Math.ab@ 257

Last change on this file since 257 was 257, checked in by イグトランス (egtra), 17 years ago
VersionTest追加、Log1p追加
File size: 12.3 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
[257]	234	Dim m = GetQWord(p) And &h7FF0000000000000
[244]	235	Dim k = ((m >> 52) As DWord) As Long - 1022
[257]	236	SetQWord(p, m + &h0010000000000000)
[244]	237	x /= tmp
[257]	238	Log = _System_LOG2 * k + _System_Log1p(x - 1)
[1]	239	End If
	240	End Function
	241
	242	Static Function Log10(x As Double) As Double
[244]	243	Return Math.Log(x) * _System_InverseLn10
[1]	244	End Function
	245
[244]	246	Static Function Max(value1 As Byte, value2 As Byte) As Byte
[1]	247	If value1>value2 then
	248	return value1
	249	Else
	250	return value2
	251	End If
	252	End Function
	253
[244]	254	Static Function Max(value1 As SByte, value2 As SByte) As SByte
[1]	255	If value1>value2 then
	256	return value1
	257	Else
	258	return value2
	259	End If
	260	End Function
	261
[244]	262	Static Function Max(value1 As Word, value2 As Word) As Word
[1]	263	If value1>value2 then
	264	return value1
	265	Else
	266	return value2
	267	End If
	268	End Function
	269
[244]	270	Static Function Max(value1 As Integer, value2 As Integer) As Integer
[1]	271	If value1>value2 then
	272	return value1
	273	Else
	274	return value2
	275	End If
	276	End Function
	277
[244]	278	Static Function Max(value1 As DWord, value2 As DWord) As DWord
[1]	279	If value1>value2 then
	280	return value1
	281	Else
	282	return value2
	283	End If
	284	End Function
	285
[244]	286	Static Function Max(value1 As Long, value2 As Long) As Long
[1]	287	If value1>value2 then
	288	return value1
	289	Else
	290	return value2
	291	End If
	292	End Function
	293
[244]	294	Static Function Max(value1 As QWord, value2 As QWord) As QWord
[1]	295	If value1>value2 then
	296	return value1
	297	Else
	298	return value2
	299	End If
	300	End Function
	301
[244]	302	Static Function Max(value1 As Int64, value2 As Int64) As Int64
[1]	303	If value1>value2 then
	304	return value1
	305	Else
	306	return value2
	307	End If
	308	End Function
	309
[244]	310	Static Function Max(value1 As Single, value2 As Single) As Single
[1]	311	If value1>value2 then
	312	return value1
	313	Else
	314	return value2
	315	End If
	316	End Function
	317
[244]	318	Static Function Max(value1 As Double, value2 As Double) As Double
[1]	319	If value1>value2 then
	320	return value1
	321	Else
	322	return value2
	323	End If
	324	End Function
	325
[244]	326	Static Function Min(value1 As Byte, value2 As Byte) As Byte
[1]	327	If value1<value2 then
	328	return value1
	329	Else
	330	return value2
	331	End If
	332	End Function
	333
[244]	334	Static Function Min(value1 As SByte, value2 As SByte) As SByte
[1]	335	If value1<value2 then
	336	return value1
	337	Else
	338	return value2
	339	End If
	340	End Function
	341
[244]	342	Static Function Min(value1 As Word, value2 As Word) As Word
[1]	343	If value1<value2 then
	344	return value1
	345	Else
	346	return value2
	347	End If
	348	End Function
	349
[244]	350	Static Function Min(value1 As Integer, value2 As Integer) As Integer
[1]	351	If value1<value2 then
	352	return value1
	353	Else
	354	return value2
	355	End If
	356	End Function
	357
[244]	358	Static Function Min(value1 As DWord, value2 As DWord) As DWord
[1]	359	If value1<value2 then
	360	return value1
	361	Else
	362	return value2
	363	End If
	364	End Function
	365
[244]	366	Static Function Min(value1 As Long, value2 As Long) As Long
[1]	367	If value1<value2 then
	368	return value1
	369	Else
	370	return value2
	371	End If
	372	End Function
	373
[244]	374	Static Function Min(value1 As QWord, value2 As QWord) As QWord
[1]	375	If value1<value2 then
	376	return value1
	377	Else
	378	return value2
	379	End If
	380	End Function
	381
[244]	382	Static Function Min(value1 As Int64, value2 As Int64) As Int64
[1]	383	If value1<value2 then
	384	return value1
	385	Else
	386	return value2
	387	End If
	388	End Function
	389
[244]	390	Static Function Min(value1 As Single, value2 As Single) As Single
[1]	391	If value1<value2 then
	392	return value1
	393	Else
	394	return value2
	395	End If
	396	End Function
	397
[244]	398	Static Function Min(value1 As Double, value2 As Double) As Double
[1]	399	If value1<value2 then
	400	return value1
	401	Else
	402	return value2
	403	End If
	404	End Function
	405
[14]	406	Static Function Pow(x As Double, y As Double) As Double
	407	return pow(x, y)
[1]	408	End Function
	409
	410	'ReferenceEquals
	411
	412	Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
	413	If value+0.5<>Int(value+0.5) then
	414	value=Int(value+0.5)
	415	ElseIf Int(value+0.5)=Int(value*2+1)/2 then
	416	value=Int(value+0.5)
	417	Else
	418	value=Int(value-0.5)
	419	End If
	420	End Function
	421
	422	Static Function Sign(value As Double) As Long
	423	If value = 0 then
	424	return 0
	425	ElseIf value > 0 then
	426	return 1
	427	Else
	428	return -1
	429	End If
	430	End Function
	431
[162]	432	Static Function Sign(value As SByte) As Long
[1]	433	If value = 0 then
	434	return 0
	435	ElseIf value > 0 then
	436	return 1
	437	Else
	438	return -1
	439	End If
	440	End Function
	441
	442	Static Function Sign(value As Integer) As Long
	443	If value = 0 then
	444	return 0
	445	ElseIf value > 0 then
	446	return 1
	447	Else
	448	return -1
	449	End If
	450	End Function
	451
	452	Static Function Sign(value As Long) As Long
	453	If value = 0 then
	454	return 0
	455	ElseIf value > 0 then
	456	return 1
	457	Else
	458	return -1
	459	End If
	460	End Function
	461
	462	Static Function Sign(value As Int64) As Long
	463	If value = 0 then
	464	return 0
	465	ElseIf value > 0 then
	466	return 1
	467	Else
	468	return -1
	469	End If
	470	End Function
	471
	472	Static Function Sign(value As Single) As Long
	473	If value = 0 then
	474	return 0
	475	ElseIf value > 0 then
	476	return 1
	477	Else
	478	return -1
	479	End If
	480	End Function
	481
	482	Static Function Sin(value As Double) As Double
[53]	483	If IsNaN(value) Then
	484	Return value
	485	ElseIf IsInf(value) Then
[1]	486	Return _System_GetNaN()
	487	Exit Function
	488	End If
	489
[53]	490	Dim k As Long
[1]	491	Dim t As Double
	492
[92]	493	t = urTan((value * 0.5) As Double, k)
[1]	494	t = 2 * t / (1 + t * t)
	495	If (k And 1) = 0 Then 'k mod 2 = 0 Then
	496	Return t
	497	Else
	498	Return -t
	499	End If
	500	End Function
	501
	502	Static Function Sinh(x As Double) As Double
[124]	503	If Math.Abs(x) > _System_EPS5 Then
[1]	504	Dim t As Double
[233]	505	t = Math.Exp(x)
[1]	506	Return (t - 1 / t) * 0.5
	507	Else
	508	Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
	509	End If
	510	End Function
	511
	512	Static Function Sqrt(x As Double) As Double
	513	Dim s As Double, last As Double
	514	Dim i As *Word, j As Long, jj As Long, k As Long
[14]	515	If x > 0 Then
	516	If IsInf(x) Then
[1]	517	Sqrt = x
	518	Else
	519	Sqrt = x
	520	i = (VarPtr(Sqrt) + 6) As *Word
	521	jj = GetWord(i)
	522	j = jj >> 5
	523	k = jj And &h0000001f
	524	j = (j+ 511) << 4 + k
	525	SetWord(i, j)
	526	Do
	527	last = Sqrt
	528	Sqrt = (x /Sqrt + Sqrt) * 0.5
[23]	529	Loop While Sqrt <> last
[1]	530	End If
[14]	531	ElseIf x < 0 Then
[23]	532	Sqrt = _System_GetNaN()
[1]	533	Else
	534	'x = 0 Or NaN
	535	Sqrt = x
	536	End If
	537	End Function
	538
[14]	539	Static Function Tan(x As Double) As Double
	540	If IsNaN(x) Then
	541	Tan = x
[1]	542	Exit Function
[14]	543	ElseIf IsInf(x) Then
[1]	544	Tan = _System_GetNaN()
	545	Exit Function
	546	End If
	547
	548	Dim k As Long
	549	Dim t As Double
	550	t = urTan(x, k)
	551	If (k And 1) = 0 Then 'k mod 2 = 0 Then
	552	Return t
	553	ElseIf t <> 0 Then
	554	Return -1 / t
	555	Else
	556	Return CopySign(_System_GetInf(FALSE), -t)
	557	End If
	558	End Function
	559
	560	Static Function Tanh(x As Double) As Double
	561	If x > _System_EPS5 Then
[233]	562	Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]	563	ElseIf x < -_System_EPS5 Then
[233]	564	Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]	565	Else
	566	Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
	567	End If
	568	End Function
	569
[92]	570	'ToString
	571
[1]	572	Static Function Truncate(x As Double) As Double
[237]	573	Return Fix(x)
[1]	574	End Function
	575
[92]	576	'Private
[1]	577	Static Function urTan(x As Double, ByRef k As Long) As Double
	578	Dim i As Long
	579	Dim t As Double, x2 As Double
	580
	581	If x >= 0 Then
[233]	582	k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]	583	Else
[233]	584	k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]	585	End If
	586	x = (x - (3217.0 / 2048.0) * k) + _System_D * k
	587	x2 = x * x
	588	t = 0
	589	For i = _System_UrTan_N To 3 Step -2
	590	t = x2 / (i - t)
	591	Next i
	592	urTan = x / (1 - t)
	593	End Function
[238]	594	Private
	595	Static Const _System_Atan_N = 20 As Long
	596	Static Const _System_UrTan_N = 17 As Long
	597	Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
	598	Static Const _System_EPS5 = 0.001 As Double
[1]	599	End Class
	600
	601	Const _System_HalfPI = (_System_PI * 0.5)
	602	Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[244]	603	Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
	604	Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
[1]	605
[244]	606
[20]	607	#endif '__SYSTEM_MATH_AB__

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

Download in other formats:

Original Format