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
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 SetQWord(VarPtr(value), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
20 End Function
21
22 Static Function Abs(value As Single) As Single
23 SetDWord(VarPtr(value), GetDWord(VarPtr(value)) And &h7fffffff)
24 End Function
25
26 Static Function Abs(value As SByte) As SByte
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
62 Acos = _System_HalfPI - Asin(x)
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
70 Asin = Math.Atan(x / Sqrt(1 - x * x))
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
98 t = i * x
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
117 Atan2 += CopySign(_System_PI, y)
118 End If
119 End If
120 End Function
121
122 Static Function BigMul(x As Long, y As Long) As Int64
123 Return (x As Int64) * y
124 End Function
125
126 Static Function Ceiling(x As Double) As Long
127 If Floor(x) = x then
128 Return x As Long
129 Else
130 Return Floor(x) + 1
131 End If
132 End Function
133
134 Static Function Cos(x As Double) As Double
135 If IsNaN(x) Then
136 Return x
137 ElseIf IsInf(x) Then
138 Return _System_GetNaN()
139 End If
140
141 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
142 End Function
143
144 Static Function Cosh(value As Double) As Double
145 Dim t As Double
146 t = Math.Exp(value)
147 return (t + 1 / t) * 0.5
148 End Function
149
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
153 End Function
154
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
158 End Function
159
160 'Equals
161
162 Static Function Exp(x As Double) As Double
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
176 k = Fix(x / _System_LOG2 + 0.5)
177 Else
178 k = Fix(x / _System_LOG2 - 0.5)
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
196 Return Int(value)
197 End Function
198
199 'GetHashCode
200
201 'GetType
202
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)
211 Else
212 q = Int(q - 0.5)
213 End If
214 End If
215 If x - y * q = 0 Then
216 If x > 0 Then
217 Return +0
218 Else
219 Return -0
220 End If
221 Else
222 Return x-y*q
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
253 Return Math.Log(x) / _System_Ln10
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
264 Static Function Max(value1 As SByte,value2 As SByte) As SByte
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
344 Static Function Min(value1 As SByte,value2 As SByte) As SByte
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
416 Static Function Pow(x As Double, y As Double) As Double
417 return pow(x, y)
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
442 Static Function Sign(value As SByte) As Long
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
493 If IsNaN(value) Then
494 Return value
495 ElseIf IsInf(value) Then
496 Return _System_GetNaN()
497 Exit Function
498 End If
499
500 Dim k As Long
501 Dim t As Double
502
503 t = urTan((value * 0.5) As Double, k)
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
513 If Math.Abs(x) > _System_EPS5 Then
514 Dim t As Double
515 t = Math.Exp(x)
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
525 If x > 0 Then
526 If IsInf(x) Then
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
539 Loop While Sqrt <> last
540 End If
541 ElseIf x < 0 Then
542 Sqrt = _System_GetNaN()
543 Else
544 'x = 0 Or NaN
545 Sqrt = x
546 End If
547 End Function
548
549 Static Function Tan(x As Double) As Double
550 If IsNaN(x) Then
551 Tan = x
552 Exit Function
553 ElseIf IsInf(x) Then
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
572 Return 2 / (1 + Math.Exp(-2 * x)) - 1
573 ElseIf x < -_System_EPS5 Then
574 Return 1 - 2 / (Math.Exp(2 * x) + 1)
575 Else
576 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
577 End If
578 End Function
579
580 'ToString
581
582 Static Function Truncate(x As Double) As Double
583 Return Fix(x)
584 End Function
585
586'Private
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
592 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
593 Else
594 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
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
609Const _System_D = 4.4544551033807686783083602485579e-6
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.