source: trunk/ab5.0/ablib/src/Classes/System/Math.ab@ 544

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

インクルードガードとその他不要な前処理定義などの削除
File size: 12.6 KB
Line 
1' Classes/System/Math.ab
2
3#require <Classes/ActiveBasic/Math/Math.ab>
4
5Namespace System
6
7Class Math
8Public
9 Static Function E() As Double
10 return 2.7182818284590452354
11 End Function
12/*
13 Static Function PI() As Double
14 return _System_PI
15 End Function
16*/
17 Static Function Abs(value As Double) As Double
18 SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
19 End Function
20
21 Static Function Abs(value As Single) As Single
22 SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)
23 End Function
24
25 Static Function Abs(value As SByte) As SByte
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
59 Acos = ActiveBasic.Math.Detail.GetNaN()
60 Else
61 Acos = _System_HalfPI - Asin(x)
62 End If
63 End Function
64
65 Static Function Asin(x As Double) As Double
66 If x < -1 Or x > 1 Then
67 Asin = ActiveBasic.Math.Detail.GetNaN()
68 Else
69 Asin = Math.Atan(x / Sqrt(1 - x * x))
70 End If
71 End Function
72
73 Static Function Atan(x As Double) As Double
74 If ActiveBasic.Math.IsNaN(x) Then
75 Atan = x
76 Exit Function
77 ElseIf ActiveBasic.Math.IsInf(x) Then
78 Atan = ActiveBasic.Math.CopySign(_System_PI, x)
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
97 t = i * x
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
116 Atan2 += ActiveBasic.Math.CopySign(_System_PI, y)
117 End If
118 End If
119 End Function
120
121 Static Function BigMul(x As Long, y As Long) As Int64
122 Return (x As Int64) * y
123 End Function
124
125 Static Function Ceiling(x As Double) As Long
126 Ceiling = Floor(x)
127 If Ceiling <> x Then
128 Ceiling++
129 End If
130 End Function
131
132 Static Function Cos(x As Double) As Double
133 If ActiveBasic.Math.IsNaN(x) Then
134 Return x
135 ElseIf ActiveBasic.Math.IsInf(x) Then
136 Return ActiveBasic.Math.Detail.GetNaN()
137 End If
138
139 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
140 End Function
141
142 Static Function Cosh(value As Double) As Double
143 Dim t = Math.Exp(value)
144 return (t + 1 / t) * 0.5
145 End Function
146
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
150 End Function
151
152 Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64
153 DivRem = x \ y
154 ret = x - (DivRem) * y
155 End Function
156
157 'Equals
158
159 Static Function Exp(x As Double) As Double
160 If ActiveBasic.Math.IsNaN(x) Then
161 Return x
162 Else If ActiveBasic.Math.IsInf(x) Then
163 If 0 > x Then
164 Return 0
165 Else
166 Return x
167 End If
168 End If
169 Dim k As Long
170 If x >= 0 Then
171 k = Fix(x / _System_LOG2 + 0.5)
172 Else
173 k = Fix(x / _System_LOG2 - 0.5)
174 End If
175
176 x -= k * _System_LOG2
177
178 Dim x2 = x * x
179 Dim w = x2 / 22
180
181 Dim i = 18
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
191 Return Int(value)
192 End Function
193
194 Static Function IEEERemainder(x As Double, y As Double) As Double
195 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
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)
202 Else
203 q = Int(q - 0.5)
204 End If
205 End If
206 If x - y * q = 0 Then
207 If x > 0 Then
208 Return +0
209 Else
210 Return -0
211 End If
212 Else
213 Return x-y*q
214 End If
215 End Function
216
217 Static Function Log(x As Double) As Double
218 If x = 0 Then
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
223 Log = x
224 Else
225 Dim tmp = x * _System_InverseSqrt2
226 Dim p = VarPtr(tmp) As *QWord
227 Dim m = GetQWord(p) And &h7FF0000000000000
228 Dim k = ((m >> 52) As DWord) As Long - 1022
229 SetQWord(p, m + &h0010000000000000)
230 x /= tmp
231 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
232 End If
233 End Function
234
235 Static Function Log10(x As Double) As Double
236 Return Math.Log(x) * _System_InverseLn10
237 End Function
238
239 Static Function Max(value1 As Byte, value2 As Byte) As Byte
240 If value1>value2 then
241 return value1
242 Else
243 return value2
244 End If
245 End Function
246
247 Static Function Max(value1 As SByte, value2 As SByte) As SByte
248 If value1>value2 then
249 return value1
250 Else
251 return value2
252 End If
253 End Function
254
255 Static Function Max(value1 As Word, value2 As Word) As Word
256 If value1>value2 then
257 return value1
258 Else
259 return value2
260 End If
261 End Function
262
263 Static Function Max(value1 As Integer, value2 As Integer) As Integer
264 If value1>value2 then
265 return value1
266 Else
267 return value2
268 End If
269 End Function
270
271 Static Function Max(value1 As DWord, value2 As DWord) As DWord
272 If value1>value2 then
273 return value1
274 Else
275 return value2
276 End If
277 End Function
278
279 Static Function Max(value1 As Long, value2 As Long) As Long
280 If value1>value2 then
281 return value1
282 Else
283 return value2
284 End If
285 End Function
286
287 Static Function Max(value1 As QWord, value2 As QWord) As QWord
288 If value1>value2 then
289 return value1
290 Else
291 return value2
292 End If
293 End Function
294
295 Static Function Max(value1 As Int64, value2 As Int64) As Int64
296 If value1>value2 then
297 return value1
298 Else
299 return value2
300 End If
301 End Function
302
303 Static Function Max(value1 As Single, value2 As Single) As Single
304 If value1>value2 then
305 return value1
306 Else
307 return value2
308 End If
309 End Function
310
311 Static Function Max(value1 As Double, value2 As Double) As Double
312 If value1>value2 then
313 return value1
314 Else
315 return value2
316 End If
317 End Function
318
319 Static Function Min(value1 As Byte, value2 As Byte) As Byte
320 If value1<value2 then
321 return value1
322 Else
323 return value2
324 End If
325 End Function
326
327 Static Function Min(value1 As SByte, value2 As SByte) As SByte
328 If value1<value2 then
329 return value1
330 Else
331 return value2
332 End If
333 End Function
334
335 Static Function Min(value1 As Word, value2 As Word) As Word
336 If value1<value2 then
337 return value1
338 Else
339 return value2
340 End If
341 End Function
342
343 Static Function Min(value1 As Integer, value2 As Integer) As Integer
344 If value1<value2 then
345 return value1
346 Else
347 return value2
348 End If
349 End Function
350
351 Static Function Min(value1 As DWord, value2 As DWord) As DWord
352 If value1<value2 then
353 return value1
354 Else
355 return value2
356 End If
357 End Function
358
359 Static Function Min(value1 As Long, value2 As Long) As Long
360 If value1<value2 then
361 return value1
362 Else
363 return value2
364 End If
365 End Function
366
367 Static Function Min(value1 As QWord, value2 As QWord) As QWord
368 If value1<value2 then
369 return value1
370 Else
371 return value2
372 End If
373 End Function
374
375 Static Function Min(value1 As Int64, value2 As Int64) As Int64
376 If value1<value2 then
377 return value1
378 Else
379 return value2
380 End If
381 End Function
382
383 Static Function Min(value1 As Single, value2 As Single) As Single
384 If value1<value2 then
385 return value1
386 Else
387 return value2
388 End If
389 End Function
390
391 Static Function Min(value1 As Double, value2 As Double) As Double
392 If value1<value2 then
393 return value1
394 Else
395 return value2
396 End If
397 End Function
398
399 Static Function Pow(x As Double, y As Double) As Double
400 return pow(x, y)
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
425 Static Function Sign(value As SByte) As Long
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
476 If ActiveBasic.Math.IsNaN(value) Then
477 Return value
478 ElseIf ActiveBasic.Math.IsInf(value) Then
479 Return ActiveBasic.Math.Detail.GetNaN()
480 Exit Function
481 End If
482
483 Dim k As Long
484 Dim t As Double
485
486 t = urTan((value * 0.5) As Double, k)
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
496 If Math.Abs(x) > _System_EPS5 Then
497 Dim t As Double
498 t = Math.Exp(x)
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
506 If x > 0 Then
507 If ActiveBasic.Math.IsInf(x) Then
508 Sqrt = x
509 Else
510 Sqrt = x
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
516 SetWord(i, j)
517 Dim last As Double
518 Do
519 last = Sqrt
520 Sqrt = (x / Sqrt + Sqrt) * 0.5
521 Loop While Sqrt <> last
522 End If
523 ElseIf x < 0 Then
524 Sqrt = ActiveBasic.Math.Detail.GetNaN()
525 Else
526 'x = 0 Or NaN
527 Sqrt = x
528 End If
529 End Function
530
531 Static Function Tan(x As Double) As Double
532 If ActiveBasic.Math.IsNaN(x) Then
533 Tan = x
534 Exit Function
535 ElseIf ActiveBasic.Math.IsInf(x) Then
536 Tan = ActiveBasic.Math.Detail.GetNaN()
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
548 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
549 End If
550 End Function
551
552 Static Function Tanh(x As Double) As Double
553 If x > _System_EPS5 Then
554 Return 2 / (1 + Math.Exp(-2 * x)) - 1
555 ElseIf x < -_System_EPS5 Then
556 Return 1 - 2 / (Math.Exp(2 * x) + 1)
557 Else
558 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
559 End If
560 End Function
561
562 'ToString
563
564 Static Function Truncate(x As Double) As Double
565 Return Fix(x)
566 End Function
567
568'Private
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
574 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
575 Else
576 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
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
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
591End Class
592
593End Namespace
594
595Const _System_HalfPI = (_System_PI * 0.5)
596Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
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.