source: trunk/Include/Classes/System/Math.ab@ 475

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

(SPrintF.ab) FormatIntegerExにStringBuilderを引数に取る版を追加。
File size: 12.7 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 Ceiling = Floor(x)
130 If Ceiling <> x Then
131 Ceiling++
132 End If
133 End Function
134
135 Static Function Cos(x As Double) As Double
136 If ActiveBasic.Math.IsNaN(x) Then
137 Return x
138 ElseIf ActiveBasic.Math.IsInf(x) Then
139 Return ActiveBasic.Math.Detail.GetNaN()
140 End If
141
142 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
143 End Function
144
145 Static Function Cosh(value As Double) As Double
146 Dim 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 DivRem = x \ y
157 ret = x - (DivRem) * y
158 End Function
159
160 'Equals
161
162 Static Function Exp(x As Double) As Double
163 If ActiveBasic.Math.IsNaN(x) Then
164 Return x
165 Else If ActiveBasic.Math.IsInf(x) Then
166 If 0 > x Then
167 Return 0
168 Else
169 Return x
170 End If
171 End If
172 Dim k As Long
173 If x >= 0 Then
174 k = Fix(x / _System_LOG2 + 0.5)
175 Else
176 k = Fix(x / _System_LOG2 - 0.5)
177 End If
178
179 x -= k * _System_LOG2
180
181 Dim x2 = x * x
182 Dim w = x2 / 22
183
184 Dim 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
194 Return Int(value)
195 End Function
196
197 Static Function IEEERemainder(x As Double, y As Double) As Double
198 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
199 Dim q = x / y
200 If q <> Int(q) Then
201 If q + 0.5 <> Int(q + 0.5) Then
202 q = Int(q + 0.5)
203 ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then
204 q = Int(q + 0.5)
205 Else
206 q = Int(q - 0.5)
207 End If
208 End If
209 If x - y * q = 0 Then
210 If x > 0 Then
211 Return +0
212 Else
213 Return -0
214 End If
215 Else
216 Return x-y*q
217 End If
218 End Function
219
220 Static Function Log(x As Double) As Double
221 If x = 0 Then
222 Log = ActiveBasic.Math.Detail.GetInf(True)
223 ElseIf x < 0 Or ActiveBasic.Math.IsNaN(x) Then
224 Log = ActiveBasic.Math.Detail.GetNaN()
225 ElseIf ActiveBasic.Math.IsInf(x) Then
226 Log = x
227 Else
228 Dim tmp = x * _System_InverseSqrt2
229 Dim p = VarPtr(tmp) As *QWord
230 Dim m = GetQWord(p) And &h7FF0000000000000
231 Dim k = ((m >> 52) As DWord) As Long - 1022
232 SetQWord(p, m + &h0010000000000000)
233 x /= tmp
234 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
235 End If
236 End Function
237
238 Static Function Log10(x As Double) As Double
239 Return Math.Log(x) * _System_InverseLn10
240 End Function
241
242 Static Function Max(value1 As Byte, value2 As Byte) As Byte
243 If value1>value2 then
244 return value1
245 Else
246 return value2
247 End If
248 End Function
249
250 Static Function Max(value1 As SByte, value2 As SByte) As SByte
251 If value1>value2 then
252 return value1
253 Else
254 return value2
255 End If
256 End Function
257
258 Static Function Max(value1 As Word, value2 As Word) As Word
259 If value1>value2 then
260 return value1
261 Else
262 return value2
263 End If
264 End Function
265
266 Static Function Max(value1 As Integer, value2 As Integer) As Integer
267 If value1>value2 then
268 return value1
269 Else
270 return value2
271 End If
272 End Function
273
274 Static Function Max(value1 As DWord, value2 As DWord) As DWord
275 If value1>value2 then
276 return value1
277 Else
278 return value2
279 End If
280 End Function
281
282 Static Function Max(value1 As Long, value2 As Long) As Long
283 If value1>value2 then
284 return value1
285 Else
286 return value2
287 End If
288 End Function
289
290 Static Function Max(value1 As QWord, value2 As QWord) As QWord
291 If value1>value2 then
292 return value1
293 Else
294 return value2
295 End If
296 End Function
297
298 Static Function Max(value1 As Int64, value2 As Int64) As Int64
299 If value1>value2 then
300 return value1
301 Else
302 return value2
303 End If
304 End Function
305
306 Static Function Max(value1 As Single, value2 As Single) As Single
307 If value1>value2 then
308 return value1
309 Else
310 return value2
311 End If
312 End Function
313
314 Static Function Max(value1 As Double, value2 As Double) As Double
315 If value1>value2 then
316 return value1
317 Else
318 return value2
319 End If
320 End Function
321
322 Static Function Min(value1 As Byte, value2 As Byte) As Byte
323 If value1<value2 then
324 return value1
325 Else
326 return value2
327 End If
328 End Function
329
330 Static Function Min(value1 As SByte, value2 As SByte) As SByte
331 If value1<value2 then
332 return value1
333 Else
334 return value2
335 End If
336 End Function
337
338 Static Function Min(value1 As Word, value2 As Word) As Word
339 If value1<value2 then
340 return value1
341 Else
342 return value2
343 End If
344 End Function
345
346 Static Function Min(value1 As Integer, value2 As Integer) As Integer
347 If value1<value2 then
348 return value1
349 Else
350 return value2
351 End If
352 End Function
353
354 Static Function Min(value1 As DWord, value2 As DWord) As DWord
355 If value1<value2 then
356 return value1
357 Else
358 return value2
359 End If
360 End Function
361
362 Static Function Min(value1 As Long, value2 As Long) As Long
363 If value1<value2 then
364 return value1
365 Else
366 return value2
367 End If
368 End Function
369
370 Static Function Min(value1 As QWord, value2 As QWord) As QWord
371 If value1<value2 then
372 return value1
373 Else
374 return value2
375 End If
376 End Function
377
378 Static Function Min(value1 As Int64, value2 As Int64) As Int64
379 If value1<value2 then
380 return value1
381 Else
382 return value2
383 End If
384 End Function
385
386 Static Function Min(value1 As Single, value2 As Single) As Single
387 If value1<value2 then
388 return value1
389 Else
390 return value2
391 End If
392 End Function
393
394 Static Function Min(value1 As Double, value2 As Double) As Double
395 If value1<value2 then
396 return value1
397 Else
398 return value2
399 End If
400 End Function
401
402 Static Function Pow(x As Double, y As Double) As Double
403 return pow(x, y)
404 End Function
405
406 'ReferenceEquals
407
408 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
409 If value+0.5<>Int(value+0.5) then
410 value=Int(value+0.5)
411 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
412 value=Int(value+0.5)
413 Else
414 value=Int(value-0.5)
415 End If
416 End Function
417
418 Static Function Sign(value As Double) As Long
419 If value = 0 then
420 return 0
421 ElseIf value > 0 then
422 return 1
423 Else
424 return -1
425 End If
426 End Function
427
428 Static Function Sign(value As SByte) As Long
429 If value = 0 then
430 return 0
431 ElseIf value > 0 then
432 return 1
433 Else
434 return -1
435 End If
436 End Function
437
438 Static Function Sign(value As Integer) As Long
439 If value = 0 then
440 return 0
441 ElseIf value > 0 then
442 return 1
443 Else
444 return -1
445 End If
446 End Function
447
448 Static Function Sign(value As Long) As Long
449 If value = 0 then
450 return 0
451 ElseIf value > 0 then
452 return 1
453 Else
454 return -1
455 End If
456 End Function
457
458 Static Function Sign(value As Int64) As Long
459 If value = 0 then
460 return 0
461 ElseIf value > 0 then
462 return 1
463 Else
464 return -1
465 End If
466 End Function
467
468 Static Function Sign(value As Single) As Long
469 If value = 0 then
470 return 0
471 ElseIf value > 0 then
472 return 1
473 Else
474 return -1
475 End If
476 End Function
477
478 Static Function Sin(value As Double) As Double
479 If ActiveBasic.Math.IsNaN(value) Then
480 Return value
481 ElseIf ActiveBasic.Math.IsInf(value) Then
482 Return ActiveBasic.Math.Detail.GetNaN()
483 Exit Function
484 End If
485
486 Dim k As Long
487 Dim t As Double
488
489 t = urTan((value * 0.5) As Double, k)
490 t = 2 * t / (1 + t * t)
491 If (k And 1) = 0 Then 'k mod 2 = 0 Then
492 Return t
493 Else
494 Return -t
495 End If
496 End Function
497
498 Static Function Sinh(x As Double) As Double
499 If Math.Abs(x) > _System_EPS5 Then
500 Dim t As Double
501 t = Math.Exp(x)
502 Return (t - 1 / t) * 0.5
503 Else
504 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
505 End If
506 End Function
507
508 Static Function Sqrt(x As Double) As Double
509 If x > 0 Then
510 If ActiveBasic.Math.IsInf(x) Then
511 Sqrt = x
512 Else
513 Sqrt = x
514 Dim i = (VarPtr(Sqrt) + 6) As *Word
515 Dim jj = GetWord(i) As Long
516 Dim j = jj >> 5 As Long
517 Dim k = (jj And &h0000001f) As Long
518 j = (j + 511) << 4 + k
519 SetWord(i, j)
520 Dim last As Double
521 Do
522 last = Sqrt
523 Sqrt = (x / Sqrt + Sqrt) * 0.5
524 Loop While Sqrt <> last
525 End If
526 ElseIf x < 0 Then
527 Sqrt = ActiveBasic.Math.Detail.GetNaN()
528 Else
529 'x = 0 Or NaN
530 Sqrt = x
531 End If
532 End Function
533
534 Static Function Tan(x As Double) As Double
535 If ActiveBasic.Math.IsNaN(x) Then
536 Tan = x
537 Exit Function
538 ElseIf ActiveBasic.Math.IsInf(x) Then
539 Tan = ActiveBasic.Math.Detail.GetNaN()
540 Exit Function
541 End If
542
543 Dim k As Long
544 Dim t As Double
545 t = urTan(x, k)
546 If (k And 1) = 0 Then 'k mod 2 = 0 Then
547 Return t
548 ElseIf t <> 0 Then
549 Return -1 / t
550 Else
551 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
552 End If
553 End Function
554
555 Static Function Tanh(x As Double) As Double
556 If x > _System_EPS5 Then
557 Return 2 / (1 + Math.Exp(-2 * x)) - 1
558 ElseIf x < -_System_EPS5 Then
559 Return 1 - 2 / (Math.Exp(2 * x) + 1)
560 Else
561 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
562 End If
563 End Function
564
565 'ToString
566
567 Static Function Truncate(x As Double) As Double
568 Return Fix(x)
569 End Function
570
571'Private
572 Static Function urTan(x As Double, ByRef k As Long) As Double
573 Dim i As Long
574 Dim t As Double, x2 As Double
575
576 If x >= 0 Then
577 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
578 Else
579 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
580 End If
581 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
582 x2 = x * x
583 t = 0
584 For i = _System_UrTan_N To 3 Step -2
585 t = x2 / (i - t)
586 Next i
587 urTan = x / (1 - t)
588 End Function
589Private
590 Static Const _System_Atan_N = 20 As Long
591 Static Const _System_UrTan_N = 17 As Long
592 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
593 Static Const _System_EPS5 = 0.001 As Double
594End Class
595
596End Namespace
597
598Const _System_HalfPI = (_System_PI * 0.5)
599Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
600Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
601Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
602
603#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.