source: Include/Classes/System/Math.ab@ 299

Last change on this file since 299 was 299, checked in by dai, 17 years ago

【32bitコンパイラ】
静的リンクライブラリを実装
ジェネリクスを実装
※64bitコンパイラは未実装
File size: 12.8 KB
RevLine 
[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]8Namespace System
9
[1]10Class Math
11Public
12 Static Function E() As Double
13 return 2.7182818284590452354
14 End Function
[299]15/*
[1]16 Static Function PI() As Double
17 return _System_PI
18 End Function
[299]19*/
[1]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
[285]174 Dim k As Long
[1]175 If x >= 0 Then
[14]176 k = Fix(x / _System_LOG2 + 0.5)
[1]177 Else
[14]178 k = Fix(x / _System_LOG2 - 0.5)
[1]179 End If
180
181 x -= k * _System_LOG2
182
[285]183 Dim x2 = x * x
184 Dim w = x2 / 22
[1]185
[285]186 Dim i = 18
[1]187 While i >= 6
188 w = x2 / (w + i)
189 i -= 4
190 Wend
191
192 Return ldexp((2 + w + x) / (2 + w - x), k)
193 End Function
194
195 Static Function Floor(value As Double) As Long
[237]196 Return Int(value)
[1]197 End Function
198
199 'GetHashCode
200
201 'GetType
202
[237]203 Static Function IEEERemainder(x As Double, y As Double) As Double
[268]204 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
[237]205 Dim q = x / y
206 If q <> Int(q) Then
207 If q + 0.5 <> Int(q + 0.5) Then
208 q = Int(q + 0.5)
209 ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then
210 q = Int(q + 0.5)
[1]211 Else
[237]212 q = Int(q - 0.5)
[1]213 End If
214 End If
[237]215 If x - y * q = 0 Then
216 If x > 0 Then
217 Return +0
[1]218 Else
[237]219 Return -0
[1]220 End If
221 Else
[237]222 Return x-y*q
[1]223 End If
224 End Function
225
226 Static Function Log(x As Double) As Double
227 If x = 0 Then
[268]228 Log = ActiveBasic.Math.Detail.GetInf(True)
229 ElseIf x < 0 Or ActiveBasic.Math.IsNaN(x) Then
230 Log = ActiveBasic.Math.Detail.GetNaN()
231 ElseIf ActiveBasic.Math.IsInf(x) Then
[1]232 Log = x
233 Else
[244]234 Dim tmp = x * _System_InverseSqrt2
235 Dim p = VarPtr(tmp) As *QWord
[257]236 Dim m = GetQWord(p) And &h7FF0000000000000
[244]237 Dim k = ((m >> 52) As DWord) As Long - 1022
[257]238 SetQWord(p, m + &h0010000000000000)
[244]239 x /= tmp
[268]240 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
[1]241 End If
242 End Function
243
244 Static Function Log10(x As Double) As Double
[244]245 Return Math.Log(x) * _System_InverseLn10
[1]246 End Function
247
[244]248 Static Function Max(value1 As Byte, value2 As Byte) As Byte
[1]249 If value1>value2 then
250 return value1
251 Else
252 return value2
253 End If
254 End Function
255
[244]256 Static Function Max(value1 As SByte, value2 As SByte) As SByte
[1]257 If value1>value2 then
258 return value1
259 Else
260 return value2
261 End If
262 End Function
263
[244]264 Static Function Max(value1 As Word, value2 As Word) As Word
[1]265 If value1>value2 then
266 return value1
267 Else
268 return value2
269 End If
270 End Function
271
[244]272 Static Function Max(value1 As Integer, value2 As Integer) As Integer
[1]273 If value1>value2 then
274 return value1
275 Else
276 return value2
277 End If
278 End Function
279
[244]280 Static Function Max(value1 As DWord, value2 As DWord) As DWord
[1]281 If value1>value2 then
282 return value1
283 Else
284 return value2
285 End If
286 End Function
287
[244]288 Static Function Max(value1 As Long, value2 As Long) As Long
[1]289 If value1>value2 then
290 return value1
291 Else
292 return value2
293 End If
294 End Function
295
[244]296 Static Function Max(value1 As QWord, value2 As QWord) As QWord
[1]297 If value1>value2 then
298 return value1
299 Else
300 return value2
301 End If
302 End Function
303
[244]304 Static Function Max(value1 As Int64, value2 As Int64) As Int64
[1]305 If value1>value2 then
306 return value1
307 Else
308 return value2
309 End If
310 End Function
311
[244]312 Static Function Max(value1 As Single, value2 As Single) As Single
[1]313 If value1>value2 then
314 return value1
315 Else
316 return value2
317 End If
318 End Function
319
[244]320 Static Function Max(value1 As Double, value2 As Double) As Double
[1]321 If value1>value2 then
322 return value1
323 Else
324 return value2
325 End If
326 End Function
327
[244]328 Static Function Min(value1 As Byte, value2 As Byte) As Byte
[1]329 If value1<value2 then
330 return value1
331 Else
332 return value2
333 End If
334 End Function
335
[244]336 Static Function Min(value1 As SByte, value2 As SByte) As SByte
[1]337 If value1<value2 then
338 return value1
339 Else
340 return value2
341 End If
342 End Function
343
[244]344 Static Function Min(value1 As Word, value2 As Word) As Word
[1]345 If value1<value2 then
346 return value1
347 Else
348 return value2
349 End If
350 End Function
351
[244]352 Static Function Min(value1 As Integer, value2 As Integer) As Integer
[1]353 If value1<value2 then
354 return value1
355 Else
356 return value2
357 End If
358 End Function
359
[244]360 Static Function Min(value1 As DWord, value2 As DWord) As DWord
[1]361 If value1<value2 then
362 return value1
363 Else
364 return value2
365 End If
366 End Function
367
[244]368 Static Function Min(value1 As Long, value2 As Long) As Long
[1]369 If value1<value2 then
370 return value1
371 Else
372 return value2
373 End If
374 End Function
375
[244]376 Static Function Min(value1 As QWord, value2 As QWord) As QWord
[1]377 If value1<value2 then
378 return value1
379 Else
380 return value2
381 End If
382 End Function
383
[244]384 Static Function Min(value1 As Int64, value2 As Int64) As Int64
[1]385 If value1<value2 then
386 return value1
387 Else
388 return value2
389 End If
390 End Function
391
[244]392 Static Function Min(value1 As Single, value2 As Single) As Single
[1]393 If value1<value2 then
394 return value1
395 Else
396 return value2
397 End If
398 End Function
399
[244]400 Static Function Min(value1 As Double, value2 As Double) As Double
[1]401 If value1<value2 then
402 return value1
403 Else
404 return value2
405 End If
406 End Function
407
[14]408 Static Function Pow(x As Double, y As Double) As Double
409 return pow(x, y)
[1]410 End Function
411
412 'ReferenceEquals
413
414 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
415 If value+0.5<>Int(value+0.5) then
416 value=Int(value+0.5)
417 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
418 value=Int(value+0.5)
419 Else
420 value=Int(value-0.5)
421 End If
422 End Function
423
424 Static Function Sign(value As Double) As Long
425 If value = 0 then
426 return 0
427 ElseIf value > 0 then
428 return 1
429 Else
430 return -1
431 End If
432 End Function
433
[162]434 Static Function Sign(value As SByte) As Long
[1]435 If value = 0 then
436 return 0
437 ElseIf value > 0 then
438 return 1
439 Else
440 return -1
441 End If
442 End Function
443
444 Static Function Sign(value As Integer) As Long
445 If value = 0 then
446 return 0
447 ElseIf value > 0 then
448 return 1
449 Else
450 return -1
451 End If
452 End Function
453
454 Static Function Sign(value As Long) As Long
455 If value = 0 then
456 return 0
457 ElseIf value > 0 then
458 return 1
459 Else
460 return -1
461 End If
462 End Function
463
464 Static Function Sign(value As Int64) As Long
465 If value = 0 then
466 return 0
467 ElseIf value > 0 then
468 return 1
469 Else
470 return -1
471 End If
472 End Function
473
474 Static Function Sign(value As Single) As Long
475 If value = 0 then
476 return 0
477 ElseIf value > 0 then
478 return 1
479 Else
480 return -1
481 End If
482 End Function
483
484 Static Function Sin(value As Double) As Double
[268]485 If ActiveBasic.Math.IsNaN(value) Then
[53]486 Return value
[268]487 ElseIf ActiveBasic.Math.IsInf(value) Then
488 Return ActiveBasic.Math.Detail.GetNaN()
[1]489 Exit Function
490 End If
491
[53]492 Dim k As Long
[1]493 Dim t As Double
494
[92]495 t = urTan((value * 0.5) As Double, k)
[1]496 t = 2 * t / (1 + t * t)
497 If (k And 1) = 0 Then 'k mod 2 = 0 Then
498 Return t
499 Else
500 Return -t
501 End If
502 End Function
503
504 Static Function Sinh(x As Double) As Double
[124]505 If Math.Abs(x) > _System_EPS5 Then
[1]506 Dim t As Double
[233]507 t = Math.Exp(x)
[1]508 Return (t - 1 / t) * 0.5
509 Else
510 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
511 End If
512 End Function
513
514 Static Function Sqrt(x As Double) As Double
515 Dim s As Double, last As Double
516 Dim i As *Word, j As Long, jj As Long, k As Long
[14]517 If x > 0 Then
[268]518 If ActiveBasic.Math.IsInf(x) Then
[1]519 Sqrt = x
520 Else
521 Sqrt = x
522 i = (VarPtr(Sqrt) + 6) As *Word
523 jj = GetWord(i)
524 j = jj >> 5
525 k = jj And &h0000001f
526 j = (j+ 511) << 4 + k
527 SetWord(i, j)
528 Do
529 last = Sqrt
530 Sqrt = (x /Sqrt + Sqrt) * 0.5
[23]531 Loop While Sqrt <> last
[1]532 End If
[14]533 ElseIf x < 0 Then
[268]534 Sqrt = ActiveBasic.Math.Detail.GetNaN()
[1]535 Else
536 'x = 0 Or NaN
537 Sqrt = x
538 End If
539 End Function
540
[14]541 Static Function Tan(x As Double) As Double
[268]542 If ActiveBasic.Math.IsNaN(x) Then
[14]543 Tan = x
[1]544 Exit Function
[268]545 ElseIf ActiveBasic.Math.IsInf(x) Then
546 Tan = ActiveBasic.Math.Detail.GetNaN()
[1]547 Exit Function
548 End If
549
550 Dim k As Long
551 Dim t As Double
552 t = urTan(x, k)
553 If (k And 1) = 0 Then 'k mod 2 = 0 Then
554 Return t
555 ElseIf t <> 0 Then
556 Return -1 / t
557 Else
[268]558 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
[1]559 End If
560 End Function
561
562 Static Function Tanh(x As Double) As Double
563 If x > _System_EPS5 Then
[233]564 Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]565 ElseIf x < -_System_EPS5 Then
[233]566 Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]567 Else
568 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
569 End If
570 End Function
571
[92]572 'ToString
573
[1]574 Static Function Truncate(x As Double) As Double
[237]575 Return Fix(x)
[1]576 End Function
577
[92]578'Private
[1]579 Static Function urTan(x As Double, ByRef k As Long) As Double
580 Dim i As Long
581 Dim t As Double, x2 As Double
582
583 If x >= 0 Then
[233]584 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]585 Else
[233]586 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]587 End If
588 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
589 x2 = x * x
590 t = 0
591 For i = _System_UrTan_N To 3 Step -2
592 t = x2 / (i - t)
593 Next i
594 urTan = x / (1 - t)
595 End Function
[238]596Private
597 Static Const _System_Atan_N = 20 As Long
598 Static Const _System_UrTan_N = 17 As Long
599 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
600 Static Const _System_EPS5 = 0.001 As Double
[1]601End Class
602
[268]603End Namespace
604
[1]605Const _System_HalfPI = (_System_PI * 0.5)
606Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[244]607Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
608Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
[1]609
[20]610#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.