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
RevLine 
[14]1' Classes/System/Math.ab
[1]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
[208]19 SetQWord(VarPtr(value), GetQWord(VarPtr(value)) And &h7fffffffffffffff)
[1]20 End Function
21
22 Static Function Abs(value As Single) As Single
[208]23 SetDWord(VarPtr(value), GetDWord(VarPtr(value)) And &h7fffffff)
[1]24 End Function
25
[162]26 Static Function Abs(value As SByte) As SByte
[1]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
[232]62 Acos = _System_HalfPI - Asin(x)
[1]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
[233]70 Asin = Math.Atan(x / Sqrt(1 - x * x))
[1]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
[14]98 t = i * x
[1]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
[91]117 Atan2 += CopySign(_System_PI, y)
[1]118 End If
119 End If
120 End Function
121
[14]122 Static Function BigMul(x As Long, y As Long) As Int64
123 Return (x As Int64) * y
[1]124 End Function
125
126 Static Function Ceiling(x As Double) As Long
127 If Floor(x) = x then
[233]128 Return x As Long
[1]129 Else
130 Return Floor(x) + 1
131 End If
132 End Function
133
[14]134 Static Function Cos(x As Double) As Double
135 If IsNaN(x) Then
136 Return x
137 ElseIf IsInf(x) Then
[1]138 Return _System_GetNaN()
139 End If
140
[124]141 Return Math.Sin((_System_HalfPI - Math.Abs(x)) As Double)
[1]142 End Function
143
144 Static Function Cosh(value As Double) As Double
145 Dim t As Double
[233]146 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
156 ret = x - (x \ y) * y
157 return x \ y
[1]158 End Function
159
160 'Equals
161
[14]162 Static Function Exp(x As Double) As Double
[1]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
[14]176 k = Fix(x / _System_LOG2 + 0.5)
[1]177 Else
[14]178 k = Fix(x / _System_LOG2 - 0.5)
[1]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
[208]203 Static Function IEEERemainder(value1 As Double, value2 As Double) As Double
[1]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
[232]254 Return Math.Log(x) / Math.Log(10)
[1]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
[162]265 Static Function Max(value1 As SByte,value2 As SByte) As SByte
[1]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
[162]345 Static Function Min(value1 As SByte,value2 As SByte) As SByte
[1]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
[14]417 Static Function Pow(x As Double, y As Double) As Double
418 return pow(x, y)
[1]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
[162]443 Static Function Sign(value As SByte) As Long
[1]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
[53]494 If IsNaN(value) Then
495 Return value
496 ElseIf IsInf(value) Then
[1]497 Return _System_GetNaN()
498 Exit Function
499 End If
500
[53]501 Dim k As Long
[1]502 Dim t As Double
503
[92]504 t = urTan((value * 0.5) As Double, k)
[1]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
[124]514 If Math.Abs(x) > _System_EPS5 Then
[1]515 Dim t As Double
[233]516 t = Math.Exp(x)
[1]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
[14]526 If x > 0 Then
527 If IsInf(x) Then
[1]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
[23]540 Loop While Sqrt <> last
[1]541 End If
[14]542 ElseIf x < 0 Then
[23]543 Sqrt = _System_GetNaN()
[1]544 Else
545 'x = 0 Or NaN
546 Sqrt = x
547 End If
548 End Function
549
[14]550 Static Function Tan(x As Double) As Double
551 If IsNaN(x) Then
552 Tan = x
[1]553 Exit Function
[14]554 ElseIf IsInf(x) Then
[1]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
[233]573 Return 2 / (1 + Math.Exp(-2 * x)) - 1
[1]574 ElseIf x < -_System_EPS5 Then
[233]575 Return 1 - 2 / (Math.Exp(2 * x) + 1)
[1]576 Else
577 Return x * (1 - x * x * 0.333333333333333) 'x * (1 - x * x / 3)
578 End If
579 End Function
580
[92]581 'ToString
582
[1]583 Static Function Truncate(x As Double) As Double
584 return Fix(x)
585 End Function
586
[92]587'Private
[1]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
[233]593 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long
[1]594 Else
[233]595 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long
[1]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
[208]610Const _System_D = 4.4544551033807686783083602485579e-6
[1]611Const _System_HalfPI = (_System_PI * 0.5)
612Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)
613
[20]614#endif '__SYSTEM_MATH_AB__
Note: See TracBrowser for help on using the repository browser.