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

Last change on this file since 92 was 92, checked in by konisi, 16 years ago

basicフォルダ内の整備、掲示板にエラーを報告したもの以外は型チェック終了しました。
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                Atan2 += 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 Math.Sin((_System_HalfPI - Abs(x)) As Double)
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) As Double, 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    'ToString
590
591    Static Function Truncate(x As Double) As Double
592        return Fix(x)
593    End Function
594
595'Private
596    Static Function urTan(x As Double, ByRef k As Long) As Double
597        Dim i As Long
598        Dim t As Double, x2 As Double
599
600        If x >= 0 Then
601            k = Fix(x * _System_InverseHalfPI) + 0.5
602        Else
603            k = Fix(x * _System_InverseHalfPI) - 0.5
604        End If
605        x = (x - (3217.0 / 2048.0) * k) + _System_D * k
606        x2 = x * x
607        t = 0
608        For i = _System_UrTan_N To 3 Step -2
609            t = x2 / (i - t)
610        Next i
611        urTan =  x / (1 - t)
612    End Function
613End Class
614
615Const _System_Log_N = 7
616Const _System_Atan_N = 20
617Const _System_UrTan_N = 17
618Const _System_D  = 4.4544551033807686783083602485579e-6
619Const _System_HalfPI = (_System_PI * 0.5)
620Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
621
622#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.