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

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

インクルードガードとその他不要な前処理定義などの削除
File size: 12.6 KB
RevLine 
[14]1' Classes/System/Math.ab
[1]2
[268]3#require <Classes/ActiveBasic/Math/Math.ab>
4
5Namespace System
6
[1]7Class Math
8Public
9 Static Function E() As Double
10 return 2.7182818284590452354
11 End Function
[299]12/*
[1]13 Static Function PI() As Double
14 return _System_PI
15 End Function
[299]16*/
[1]17 Static Function Abs(value As Double) As Double
[239]18 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
[1]19 End Function
20
21 Static Function Abs(value As Single) As Single
[239]22 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
[1]23 End Function
24
[162]25 Static Function Abs(value As SByte) As SByte
[1]26 If value<0 then
27 return -value
28 Else
29 return value
30 End If
31 End Function
32
33 Static Function Abs(value As Integer) As Integer
34 If value<0 then
35 return -value
36 Else
37 return value
38 End If
39 End Function
40
41 Static Function Abs(value As Long) As Long
42 If value<0 then
43 return -value
44 Else
45 return value
46 End If
47 End Function
48
49 Static Function Abs(value As Int64) As Int64
50 If value<0 then
51 return -value
52 Else
53 return value
54 End If
55 End Function
56
57 Static Function Acos(x As Double) As Double
58 If x < -1 Or x > 1 Then
[268]59 Acos = ActiveBasic.Math.Detail.GetNaN()
[1]60 Else
[232]61 Acos = _System_HalfPI - Asin(x)
[1]62 End If
63 End Function
64
65 Static Function Asin(x As Double) As Double
66 If x < -1 Or x > 1 Then
[268]67 Asin = ActiveBasic.Math.Detail.GetNaN()
[1]68 Else
[233]69 Asin = Math.Atan(x / Sqrt(1 - x * x))
[1]70 End If
71 End Function
72
73 Static Function Atan(x As Double) As Double
[268]74 If ActiveBasic.Math.IsNaN(x) Then
[1]75 Atan = x
76 Exit Function
[268]77 ElseIf ActiveBasic.Math.IsInf(x) Then
78 Atan = ActiveBasic.Math.CopySign(_System_PI, x)
[1]79 Exit Function
80 End If
81 Dim i As Long
82 Dim sgn As Long
83 Dim dbl = 0 As Double
84
85 If x > 1 Then
86 sgn = 1
87 x = 1 / x
88 ElseIf x < -1 Then
89 sgn = -1
90 x = 1 / x
91 Else
92 sgn = 0
93 End If
94
95 For i = _System_Atan_N To 1 Step -1
96 Dim t As Double
[14]97 t = i * x
[1]98 dbl = (t * t) / (2 * i + 1 + dbl)
99 Next
100
101 If sgn > 0 Then
102 Atan = _System_HalfPI - x / (1 + dbl)
103 ElseIf sgn < 0 Then
104 Atan = -_System_HalfPI - x / (1 + dbl)
105 Else
106 Atan = x / (1 + dbl)
107 End If
108 End Function
109
110 Static Function Atan2(y As Double, x As Double) As Double
111 If x = 0 Then
112 Atan2 = Sgn(y) * _System_HalfPI
113 Else
114 Atan2 = Atn(y / x)
115 If x < 0 Then
[268]116 Atan2 += ActiveBasic.Math.CopySign(_System_PI, y)
[1]117 End If
118 End If
119 End Function
120
[14]121 Static Function BigMul(x As Long, y As Long) As Int64
122 Return (x As Int64) * y
[1]123 End Function
124
125 Static Function Ceiling(x As Double) As Long
[457]126 Ceiling = Floor(x)
127 If Ceiling <> x Then
128 Ceiling++
[1]129 End If
130 End Function
131
[14]132 Static Function Cos(x As Double) As Double
[268]133 If ActiveBasic.Math.IsNaN(x) Then
[14]134 Return x
[268]135 ElseIf ActiveBasic.Math.IsInf(x) Then
136 Return ActiveBasic.Math.Detail.GetNaN()
[1]137 End If
138
[124]139 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
[1]140 End Function
141
142 Static Function Cosh(value As Double) As Double
[457]143 Dim t = Math.Exp(value)
[1]144 return (t + 1 / t) * 0.5
145 End Function
146
[14]147 Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long
148 ret = x Mod y
149 return x \ y
[1]150 End Function
151
[14]152 Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64
[457]153 DivRem = x \ y
154 ret = x - (DivRem) * y
[1]155 End Function
156
157 'Equals
158
[14]159 Static Function Exp(x As Double) As Double
[268]160 If ActiveBasic.Math.IsNaN(x) Then
[1]161 Return x
[268]162 Else If ActiveBasic.Math.IsInf(x) Then
[1]163 If 0 > x Then
164 Return 0
165 Else
166 Return x
167 End If
168 End If
[285]169 Dim k As Long
[1]170 If x >= 0 Then
[14]171 k = Fix(x / _System_LOG2 + 0.5)
[1]172 Else
[14]173 k = Fix(x / _System_LOG2 - 0.5)
[1]174 End If
175
176 x -= k * _System_LOG2
177
[285]178 Dim x2 = x * x
179 Dim w = x2 / 22
[1]180
[285]181 Dim i = 18
[1]182 While i >= 6
183 w = x2 / (w + i)
184 i -= 4
185 Wend
186
187 Return ldexp((2 + w + x) / (2 + w - x), k)
188 End Function
189
190 Static Function Floor(value As Double) As Long
[237]191 Return Int(value)
[1]192 End Function
193
[237]194 Static Function IEEERemainder(x As Double, y As Double) As Double
[268]195 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
[237]196 Dim q = x / y
197 If q <> Int(q) Then
198 If q + 0.5 <> Int(q + 0.5) Then
199 q = Int(q + 0.5)
200 ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then
201 q = Int(q + 0.5)
[1]202 Else
[237]203 q = Int(q - 0.5)
[1]204 End If
205 End If
[237]206 If x - y * q = 0 Then
207 If x > 0 Then
208 Return +0
[1]209 Else
[237]210 Return -0
[1]211 End If
212 Else
[237]213 Return x-y*q
[1]214 End If
215 End Function
216
217 Static Function Log(x As Double) As Double
218 If x = 0 Then
[268]219 Log = ActiveBasic.Math.Detail.GetInf(True)
220 ElseIf x < 0 Or ActiveBasic.Math.IsNaN(x) Then
221 Log = ActiveBasic.Math.Detail.GetNaN()
222 ElseIf ActiveBasic.Math.IsInf(x) Then
[1]223 Log = x
224 Else
[244]225 Dim tmp = x * _System_InverseSqrt2
226 Dim p = VarPtr(tmp) As *QWord
[257]227 Dim m = GetQWord(p) And &h7FF0000000000000
[244]228 Dim k = ((m >> 52) As DWord) As Long - 1022
[257]229 SetQWord(p, m + &h0010000000000000)
[244]230 x /= tmp
[268]231 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
[1]232 End If
233 End Function
234
235 Static Function Log10(x As Double) As Double
[244]236 Return Math.Log(x) * _System_InverseLn10
[1]237 End Function
238
[244]239 Static Function Max(value1 As Byte, value2 As Byte) As Byte
[1]240 If value1>value2 then
241 return value1
242 Else
243 return value2
244 End If
245 End Function
246
[244]247 Static Function Max(value1 As SByte, value2 As SByte) As SByte
[1]248 If value1>value2 then
249 return value1
250 Else
251 return value2
252 End If
253 End Function
254
[244]255 Static Function Max(value1 As Word, value2 As Word) As Word
[1]256 If value1>value2 then
257 return value1
258 Else
259 return value2
260 End If
261 End Function
262
[244]263 Static Function Max(value1 As Integer, value2 As Integer) As Integer
[1]264 If value1>value2 then
265 return value1
266 Else
267 return value2
268 End If
269 End Function
270
[244]271 Static Function Max(value1 As DWord, value2 As DWord) As DWord
[1]272 If value1>value2 then
273 return value1
274 Else
275 return value2
276 End If
277 End Function
278
[244]279 Static Function Max(value1 As Long, value2 As Long) As Long
[1]280 If value1>value2 then
281 return value1
282 Else
283 return value2
284 End If
285 End Function
286
[244]287 Static Function Max(value1 As QWord, value2 As QWord) As QWord
[1]288 If value1>value2 then
289 return value1
290 Else
291 return value2
292 End If
293 End Function
294
[244]295 Static Function Max(value1 As Int64, value2 As Int64) As Int64
[1]296 If value1>value2 then
297 return value1
298 Else
299 return value2
300 End If
301 End Function
302
[244]303 Static Function Max(value1 As Single, value2 As Single) As Single
[1]304 If value1>value2 then
305 return value1
306 Else
307 return value2
308 End If
309 End Function
310
[244]311 Static Function Max(value1 As Double, value2 As Double) As Double
[1]312 If value1>value2 then
313 return value1
314 Else
315 return value2
316 End If
317 End Function
318
[244]319 Static Function Min(value1 As Byte, value2 As Byte) As Byte
[1]320 If value1<value2 then
321 return value1
322 Else
323 return value2
324 End If
325 End Function
326
[244]327 Static Function Min(value1 As SByte, value2 As SByte) As SByte
[1]328 If value1<value2 then
329 return value1
330 Else
331 return value2
332 End If
333 End Function
334
[244]335 Static Function Min(value1 As Word, value2 As Word) As Word
[1]336 If value1<value2 then
337 return value1
338 Else
339 return value2
340 End If
341 End Function
342
[244]343 Static Function Min(value1 As Integer, value2 As Integer) As Integer
[1]344 If value1<value2 then
345 return value1
346 Else
347 return value2
348 End If
349 End Function
350
[244]351 Static Function Min(value1 As DWord, value2 As DWord) As DWord
[1]352 If value1<value2 then
353 return value1
354 Else
355 return value2
356 End If
357 End Function
358
[244]359 Static Function Min(value1 As Long, value2 As Long) As Long
[1]360 If value1<value2 then
361 return value1
362 Else
363 return value2
364 End If
365 End Function
366
[244]367 Static Function Min(value1 As QWord, value2 As QWord) As QWord
[1]368 If value1<value2 then
369 return value1
370 Else
371 return value2
372 End If
373 End Function
374
[244]375 Static Function Min(value1 As Int64, value2 As Int64) As Int64
[1]376 If value1<value2 then
377 return value1
378 Else
379 return value2
380 End If
381 End Function
382
[244]383 Static Function Min(value1 As Single, value2 As Single) As Single
[1]384 If value1<value2 then
385 return value1
386 Else
387 return value2
388 End If
389 End Function
390
[244]391 Static Function Min(value1 As Double, value2 As Double) As Double
[1]392 If value1<value2 then
393 return value1
394 Else
395 return value2
396 End If
397 End Function
398
[14]399 Static Function Pow(x As Double, y As Double) As Double
400 return pow(x, y)
[1]401 End Function
402
403 'ReferenceEquals
404
405 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
406 If value+0.5<>Int(value+0.5) then
407 value=Int(value+0.5)
408 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
409 value=Int(value+0.5)
410 Else
411 value=Int(value-0.5)
412 End If
413 End Function
414
415 Static Function Sign(value As Double) As Long
416 If value = 0 then
417 return 0
418 ElseIf value > 0 then
419 return 1
420 Else
421 return -1
422 End If
423 End Function
424
[162]425 Static Function Sign(value As SByte) As Long
[1]426 If value = 0 then
427 return 0
428 ElseIf value > 0 then
429 return 1
430 Else
431 return -1
432 End If
433 End Function
434
435 Static Function Sign(value As Integer) As Long
436 If value = 0 then
437 return 0
438 ElseIf value > 0 then
439 return 1
440 Else
441 return -1
442 End If
443 End Function
444
445 Static Function Sign(value As Long) As Long
446 If value = 0 then
447 return 0
448 ElseIf value > 0 then
449 return 1
450 Else
451 return -1
452 End If
453 End Function
454
455 Static Function Sign(value As Int64) As Long
456 If value = 0 then
457 return 0
458 ElseIf value > 0 then
459 return 1
460 Else
461 return -1
462 End If
463 End Function
464
465 Static Function Sign(value As Single) As Long
466 If value = 0 then
467 return 0
468 ElseIf value > 0 then
469 return 1
470 Else
471 return -1
472 End If
473 End Function
474
475 Static Function Sin(value As Double) As Double
[268]476 If ActiveBasic.Math.IsNaN(value) Then
[53]477 Return value
[268]478 ElseIf ActiveBasic.Math.IsInf(value) Then
479 Return ActiveBasic.Math.Detail.GetNaN()
[1]480 Exit Function
481 End If
482
[53]483 Dim k As Long
[1]484 Dim t As Double
485
[92]486 t = urTan((value * 0.5) As Double, k)
[1]487 t = 2 * t / (1 + t * t)
488 If (k And 1) = 0 Then 'k mod 2 = 0 Then
489 Return t
490 Else
491 Return -t
492 End If
493 End Function
494
495 Static Function Sinh(x As Double) As Double
[124]496 If Math.Abs(x) > _System_EPS5 Then
[1]497 Dim t As Double
[233]498 t = Math.Exp(x)
[1]499 Return (t - 1 / t) * 0.5
500 Else
501 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
502 End If
503 End Function
504
505 Static Function Sqrt(x As Double) As Double
[14]506 If x > 0 Then
[268]507 If ActiveBasic.Math.IsInf(x) Then
[1]508 Sqrt = x
509 Else
510 Sqrt = x
[457]511 Dim i = (VarPtr(Sqrt) + 6) As *Word
512 Dim jj = GetWord(i) As Long
513 Dim j = jj >> 5 As Long
514 Dim k = (jj And &h0000001f) As Long
515 j = (j + 511) << 4 + k
[1]516 SetWord(i, j)
[457]517 Dim last As Double
[1]518 Do
519 last = Sqrt
[457]520 Sqrt = (x / Sqrt + Sqrt) * 0.5
[23]521 Loop While Sqrt <> last
[1]522 End If
[14]523 ElseIf x < 0 Then
[268]524 Sqrt = ActiveBasic.Math.Detail.GetNaN()
[1]525 Else
526 'x = 0 Or NaN
527 Sqrt = x
528 End If
529 End Function
530
[14]531 Static Function Tan(x As Double) As Double
[268]532 If ActiveBasic.Math.IsNaN(x) Then
[14]533 Tan = x
[1]534 Exit Function
[268]535 ElseIf ActiveBasic.Math.IsInf(x) Then
536 Tan = ActiveBasic.Math.Detail.GetNaN()
[1]537 Exit Function
538 End If
539
540 Dim k As Long
541 Dim t As Double
542 t = urTan(x, k)
543 If (k And 1) = 0 Then 'k mod 2 = 0 Then
544 Return t
545 ElseIf t <> 0 Then
546 Return -1 / t
547 Else
[268]548 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
[1]549 End If
550 End Function
551
552 Static Function Tanh(x As Double) As Double
553 If x > _System_EPS5 Then
[233]554 Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]555 ElseIf x < -_System_EPS5 Then
[233]556 Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]557 Else
558 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
559 End If
560 End Function
561
[92]562 'ToString
563
[1]564 Static Function Truncate(x As Double) As Double
[237]565 Return Fix(x)
[1]566 End Function
567
[92]568'Private
[1]569 Static Function urTan(x As Double, ByRef k As Long) As Double
570 Dim i As Long
571 Dim t As Double, x2 As Double
572
573 If x >= 0 Then
[233]574 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]575 Else
[233]576 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]577 End If
578 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
579 x2 = x * x
580 t = 0
581 For i = _System_UrTan_N To 3 Step -2
582 t = x2 / (i - t)
583 Next i
584 urTan = x / (1 - t)
585 End Function
[238]586Private
587 Static Const _System_Atan_N = 20 As Long
588 Static Const _System_UrTan_N = 17 As Long
589 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
590 Static Const _System_EPS5 = 0.001 As Double
[1]591End Class
592
[268]593End Namespace
594
[1]595Const _System_HalfPI = (_System_PI * 0.5)
596Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
[244]597Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
598Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
Note: See TracBrowser for help on using the repository browser.