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

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

すみません、[238]では肝心の修正箇所が含まれていませんでした。今度こそMath.Absの修正です。
File size: 12.2 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 i As Long, k As Long
233 Dim s As Double, t As Double
234 frexp(x / _System_SQRT2, k)
235 x /= ldexp(1, k)
236
237 x--
238 s = 0
239 i = _System_Log_N
240 While i >= 1
241 t = i * x
242 s = t / (2 + t / (2 * i + 1 + s))
243 i--
244 Wend
245
246 Log = _System_LOG2 * k + x / (1 + s)
247 End If
248 End Function
249
250 Static Function Log10(x As Double) As Double
251 Return Math.Log(x) / _System_Ln10
252 End Function
253
254 Static Function Max(value1 As Byte,value2 As Byte) As Byte
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 SByte,value2 As SByte) As SByte
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 Word,value2 As Word) As Word
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 Integer,value2 As Integer) As Integer
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 DWord,value2 As DWord) As DWord
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 Long,value2 As Long) As Long
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 QWord,value2 As QWord) As QWord
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 Int64,value2 As Int64) As Int64
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 Single,value2 As Single) As Single
319 If value1>value2 then
320 return value1
321 Else
322 return value2
323 End If
324 End Function
325
326 Static Function Max(value1 As Double,value2 As Double) As Double
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 Byte,value2 As Byte) As Byte
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 SByte,value2 As SByte) As SByte
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 Word,value2 As Word) As Word
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 Integer,value2 As Integer) As Integer
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 DWord,value2 As DWord) As DWord
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 Long,value2 As Long) As Long
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 QWord,value2 As QWord) As QWord
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 Int64,value2 As Int64) As Int64
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 Single,value2 As Single) As Single
399 If value1<value2 then
400 return value1
401 Else
402 return value2
403 End If
404 End Function
405
406 Static Function Min(value1 As Double,value2 As Double) As Double
407 If value1<value2 then
408 return value1
409 Else
410 return value2
411 End If
412 End Function
413
414 Static Function Pow(x As Double, y As Double) As Double
415 return pow(x, y)
416 End Function
417
418 'ReferenceEquals
419
420 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
421 If value+0.5<>Int(value+0.5) then
422 value=Int(value+0.5)
423 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
424 value=Int(value+0.5)
425 Else
426 value=Int(value-0.5)
427 End If
428 End Function
429
430 Static Function Sign(value As Double) As Long
431 If value = 0 then
432 return 0
433 ElseIf value > 0 then
434 return 1
435 Else
436 return -1
437 End If
438 End Function
439
440 Static Function Sign(value As SByte) As Long
441 If value = 0 then
442 return 0
443 ElseIf value > 0 then
444 return 1
445 Else
446 return -1
447 End If
448 End Function
449
450 Static Function Sign(value As Integer) As Long
451 If value = 0 then
452 return 0
453 ElseIf value > 0 then
454 return 1
455 Else
456 return -1
457 End If
458 End Function
459
460 Static Function Sign(value As Long) As Long
461 If value = 0 then
462 return 0
463 ElseIf value > 0 then
464 return 1
465 Else
466 return -1
467 End If
468 End Function
469
470 Static Function Sign(value As Int64) As Long
471 If value = 0 then
472 return 0
473 ElseIf value > 0 then
474 return 1
475 Else
476 return -1
477 End If
478 End Function
479
480 Static Function Sign(value As Single) As Long
481 If value = 0 then
482 return 0
483 ElseIf value > 0 then
484 return 1
485 Else
486 return -1
487 End If
488 End Function
489
490 Static Function Sin(value As Double) As Double
491 If IsNaN(value) Then
492 Return value
493 ElseIf IsInf(value) Then
494 Return _System_GetNaN()
495 Exit Function
496 End If
497
498 Dim k As Long
499 Dim t As Double
500
501 t = urTan((value * 0.5) As Double, k)
502 t = 2 * t / (1 + t * t)
503 If (k And 1) = 0 Then 'k mod 2 = 0 Then
504 Return t
505 Else
506 Return -t
507 End If
508 End Function
509
510 Static Function Sinh(x As Double) As Double
511 If Math.Abs(x) > _System_EPS5 Then
512 Dim t As Double
513 t = Math.Exp(x)
514 Return (t - 1 / t) * 0.5
515 Else
516 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
517 End If
518 End Function
519
520 Static Function Sqrt(x As Double) As Double
521 Dim s As Double, last As Double
522 Dim i As *Word, j As Long, jj As Long, k As Long
523 If x > 0 Then
524 If IsInf(x) Then
525 Sqrt = x
526 Else
527 Sqrt = x
528 i = (VarPtr(Sqrt) + 6) As *Word
529 jj = GetWord(i)
530 j = jj >> 5
531 k = jj And &h0000001f
532 j = (j+ 511) << 4 + k
533 SetWord(i, j)
534 Do
535 last = Sqrt
536 Sqrt = (x /Sqrt + Sqrt) * 0.5
537 Loop While Sqrt <> last
538 End If
539 ElseIf x < 0 Then
540 Sqrt = _System_GetNaN()
541 Else
542 'x = 0 Or NaN
543 Sqrt = x
544 End If
545 End Function
546
547 Static Function Tan(x As Double) As Double
548 If IsNaN(x) Then
549 Tan = x
550 Exit Function
551 ElseIf IsInf(x) Then
552 Tan = _System_GetNaN()
553 Exit Function
554 End If
555
556 Dim k As Long
557 Dim t As Double
558 t = urTan(x, k)
559 If (k And 1) = 0 Then 'k mod 2 = 0 Then
560 Return t
561 ElseIf t <> 0 Then
562 Return -1 / t
563 Else
564 Return CopySign(_System_GetInf(FALSE), -t)
565 End If
566 End Function
567
568 Static Function Tanh(x As Double) As Double
569 If x > _System_EPS5 Then
570 Return 2 / (1 + Math.Exp(-2 * x)) - 1
571 ElseIf x < -_System_EPS5 Then
572 Return 1 - 2 / (Math.Exp(2 * x) + 1)
573 Else
574 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
575 End If
576 End Function
577
578 'ToString
579
580 Static Function Truncate(x As Double) As Double
581 Return Fix(x)
582 End Function
583
584'Private
585 Static Function urTan(x As Double, ByRef k As Long) As Double
586 Dim i As Long
587 Dim t As Double, x2 As Double
588
589 If x >= 0 Then
590 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
591 Else
592 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
593 End If
594 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
595 x2 = x * x
596 t = 0
597 For i = _System_UrTan_N To 3 Step -2
598 t = x2 / (i - t)
599 Next i
600 urTan = x / (1 - t)
601 End Function
602Private
603 Static Const _System_Log_N = 7 As Long
604 Static Const _System_Atan_N = 20 As Long
605 Static Const _System_UrTan_N = 17 As Long
606 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
607 Static Const _System_EPS5 = 0.001 As Double
608End Class
609
610Const _System_HalfPI = (_System_PI * 0.5)
611Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
612Const _System_Ln10 = 2.3025850929940456840179914546844 '10の自然対数
613
614#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.