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

Last change on this file since 66 was 53, checked in by dai, 18 years ago

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