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

Last change on this file since 233 was 233, checked in by dai, 17 years ago

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