Context Navigation

Math.ab@ 268

Last change on this file since 268 was 268, checked in by イグトランス (egtra), 17 years ago
StringのResizeを呼ぶコンストラクタでメモリ確保されない場合を排除、ほか微修正
File size: 12.8 KB

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

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

Download in other formats:

Original Format