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

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

wtypes.abを追加
File size: 12.8 KB
Line 
1' Classes/System/Math.ab
2
3#require <Classes/ActiveBasic/Math/Math.ab>
4
5#ifndef __SYSTEM_MATH_AB__
6#define __SYSTEM_MATH_AB__
7
8Namespace System
9
10Class Math
11Public
12 Static Function E() As Double
13 return 2.7182818284590452354
14 End Function
15
16 Static Function PI() As Double
17 return _System_PI
18 End Function
19
20 Static Function Abs(value As Double) As Double
21 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
22 End Function
23
24 Static Function Abs(value As Single) As Single
25 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
26 End Function
27
28 Static Function Abs(value As SByte) As SByte
29 If value<0 then
30 return -value
31 Else
32 return value
33 End If
34 End Function
35
36 Static Function Abs(value As Integer) As Integer
37 If value<0 then
38 return -value
39 Else
40 return value
41 End If
42 End Function
43
44 Static Function Abs(value As Long) As Long
45 If value<0 then
46 return -value
47 Else
48 return value
49 End If
50 End Function
51
52 Static Function Abs(value As Int64) As Int64
53 If value<0 then
54 return -value
55 Else
56 return value
57 End If
58 End Function
59
60 Static Function Acos(x As Double) As Double
61 If x < -1 Or x > 1 Then
62 Acos = ActiveBasic.Math.Detail.GetNaN()
63 Else
64 Acos = _System_HalfPI - Asin(x)
65 End If
66 End Function
67
68 Static Function Asin(x As Double) As Double
69 If x < -1 Or x > 1 Then
70 Asin = ActiveBasic.Math.Detail.GetNaN()
71 Else
72 Asin = Math.Atan(x / Sqrt(1 - x * x))
73 End If
74 End Function
75
76 Static Function Atan(x As Double) As Double
77 If ActiveBasic.Math.IsNaN(x) Then
78 Atan = x
79 Exit Function
80 ElseIf ActiveBasic.Math.IsInf(x) Then
81 Atan = ActiveBasic.Math.CopySign(_System_PI, x)
82 Exit Function
83 End If
84 Dim i As Long
85 Dim sgn As Long
86 Dim dbl = 0 As Double
87
88 If x > 1 Then
89 sgn = 1
90 x = 1 / x
91 ElseIf x < -1 Then
92 sgn = -1
93 x = 1 / x
94 Else
95 sgn = 0
96 End If
97
98 For i = _System_Atan_N To 1 Step -1
99 Dim t As Double
100 t = i * x
101 dbl = (t * t) / (2 * i + 1 + dbl)
102 Next
103
104 If sgn > 0 Then
105 Atan = _System_HalfPI - x / (1 + dbl)
106 ElseIf sgn < 0 Then
107 Atan = -_System_HalfPI - x / (1 + dbl)
108 Else
109 Atan = x / (1 + dbl)
110 End If
111 End Function
112
113 Static Function Atan2(y As Double, x As Double) As Double
114 If x = 0 Then
115 Atan2 = Sgn(y) * _System_HalfPI
116 Else
117 Atan2 = Atn(y / x)
118 If x < 0 Then
119 Atan2 += ActiveBasic.Math.CopySign(_System_PI, y)
120 End If
121 End If
122 End Function
123
124 Static Function BigMul(x As Long, y As Long) As Int64
125 Return (x As Int64) * y
126 End Function
127
128 Static Function Ceiling(x As Double) As Long
129 If Floor(x) = x then
130 Return x As Long
131 Else
132 Return Floor(x) + 1
133 End If
134 End Function
135
136 Static Function Cos(x As Double) As Double
137 If ActiveBasic.Math.IsNaN(x) Then
138 Return x
139 ElseIf ActiveBasic.Math.IsInf(x) Then
140 Return ActiveBasic.Math.Detail.GetNaN()
141 End If
142
143 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
144 End Function
145
146 Static Function Cosh(value As Double) As Double
147 Dim t As Double
148 t = Math.Exp(value)
149 return (t + 1 / t) * 0.5
150 End Function
151
152 Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long
153 ret = x Mod y
154 return x \ y
155 End Function
156
157 Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64
158 ret = x - (x \ y) * y
159 return x \ y
160 End Function
161
162 'Equals
163
164 Static Function Exp(x As Double) As Double
165 If ActiveBasic.Math.IsNaN(x) Then
166 Return x
167 Else If ActiveBasic.Math.IsInf(x) Then
168 If 0 > x Then
169 Return 0
170 Else
171 Return x
172 End If
173 End If
174 Dim k As Long
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 Dim x2 = x * x
184 Dim w = x2 / 22
185
186 Dim 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 ActiveBasic.Math.Detail.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 = ActiveBasic.Math.Detail.GetInf(True)
229 ElseIf x < 0 Or ActiveBasic.Math.IsNaN(x) Then
230 Log = ActiveBasic.Math.Detail.GetNaN()
231 ElseIf ActiveBasic.Math.IsInf(x) Then
232 Log = x
233 Else
234 Dim tmp = x * _System_InverseSqrt2
235 Dim p = VarPtr(tmp) As *QWord
236 Dim m = GetQWord(p) And &h7FF0000000000000
237 Dim k = ((m >> 52) As DWord) As Long - 1022
238 SetQWord(p, m + &h0010000000000000)
239 x /= tmp
240 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
241 End If
242 End Function
243
244 Static Function Log10(x As Double) As Double
245 Return Math.Log(x) * _System_InverseLn10
246 End Function
247
248 Static Function Max(value1 As Byte, value2 As Byte) As Byte
249 If value1>value2 then
250 return value1
251 Else
252 return value2
253 End If
254 End Function
255
256 Static Function Max(value1 As SByte, value2 As SByte) As SByte
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 Word, value2 As Word) As Word
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 Integer, value2 As Integer) As Integer
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 DWord, value2 As DWord) As DWord
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 Long, value2 As Long) As Long
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 QWord, value2 As QWord) As QWord
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 Int64, value2 As Int64) As Int64
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 Single, value2 As Single) As Single
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 Double, value2 As Double) As Double
321 If value1>value2 then
322 return value1
323 Else
324 return value2
325 End If
326 End Function
327
328 Static Function Min(value1 As Byte, value2 As Byte) As Byte
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 SByte, value2 As SByte) As SByte
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 Word, value2 As Word) As Word
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 Integer, value2 As Integer) As Integer
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 DWord, value2 As DWord) As DWord
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 Long, value2 As Long) As Long
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 QWord, value2 As QWord) As QWord
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 Int64, value2 As Int64) As Int64
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 Single, value2 As Single) As Single
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 Double, value2 As Double) As Double
401 If value1<value2 then
402 return value1
403 Else
404 return value2
405 End If
406 End Function
407
408 Static Function Pow(x As Double, y As Double) As Double
409 return pow(x, y)
410 End Function
411
412 'ReferenceEquals
413
414 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
415 If value+0.5<>Int(value+0.5) then
416 value=Int(value+0.5)
417 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
418 value=Int(value+0.5)
419 Else
420 value=Int(value-0.5)
421 End If
422 End Function
423
424 Static Function Sign(value As Double) As Long
425 If value = 0 then
426 return 0
427 ElseIf value > 0 then
428 return 1
429 Else
430 return -1
431 End If
432 End Function
433
434 Static Function Sign(value As SByte) As Long
435 If value = 0 then
436 return 0
437 ElseIf value > 0 then
438 return 1
439 Else
440 return -1
441 End If
442 End Function
443
444 Static Function Sign(value As Integer) As Long
445 If value = 0 then
446 return 0
447 ElseIf value > 0 then
448 return 1
449 Else
450 return -1
451 End If
452 End Function
453
454 Static Function Sign(value As Long) As Long
455 If value = 0 then
456 return 0
457 ElseIf value > 0 then
458 return 1
459 Else
460 return -1
461 End If
462 End Function
463
464 Static Function Sign(value As Int64) As Long
465 If value = 0 then
466 return 0
467 ElseIf value > 0 then
468 return 1
469 Else
470 return -1
471 End If
472 End Function
473
474 Static Function Sign(value As Single) As Long
475 If value = 0 then
476 return 0
477 ElseIf value > 0 then
478 return 1
479 Else
480 return -1
481 End If
482 End Function
483
484 Static Function Sin(value As Double) As Double
485 If ActiveBasic.Math.IsNaN(value) Then
486 Return value
487 ElseIf ActiveBasic.Math.IsInf(value) Then
488 Return ActiveBasic.Math.Detail.GetNaN()
489 Exit Function
490 End If
491
492 Dim k As Long
493 Dim t As Double
494
495 t = urTan((value * 0.5) As Double, k)
496 t = 2 * t / (1 + t * t)
497 If (k And 1) = 0 Then 'k mod 2 = 0 Then
498 Return t
499 Else
500 Return -t
501 End If
502 End Function
503
504 Static Function Sinh(x As Double) As Double
505 If Math.Abs(x) > _System_EPS5 Then
506 Dim t As Double
507 t = Math.Exp(x)
508 Return (t - 1 / t) * 0.5
509 Else
510 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
511 End If
512 End Function
513
514 Static Function Sqrt(x As Double) As Double
515 Dim s As Double, last As Double
516 Dim i As *Word, j As Long, jj As Long, k As Long
517 If x > 0 Then
518 If ActiveBasic.Math.IsInf(x) Then
519 Sqrt = x
520 Else
521 Sqrt = x
522 i = (VarPtr(Sqrt) + 6) As *Word
523 jj = GetWord(i)
524 j = jj >> 5
525 k = jj And &h0000001f
526 j = (j+ 511) << 4 + k
527 SetWord(i, j)
528 Do
529 last = Sqrt
530 Sqrt = (x /Sqrt + Sqrt) * 0.5
531 Loop While Sqrt <> last
532 End If
533 ElseIf x < 0 Then
534 Sqrt = ActiveBasic.Math.Detail.GetNaN()
535 Else
536 'x = 0 Or NaN
537 Sqrt = x
538 End If
539 End Function
540
541 Static Function Tan(x As Double) As Double
542 If ActiveBasic.Math.IsNaN(x) Then
543 Tan = x
544 Exit Function
545 ElseIf ActiveBasic.Math.IsInf(x) Then
546 Tan = ActiveBasic.Math.Detail.GetNaN()
547 Exit Function
548 End If
549
550 Dim k As Long
551 Dim t As Double
552 t = urTan(x, k)
553 If (k And 1) = 0 Then 'k mod 2 = 0 Then
554 Return t
555 ElseIf t <> 0 Then
556 Return -1 / t
557 Else
558 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
559 End If
560 End Function
561
562 Static Function Tanh(x As Double) As Double
563 If x > _System_EPS5 Then
564 Return 2 / (1 + Math.Exp(-2 * x)) - 1
565 ElseIf x < -_System_EPS5 Then
566 Return 1 - 2 / (Math.Exp(2 * x) + 1)
567 Else
568 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
569 End If
570 End Function
571
572 'ToString
573
574 Static Function Truncate(x As Double) As Double
575 Return Fix(x)
576 End Function
577
578'Private
579 Static Function urTan(x As Double, ByRef k As Long) As Double
580 Dim i As Long
581 Dim t As Double, x2 As Double
582
583 If x >= 0 Then
584 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
585 Else
586 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
587 End If
588 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
589 x2 = x * x
590 t = 0
591 For i = _System_UrTan_N To 3 Step -2
592 t = x2 / (i - t)
593 Next i
594 urTan = x / (1 - t)
595 End Function
596Private
597 Static Const _System_Atan_N = 20 As Long
598 Static Const _System_UrTan_N = 17 As Long
599 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
600 Static Const _System_EPS5 = 0.001 As Double
601End Class
602
603End Namespace
604
605Const _System_HalfPI = (_System_PI * 0.5)
606Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
607Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
608Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
609
610#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.