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

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

(SPrintF.ab) FormatIntegerExにStringBuilderを引数に取る版を追加。
File size: 12.7 KB
RevLine 
[14]1' Classes/System/Math.ab
[1]2
[268]3#require <Classes/ActiveBasic/Math/Math.ab>
4
[1]5#ifndef __SYSTEM_MATH_AB__
6#define __SYSTEM_MATH_AB__
7
[268]8Namespace System
9
[1]10Class Math
11Public
12 Static Function E() As Double
13 return 2.7182818284590452354
14 End Function
[299]15/*
[1]16 Static Function PI() As Double
17 return _System_PI
18 End Function
[299]19*/
[1]20 Static Function Abs(value As Double) As Double
[239]21 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
[1]22 End Function
23
24 Static Function Abs(value As Single) As Single
[239]25 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
[1]26 End Function
27
[162]28 Static Function Abs(value As SByte) As SByte
[1]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
[268]62 Acos = ActiveBasic.Math.Detail.GetNaN()
[1]63 Else
[232]64 Acos = _System_HalfPI - Asin(x)
[1]65 End If
66 End Function
67
68 Static Function Asin(x As Double) As Double
69 If x < -1 Or x > 1 Then
[268]70 Asin = ActiveBasic.Math.Detail.GetNaN()
[1]71 Else
[233]72 Asin = Math.Atan(x / Sqrt(1 - x * x))
[1]73 End If
74 End Function
75
76 Static Function Atan(x As Double) As Double
[268]77 If ActiveBasic.Math.IsNaN(x) Then
[1]78 Atan = x
79 Exit Function
[268]80 ElseIf ActiveBasic.Math.IsInf(x) Then
81 Atan = ActiveBasic.Math.CopySign(_System_PI, x)
[1]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
[14]100 t = i * x
[1]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
[268]119 Atan2 += ActiveBasic.Math.CopySign(_System_PI, y)
[1]120 End If
121 End If
122 End Function
123
[14]124 Static Function BigMul(x As Long, y As Long) As Int64
125 Return (x As Int64) * y
[1]126 End Function
127
128 Static Function Ceiling(x As Double) As Long
[457]129 Ceiling = Floor(x)
130 If Ceiling <> x Then
131 Ceiling++
[1]132 End If
133 End Function
134
[14]135 Static Function Cos(x As Double) As Double
[268]136 If ActiveBasic.Math.IsNaN(x) Then
[14]137 Return x
[268]138 ElseIf ActiveBasic.Math.IsInf(x) Then
139 Return ActiveBasic.Math.Detail.GetNaN()
[1]140 End If
141
[124]142 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
[1]143 End Function
144
145 Static Function Cosh(value As Double) As Double
[457]146 Dim 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
[457]156 DivRem = x \ y
157 ret = x - (DivRem) * y
[1]158 End Function
159
160 'Equals
161
[14]162 Static Function Exp(x As Double) As Double
[268]163 If ActiveBasic.Math.IsNaN(x) Then
[1]164 Return x
[268]165 Else If ActiveBasic.Math.IsInf(x) Then
[1]166 If 0 > x Then
167 Return 0
168 Else
169 Return x
170 End If
171 End If
[285]172 Dim k As Long
[1]173 If x >= 0 Then
[14]174 k = Fix(x / _System_LOG2 + 0.5)
[1]175 Else
[14]176 k = Fix(x / _System_LOG2 - 0.5)
[1]177 End If
178
179 x -= k * _System_LOG2
180
[285]181 Dim x2 = x * x
182 Dim w = x2 / 22
[1]183
[285]184 Dim i = 18
[1]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
[237]194 Return Int(value)
[1]195 End Function
196
[237]197 Static Function IEEERemainder(x As Double, y As Double) As Double
[268]198 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
[237]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)
[1]205 Else
[237]206 q = Int(q - 0.5)
[1]207 End If
208 End If
[237]209 If x - y * q = 0 Then
210 If x > 0 Then
211 Return +0
[1]212 Else
[237]213 Return -0
[1]214 End If
215 Else
[237]216 Return x-y*q
[1]217 End If
218 End Function
219
220 Static Function Log(x As Double) As Double
221 If x = 0 Then
[268]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
[1]226 Log = x
227 Else
[244]228 Dim tmp = x * _System_InverseSqrt2
229 Dim p = VarPtr(tmp) As *QWord
[257]230 Dim m = GetQWord(p) And &h7FF0000000000000
[244]231 Dim k = ((m >> 52) As DWord) As Long - 1022
[257]232 SetQWord(p, m + &h0010000000000000)
[244]233 x /= tmp
[268]234 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
[1]235 End If
236 End Function
237
238 Static Function Log10(x As Double) As Double
[244]239 Return Math.Log(x) * _System_InverseLn10
[1]240 End Function
241
[244]242 Static Function Max(value1 As Byte, value2 As Byte) As Byte
[1]243 If value1>value2 then
244 return value1
245 Else
246 return value2
247 End If
248 End Function
249
[244]250 Static Function Max(value1 As SByte, value2 As SByte) As SByte
[1]251 If value1>value2 then
252 return value1
253 Else
254 return value2
255 End If
256 End Function
257
[244]258 Static Function Max(value1 As Word, value2 As Word) As Word
[1]259 If value1>value2 then
260 return value1
261 Else
262 return value2
263 End If
264 End Function
265
[244]266 Static Function Max(value1 As Integer, value2 As Integer) As Integer
[1]267 If value1>value2 then
268 return value1
269 Else
270 return value2
271 End If
272 End Function
273
[244]274 Static Function Max(value1 As DWord, value2 As DWord) As DWord
[1]275 If value1>value2 then
276 return value1
277 Else
278 return value2
279 End If
280 End Function
281
[244]282 Static Function Max(value1 As Long, value2 As Long) As Long
[1]283 If value1>value2 then
284 return value1
285 Else
286 return value2
287 End If
288 End Function
289
[244]290 Static Function Max(value1 As QWord, value2 As QWord) As QWord
[1]291 If value1>value2 then
292 return value1
293 Else
294 return value2
295 End If
296 End Function
297
[244]298 Static Function Max(value1 As Int64, value2 As Int64) As Int64
[1]299 If value1>value2 then
300 return value1
301 Else
302 return value2
303 End If
304 End Function
305
[244]306 Static Function Max(value1 As Single, value2 As Single) As Single
[1]307 If value1>value2 then
308 return value1
309 Else
310 return value2
311 End If
312 End Function
313
[244]314 Static Function Max(value1 As Double, value2 As Double) As Double
[1]315 If value1>value2 then
316 return value1
317 Else
318 return value2
319 End If
320 End Function
321
[244]322 Static Function Min(value1 As Byte, value2 As Byte) As Byte
[1]323 If value1<value2 then
324 return value1
325 Else
326 return value2
327 End If
328 End Function
329
[244]330 Static Function Min(value1 As SByte, value2 As SByte) As SByte
[1]331 If value1<value2 then
332 return value1
333 Else
334 return value2
335 End If
336 End Function
337
[244]338 Static Function Min(value1 As Word, value2 As Word) As Word
[1]339 If value1<value2 then
340 return value1
341 Else
342 return value2
343 End If
344 End Function
345
[244]346 Static Function Min(value1 As Integer, value2 As Integer) As Integer
[1]347 If value1<value2 then
348 return value1
349 Else
350 return value2
351 End If
352 End Function
353
[244]354 Static Function Min(value1 As DWord, value2 As DWord) As DWord
[1]355 If value1<value2 then
356 return value1
357 Else
358 return value2
359 End If
360 End Function
361
[244]362 Static Function Min(value1 As Long, value2 As Long) As Long
[1]363 If value1<value2 then
364 return value1
365 Else
366 return value2
367 End If
368 End Function
369
[244]370 Static Function Min(value1 As QWord, value2 As QWord) As QWord
[1]371 If value1<value2 then
372 return value1
373 Else
374 return value2
375 End If
376 End Function
377
[244]378 Static Function Min(value1 As Int64, value2 As Int64) As Int64
[1]379 If value1<value2 then
380 return value1
381 Else
382 return value2
383 End If
384 End Function
385
[244]386 Static Function Min(value1 As Single, value2 As Single) As Single
[1]387 If value1<value2 then
388 return value1
389 Else
390 return value2
391 End If
392 End Function
393
[244]394 Static Function Min(value1 As Double, value2 As Double) As Double
[1]395 If value1<value2 then
396 return value1
397 Else
398 return value2
399 End If
400 End Function
401
[14]402 Static Function Pow(x As Double, y As Double) As Double
403 return pow(x, y)
[1]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
[162]428 Static Function Sign(value As SByte) As Long
[1]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
[268]479 If ActiveBasic.Math.IsNaN(value) Then
[53]480 Return value
[268]481 ElseIf ActiveBasic.Math.IsInf(value) Then
482 Return ActiveBasic.Math.Detail.GetNaN()
[1]483 Exit Function
484 End If
485
[53]486 Dim k As Long
[1]487 Dim t As Double
488
[92]489 t = urTan((value * 0.5) As Double, k)
[1]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
[124]499 If Math.Abs(x) > _System_EPS5 Then
[1]500 Dim t As Double
[233]501 t = Math.Exp(x)
[1]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
[14]509 If x > 0 Then
[268]510 If ActiveBasic.Math.IsInf(x) Then
[1]511 Sqrt = x
512 Else
513 Sqrt = x
[457]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
[1]519 SetWord(i, j)
[457]520 Dim last As Double
[1]521 Do
522 last = Sqrt
[457]523 Sqrt = (x / Sqrt + Sqrt) * 0.5
[23]524 Loop While Sqrt <> last
[1]525 End If
[14]526 ElseIf x < 0 Then
[268]527 Sqrt = ActiveBasic.Math.Detail.GetNaN()
[1]528 Else
529 'x = 0 Or NaN
530 Sqrt = x
531 End If
532 End Function
533
[14]534 Static Function Tan(x As Double) As Double
[268]535 If ActiveBasic.Math.IsNaN(x) Then
[14]536 Tan = x
[1]537 Exit Function
[268]538 ElseIf ActiveBasic.Math.IsInf(x) Then
539 Tan = ActiveBasic.Math.Detail.GetNaN()
[1]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
[268]551 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
[1]552 End If
553 End Function
554
555 Static Function Tanh(x As Double) As Double
556 If x > _System_EPS5 Then
[233]557 Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]558 ElseIf x < -_System_EPS5 Then
[233]559 Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]560 Else
561 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
562 End If
563 End Function
564
[92]565 'ToString
566
[1]567 Static Function Truncate(x As Double) As Double
[237]568 Return Fix(x)
[1]569 End Function
570
[92]571'Private
[1]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
[233]577 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]578 Else
[233]579 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]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
[238]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
[1]594End Class
595
[268]596End Namespace
597
[1]598Const _System_HalfPI = (_System_PI * 0.5)
599Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[244]600Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
601Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
[1]602
[20]603#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.