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

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

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