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

Last change on this file since 257 was 257, checked in by イグトランス (egtra), 18 years ago

VersionTest追加、Log1p追加
File size: 12.3 KB
Line 
1' Classes/System/Math.ab
2
3#ifndef __SYSTEM_MATH_AB__
4#define __SYSTEM_MATH_AB__
5
6Class Math
7Public
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
17 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
18 End Function
19
20 Static Function Abs(value As Single) As Single
21 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
22 End Function
23
24 Static Function Abs(value As SByte) As SByte
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
60 Acos = _System_HalfPI - Asin(x)
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
68 Asin = Math.Atan(x / Sqrt(1 - x * x))
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
96 t = i * x
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
115 Atan2 += CopySign(_System_PI, y)
116 End If
117 End If
118 End Function
119
120 Static Function BigMul(x As Long, y As Long) As Int64
121 Return (x As Int64) * y
122 End Function
123
124 Static Function Ceiling(x As Double) As Long
125 If Floor(x) = x then
126 Return x As Long
127 Else
128 Return Floor(x) + 1
129 End If
130 End Function
131
132 Static Function Cos(x As Double) As Double
133 If IsNaN(x) Then
134 Return x
135 ElseIf IsInf(x) Then
136 Return _System_GetNaN()
137 End If
138
139 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
140 End Function
141
142 Static Function Cosh(value As Double) As Double
143 Dim t As Double
144 t = Math.Exp(value)
145 return (t + 1 / t) * 0.5
146 End Function
147
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
151 End Function
152
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
156 End Function
157
158 'Equals
159
160 Static Function Exp(x As Double) As Double
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
174 k = Fix(x / _System_LOG2 + 0.5)
175 Else
176 k = Fix(x / _System_LOG2 - 0.5)
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
194 Return Int(value)
195 End Function
196
197 'GetHashCode
198
199 'GetType
200
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)
209 Else
210 q = Int(q - 0.5)
211 End If
212 End If
213 If x - y * q = 0 Then
214 If x > 0 Then
215 Return +0
216 Else
217 Return -0
218 End If
219 Else
220 Return x-y*q
221 End If
222 End Function
223
224 Static Function Log(x As Double) As Double
225 If x = 0 Then
226 Log = _System_GetInf(True)
227 ElseIf x < 0 Or IsNaN(x) Then
228 Log = _System_GetNaN()
229 ElseIf IsInf(x) Then
230 Log = x
231 Else
232 Dim tmp = x * _System_InverseSqrt2
233 Dim p = VarPtr(tmp) As *QWord
234 Dim m = GetQWord(p) And &h7FF0000000000000
235 Dim k = ((m >> 52) As DWord) As Long - 1022
236 SetQWord(p, m + &h0010000000000000)
237 x /= tmp
238 Log = _System_LOG2 * k + _System_Log1p(x - 1)
239 End If
240 End Function
241
242 Static Function Log10(x As Double) As Double
243 Return Math.Log(x) * _System_InverseLn10
244 End Function
245
246 Static Function Max(value1 As Byte, value2 As Byte) As Byte
247 If value1>value2 then
248 return value1
249 Else
250 return value2
251 End If
252 End Function
253
254 Static Function Max(value1 As SByte, value2 As SByte) As SByte
255 If value1>value2 then
256 return value1
257 Else
258 return value2
259 End If
260 End Function
261
262 Static Function Max(value1 As Word, value2 As Word) As Word
263 If value1>value2 then
264 return value1
265 Else
266 return value2
267 End If
268 End Function
269
270 Static Function Max(value1 As Integer, value2 As Integer) As Integer
271 If value1>value2 then
272 return value1
273 Else
274 return value2
275 End If
276 End Function
277
278 Static Function Max(value1 As DWord, value2 As DWord) As DWord
279 If value1>value2 then
280 return value1
281 Else
282 return value2
283 End If
284 End Function
285
286 Static Function Max(value1 As Long, value2 As Long) As Long
287 If value1>value2 then
288 return value1
289 Else
290 return value2
291 End If
292 End Function
293
294 Static Function Max(value1 As QWord, value2 As QWord) As QWord
295 If value1>value2 then
296 return value1
297 Else
298 return value2
299 End If
300 End Function
301
302 Static Function Max(value1 As Int64, value2 As Int64) As Int64
303 If value1>value2 then
304 return value1
305 Else
306 return value2
307 End If
308 End Function
309
310 Static Function Max(value1 As Single, value2 As Single) As Single
311 If value1>value2 then
312 return value1
313 Else
314 return value2
315 End If
316 End Function
317
318 Static Function Max(value1 As Double, value2 As Double) As Double
319 If value1>value2 then
320 return value1
321 Else
322 return value2
323 End If
324 End Function
325
326 Static Function Min(value1 As Byte, value2 As Byte) As Byte
327 If value1<value2 then
328 return value1
329 Else
330 return value2
331 End If
332 End Function
333
334 Static Function Min(value1 As SByte, value2 As SByte) As SByte
335 If value1<value2 then
336 return value1
337 Else
338 return value2
339 End If
340 End Function
341
342 Static Function Min(value1 As Word, value2 As Word) As Word
343 If value1<value2 then
344 return value1
345 Else
346 return value2
347 End If
348 End Function
349
350 Static Function Min(value1 As Integer, value2 As Integer) As Integer
351 If value1<value2 then
352 return value1
353 Else
354 return value2
355 End If
356 End Function
357
358 Static Function Min(value1 As DWord, value2 As DWord) As DWord
359 If value1<value2 then
360 return value1
361 Else
362 return value2
363 End If
364 End Function
365
366 Static Function Min(value1 As Long, value2 As Long) As Long
367 If value1<value2 then
368 return value1
369 Else
370 return value2
371 End If
372 End Function
373
374 Static Function Min(value1 As QWord, value2 As QWord) As QWord
375 If value1<value2 then
376 return value1
377 Else
378 return value2
379 End If
380 End Function
381
382 Static Function Min(value1 As Int64, value2 As Int64) As Int64
383 If value1<value2 then
384 return value1
385 Else
386 return value2
387 End If
388 End Function
389
390 Static Function Min(value1 As Single, value2 As Single) As Single
391 If value1<value2 then
392 return value1
393 Else
394 return value2
395 End If
396 End Function
397
398 Static Function Min(value1 As Double, value2 As Double) As Double
399 If value1<value2 then
400 return value1
401 Else
402 return value2
403 End If
404 End Function
405
406 Static Function Pow(x As Double, y As Double) As Double
407 return pow(x, y)
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
432 Static Function Sign(value As SByte) As Long
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
483 If IsNaN(value) Then
484 Return value
485 ElseIf IsInf(value) Then
486 Return _System_GetNaN()
487 Exit Function
488 End If
489
490 Dim k As Long
491 Dim t As Double
492
493 t = urTan((value * 0.5) As Double, k)
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
503 If Math.Abs(x) > _System_EPS5 Then
504 Dim t As Double
505 t = Math.Exp(x)
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
515 If x > 0 Then
516 If IsInf(x) Then
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
529 Loop While Sqrt <> last
530 End If
531 ElseIf x < 0 Then
532 Sqrt = _System_GetNaN()
533 Else
534 'x = 0 Or NaN
535 Sqrt = x
536 End If
537 End Function
538
539 Static Function Tan(x As Double) As Double
540 If IsNaN(x) Then
541 Tan = x
542 Exit Function
543 ElseIf IsInf(x) Then
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
562 Return 2 / (1 + Math.Exp(-2 * x)) - 1
563 ElseIf x < -_System_EPS5 Then
564 Return 1 - 2 / (Math.Exp(2 * x) + 1)
565 Else
566 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
567 End If
568 End Function
569
570 'ToString
571
572 Static Function Truncate(x As Double) As Double
573 Return Fix(x)
574 End Function
575
576'Private
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
582 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
583 Else
584 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
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
594Private
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
599End Class
600
601Const _System_HalfPI = (_System_PI * 0.5)
602Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
603Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
604Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
605
606
607#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.