source: Include/Classes/System/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
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 = p[0] And &h7FF0000000000000
235 Dim k = ((m >> 52) As DWord) As Long - 1022
236 p[0] = m + &h0010000000000000
237 x /= tmp
238
239 x--
240 Dim s = 0 As Double
241 Dim i = _System_Log_N As Long
242 While i >= 1
243 Dim t = (i * x) As Double
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
252 Return Math.Log(x) * _System_InverseLn10
253 End Function
254
255 Static Function Max(value1 As Byte, value2 As Byte) As Byte
256 If value1>value2 then
257 return value1
258 Else
259 return value2
260 End If
261 End Function
262
263 Static Function Max(value1 As SByte, value2 As SByte) As SByte
264 If value1>value2 then
265 return value1
266 Else
267 return value2
268 End If
269 End Function
270
271 Static Function Max(value1 As Word, value2 As Word) As Word
272 If value1>value2 then
273 return value1
274 Else
275 return value2
276 End If
277 End Function
278
279 Static Function Max(value1 As Integer, value2 As Integer) As Integer
280 If value1>value2 then
281 return value1
282 Else
283 return value2
284 End If
285 End Function
286
287 Static Function Max(value1 As DWord, value2 As DWord) As DWord
288 If value1>value2 then
289 return value1
290 Else
291 return value2
292 End If
293 End Function
294
295 Static Function Max(value1 As Long, value2 As Long) As Long
296 If value1>value2 then
297 return value1
298 Else
299 return value2
300 End If
301 End Function
302
303 Static Function Max(value1 As QWord, value2 As QWord) As QWord
304 If value1>value2 then
305 return value1
306 Else
307 return value2
308 End If
309 End Function
310
311 Static Function Max(value1 As Int64, value2 As Int64) As Int64
312 If value1>value2 then
313 return value1
314 Else
315 return value2
316 End If
317 End Function
318
319 Static Function Max(value1 As Single, value2 As Single) As Single
320 If value1>value2 then
321 return value1
322 Else
323 return value2
324 End If
325 End Function
326
327 Static Function Max(value1 As Double, value2 As Double) As Double
328 If value1>value2 then
329 return value1
330 Else
331 return value2
332 End If
333 End Function
334
335 Static Function Min(value1 As Byte, value2 As Byte) As Byte
336 If value1<value2 then
337 return value1
338 Else
339 return value2
340 End If
341 End Function
342
343 Static Function Min(value1 As SByte, value2 As SByte) As SByte
344 If value1<value2 then
345 return value1
346 Else
347 return value2
348 End If
349 End Function
350
351 Static Function Min(value1 As Word, value2 As Word) As Word
352 If value1<value2 then
353 return value1
354 Else
355 return value2
356 End If
357 End Function
358
359 Static Function Min(value1 As Integer, value2 As Integer) As Integer
360 If value1<value2 then
361 return value1
362 Else
363 return value2
364 End If
365 End Function
366
367 Static Function Min(value1 As DWord, value2 As DWord) As DWord
368 If value1<value2 then
369 return value1
370 Else
371 return value2
372 End If
373 End Function
374
375 Static Function Min(value1 As Long, value2 As Long) As Long
376 If value1<value2 then
377 return value1
378 Else
379 return value2
380 End If
381 End Function
382
383 Static Function Min(value1 As QWord, value2 As QWord) As QWord
384 If value1<value2 then
385 return value1
386 Else
387 return value2
388 End If
389 End Function
390
391 Static Function Min(value1 As Int64, value2 As Int64) As Int64
392 If value1<value2 then
393 return value1
394 Else
395 return value2
396 End If
397 End Function
398
399 Static Function Min(value1 As Single, value2 As Single) As Single
400 If value1<value2 then
401 return value1
402 Else
403 return value2
404 End If
405 End Function
406
407 Static Function Min(value1 As Double, value2 As Double) As Double
408 If value1<value2 then
409 return value1
410 Else
411 return value2
412 End If
413 End Function
414
415 Static Function Pow(x As Double, y As Double) As Double
416 return pow(x, y)
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
441 Static Function Sign(value As SByte) As Long
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
492 If IsNaN(value) Then
493 Return value
494 ElseIf IsInf(value) Then
495 Return _System_GetNaN()
496 Exit Function
497 End If
498
499 Dim k As Long
500 Dim t As Double
501
502 t = urTan((value * 0.5) As Double, k)
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
512 If Math.Abs(x) > _System_EPS5 Then
513 Dim t As Double
514 t = Math.Exp(x)
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
524 If x > 0 Then
525 If IsInf(x) Then
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
538 Loop While Sqrt <> last
539 End If
540 ElseIf x < 0 Then
541 Sqrt = _System_GetNaN()
542 Else
543 'x = 0 Or NaN
544 Sqrt = x
545 End If
546 End Function
547
548 Static Function Tan(x As Double) As Double
549 If IsNaN(x) Then
550 Tan = x
551 Exit Function
552 ElseIf IsInf(x) Then
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
571 Return 2 / (1 + Math.Exp(-2 * x)) - 1
572 ElseIf x < -_System_EPS5 Then
573 Return 1 - 2 / (Math.Exp(2 * x) + 1)
574 Else
575 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
576 End If
577 End Function
578
579 'ToString
580
581 Static Function Truncate(x As Double) As Double
582 Return Fix(x)
583 End Function
584
585'Private
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
591 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
592 Else
593 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
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
603Private
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
609End Class
610
611Const _System_HalfPI = (_System_PI * 0.5)
612Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
613Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
614Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
615
616
617#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.