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

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

StringのResizeを呼ぶコンストラクタでメモリ確保されない場合を排除、ほか微修正
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 i As Long, k As Long
175 Dim x2 As Double, w As Double
176
177 If x >= 0 Then
178 k = Fix(x / _System_LOG2 + 0.5)
179 Else
180 k = Fix(x / _System_LOG2 - 0.5)
181 End If
182
183 x -= k * _System_LOG2
184
185 x2 = x * x
186 w = x2 / 22
187
188 i = 18
189 While i >= 6
190 w = x2 / (w + i)
191 i -= 4
192 Wend
193
194 Return ldexp((2 + w + x) / (2 + w - x), k)
195 End Function
196
197 Static Function Floor(value As Double) As Long
198 Return Int(value)
199 End Function
200
201 'GetHashCode
202
203 'GetType
204
205 Static Function IEEERemainder(x As Double, y As Double) As Double
206 If y = 0 Then Return ActiveBasic.Math.Detail.GetNaN()
207 Dim q = x / y
208 If q <> Int(q) Then
209 If q + 0.5 <> Int(q + 0.5) Then
210 q = Int(q + 0.5)
211 ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then
212 q = Int(q + 0.5)
213 Else
214 q = Int(q - 0.5)
215 End If
216 End If
217 If x - y * q = 0 Then
218 If x > 0 Then
219 Return +0
220 Else
221 Return -0
222 End If
223 Else
224 Return x-y*q
225 End If
226 End Function
227
228 Static Function Log(x As Double) As Double
229 If x = 0 Then
230 Log = ActiveBasic.Math.Detail.GetInf(True)
231 ElseIf x < 0 Or ActiveBasic.Math.IsNaN(x) Then
232 Log = ActiveBasic.Math.Detail.GetNaN()
233 ElseIf ActiveBasic.Math.IsInf(x) Then
234 Log = x
235 Else
236 Dim tmp = x * _System_InverseSqrt2
237 Dim p = VarPtr(tmp) As *QWord
238 Dim m = GetQWord(p) And &h7FF0000000000000
239 Dim k = ((m >> 52) As DWord) As Long - 1022
240 SetQWord(p, m + &h0010000000000000)
241 x /= tmp
242 Log = _System_LOG2 * k + ActiveBasic.Math.Detail.Log1p(x - 1)
243 End If
244 End Function
245
246 Static Function Log10(x As Double) As Double
247 Return Math.Log(x) * _System_InverseLn10
248 End Function
249
250 Static Function Max(value1 As Byte, value2 As Byte) As Byte
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 SByte, value2 As SByte) As SByte
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 Word, value2 As Word) As Word
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 Integer, value2 As Integer) As Integer
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 DWord, value2 As DWord) As DWord
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 Long, value2 As Long) As Long
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 QWord, value2 As QWord) As QWord
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 Int64, value2 As Int64) As Int64
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 Single, value2 As Single) As Single
315 If value1>value2 then
316 return value1
317 Else
318 return value2
319 End If
320 End Function
321
322 Static Function Max(value1 As Double, value2 As Double) As Double
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 Byte, value2 As Byte) As Byte
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 SByte, value2 As SByte) As SByte
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 Word, value2 As Word) As Word
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 Integer, value2 As Integer) As Integer
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 DWord, value2 As DWord) As DWord
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 Long, value2 As Long) As Long
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 QWord, value2 As QWord) As QWord
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 Int64, value2 As Int64) As Int64
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 Single, value2 As Single) As Single
395 If value1<value2 then
396 return value1
397 Else
398 return value2
399 End If
400 End Function
401
402 Static Function Min(value1 As Double, value2 As Double) As Double
403 If value1<value2 then
404 return value1
405 Else
406 return value2
407 End If
408 End Function
409
410 Static Function Pow(x As Double, y As Double) As Double
411 return pow(x, y)
412 End Function
413
414 'ReferenceEquals
415
416 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。
417 If value+0.5<>Int(value+0.5) then
418 value=Int(value+0.5)
419 ElseIf Int(value+0.5)=Int(value*2+1)/2 then
420 value=Int(value+0.5)
421 Else
422 value=Int(value-0.5)
423 End If
424 End Function
425
426 Static Function Sign(value As Double) As Long
427 If value = 0 then
428 return 0
429 ElseIf value > 0 then
430 return 1
431 Else
432 return -1
433 End If
434 End Function
435
436 Static Function Sign(value As SByte) As Long
437 If value = 0 then
438 return 0
439 ElseIf value > 0 then
440 return 1
441 Else
442 return -1
443 End If
444 End Function
445
446 Static Function Sign(value As Integer) As Long
447 If value = 0 then
448 return 0
449 ElseIf value > 0 then
450 return 1
451 Else
452 return -1
453 End If
454 End Function
455
456 Static Function Sign(value As Long) As Long
457 If value = 0 then
458 return 0
459 ElseIf value > 0 then
460 return 1
461 Else
462 return -1
463 End If
464 End Function
465
466 Static Function Sign(value As Int64) As Long
467 If value = 0 then
468 return 0
469 ElseIf value > 0 then
470 return 1
471 Else
472 return -1
473 End If
474 End Function
475
476 Static Function Sign(value As Single) As Long
477 If value = 0 then
478 return 0
479 ElseIf value > 0 then
480 return 1
481 Else
482 return -1
483 End If
484 End Function
485
486 Static Function Sin(value As Double) As Double
487 If ActiveBasic.Math.IsNaN(value) Then
488 Return value
489 ElseIf ActiveBasic.Math.IsInf(value) Then
490 Return ActiveBasic.Math.Detail.GetNaN()
491 Exit Function
492 End If
493
494 Dim k As Long
495 Dim t As Double
496
497 t = urTan((value * 0.5) As Double, k)
498 t = 2 * t / (1 + t * t)
499 If (k And 1) = 0 Then 'k mod 2 = 0 Then
500 Return t
501 Else
502 Return -t
503 End If
504 End Function
505
506 Static Function Sinh(x As Double) As Double
507 If Math.Abs(x) > _System_EPS5 Then
508 Dim t As Double
509 t = Math.Exp(x)
510 Return (t - 1 / t) * 0.5
511 Else
512 Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)
513 End If
514 End Function
515
516 Static Function Sqrt(x As Double) As Double
517 Dim s As Double, last As Double
518 Dim i As *Word, j As Long, jj As Long, k As Long
519 If x > 0 Then
520 If ActiveBasic.Math.IsInf(x) Then
521 Sqrt = x
522 Else
523 Sqrt = x
524 i = (VarPtr(Sqrt) + 6) As *Word
525 jj = GetWord(i)
526 j = jj >> 5
527 k = jj And &h0000001f
528 j = (j+ 511) << 4 + k
529 SetWord(i, j)
530 Do
531 last = Sqrt
532 Sqrt = (x /Sqrt + Sqrt) * 0.5
533 Loop While Sqrt <> last
534 End If
535 ElseIf x < 0 Then
536 Sqrt = ActiveBasic.Math.Detail.GetNaN()
537 Else
538 'x = 0 Or NaN
539 Sqrt = x
540 End If
541 End Function
542
543 Static Function Tan(x As Double) As Double
544 If ActiveBasic.Math.IsNaN(x) Then
545 Tan = x
546 Exit Function
547 ElseIf ActiveBasic.Math.IsInf(x) Then
548 Tan = ActiveBasic.Math.Detail.GetNaN()
549 Exit Function
550 End If
551
552 Dim k As Long
553 Dim t As Double
554 t = urTan(x, k)
555 If (k And 1) = 0 Then 'k mod 2 = 0 Then
556 Return t
557 ElseIf t <> 0 Then
558 Return -1 / t
559 Else
560 Return ActiveBasic.Math.CopySign(ActiveBasic.Math.Detail.GetInf(False), -t)
561 End If
562 End Function
563
564 Static Function Tanh(x As Double) As Double
565 If x > _System_EPS5 Then
566 Return 2 / (1 + Math.Exp(-2 * x)) - 1
567 ElseIf x < -_System_EPS5 Then
568 Return 1 - 2 / (Math.Exp(2 * x) + 1)
569 Else
570 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
571 End If
572 End Function
573
574 'ToString
575
576 Static Function Truncate(x As Double) As Double
577 Return Fix(x)
578 End Function
579
580'Private
581 Static Function urTan(x As Double, ByRef k As Long) As Double
582 Dim i As Long
583 Dim t As Double, x2 As Double
584
585 If x >= 0 Then
586 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
587 Else
588 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
589 End If
590 x = (x - (3217.0 / 2048.0) * k) + _System_D * k
591 x2 = x * x
592 t = 0
593 For i = _System_UrTan_N To 3 Step -2
594 t = x2 / (i - t)
595 Next i
596 urTan = x / (1 - t)
597 End Function
598Private
599 Static Const _System_Atan_N = 20 As Long
600 Static Const _System_UrTan_N = 17 As Long
601 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double
602 Static Const _System_EPS5 = 0.001 As Double
603End Class
604
605End Namespace
606
607Const _System_HalfPI = (_System_PI * 0.5)
608Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
609Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)
610Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
611
612#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.