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
RevLine 
[14]1' Classes/System/Math.ab
[1]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
[239]17 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
[1]18 End Function
19
20 Static Function Abs(value As Single) As Single
[239]21 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
[1]22 End Function
23
[162]24 Static Function Abs(value As SByte) As SByte
[1]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
[232]60 Acos = _System_HalfPI - Asin(x)
[1]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
[233]68 Asin = Math.Atan(x / Sqrt(1 - x * x))
[1]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
[14]96 t = i * x
[1]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
[91]115 Atan2 += CopySign(_System_PI, y)
[1]116 End If
117 End If
118 End Function
119
[14]120 Static Function BigMul(x As Long, y As Long) As Int64
121 Return (x As Int64) * y
[1]122 End Function
123
124 Static Function Ceiling(x As Double) As Long
125 If Floor(x) = x then
[233]126 Return x As Long
[1]127 Else
128 Return Floor(x) + 1
129 End If
130 End Function
131
[14]132 Static Function Cos(x As Double) As Double
133 If IsNaN(x) Then
134 Return x
135 ElseIf IsInf(x) Then
[1]136 Return _System_GetNaN()
137 End If
138
[124]139 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
[1]140 End Function
141
142 Static Function Cosh(value As Double) As Double
143 Dim t As Double
[233]144 t = Math.Exp(value)
[1]145 return (t + 1 / t) * 0.5
146 End Function
147
[14]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
[1]151 End Function
152
[14]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
[1]156 End Function
157
158 'Equals
159
[14]160 Static Function Exp(x As Double) As Double
[1]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
[14]174 k = Fix(x / _System_LOG2 + 0.5)
[1]175 Else
[14]176 k = Fix(x / _System_LOG2 - 0.5)
[1]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
[237]194 Return Int(value)
[1]195 End Function
196
197 'GetHashCode
198
199 'GetType
200
[237]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)
[1]209 Else
[237]210 q = Int(q - 0.5)
[1]211 End If
212 End If
[237]213 If x - y * q = 0 Then
214 If x > 0 Then
215 Return +0
[1]216 Else
[237]217 Return -0
[1]218 End If
219 Else
[237]220 Return x-y*q
[1]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
[237]251 Return Math.Log(x) / _System_Ln10
[1]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
[162]262 Static Function Max(value1 As SByte,value2 As SByte) As SByte
[1]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
[162]342 Static Function Min(value1 As SByte,value2 As SByte) As SByte
[1]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
[14]414 Static Function Pow(x As Double, y As Double) As Double
415 return pow(x, y)
[1]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
[162]440 Static Function Sign(value As SByte) As Long
[1]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
[53]491 If IsNaN(value) Then
492 Return value
493 ElseIf IsInf(value) Then
[1]494 Return _System_GetNaN()
495 Exit Function
496 End If
497
[53]498 Dim k As Long
[1]499 Dim t As Double
500
[92]501 t = urTan((value * 0.5) As Double, k)
[1]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
[124]511 If Math.Abs(x) > _System_EPS5 Then
[1]512 Dim t As Double
[233]513 t = Math.Exp(x)
[1]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
[14]523 If x > 0 Then
524 If IsInf(x) Then
[1]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
[23]537 Loop While Sqrt <> last
[1]538 End If
[14]539 ElseIf x < 0 Then
[23]540 Sqrt = _System_GetNaN()
[1]541 Else
542 'x = 0 Or NaN
543 Sqrt = x
544 End If
545 End Function
546
[14]547 Static Function Tan(x As Double) As Double
548 If IsNaN(x) Then
549 Tan = x
[1]550 Exit Function
[14]551 ElseIf IsInf(x) Then
[1]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
[233]570 Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]571 ElseIf x < -_System_EPS5 Then
[233]572 Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]573 Else
574 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
575 End If
576 End Function
577
[92]578 'ToString
579
[1]580 Static Function Truncate(x As Double) As Double
[237]581 Return Fix(x)
[1]582 End Function
583
[92]584'Private
[1]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
[233]590 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]591 Else
[233]592 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]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
[238]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
[1]608End Class
609
610Const _System_HalfPI = (_System_PI * 0.5)
611Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[237]612Const _System_Ln10 = 2.3025850929940456840179914546844 '10の自然対数
[1]613
[20]614#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.