Changeset 589 for trunk/ab5.0/ablib/src/Classes/System
- Timestamp:
- Aug 15, 2008, 1:00:15 AM (16 years ago)
- File:
-
- 1 edited
-
trunk/ab5.0/ablib/src/Classes/System/Math.ab (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/Classes/System/Math.ab
r497 r589 24 24 25 25 Static Function Abs(value As SByte) As SByte 26 If value<0 then26 If value<0 Then 27 27 return -value 28 28 Else … … 32 32 33 33 Static Function Abs(value As Integer) As Integer 34 If value<0 then34 If value<0 Then 35 35 return -value 36 36 Else … … 40 40 41 41 Static Function Abs(value As Long) As Long 42 If value<0 then42 If value<0 Then 43 43 return -value 44 44 Else … … 48 48 49 49 Static Function Abs(value As Int64) As Int64 50 If value<0 then50 If value<0 Then 51 51 return -value 52 52 Else … … 56 56 57 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 58 Acos = ActiveBasic.Math.Acos(x) 63 59 End Function 64 60 65 61 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 62 Asin = ActiveBasic.Math.Asin(x) 71 63 End Function 72 64 73 65 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 66 Atan = ActiveBasic.Math.Atan(x) 108 67 End Function 109 68 110 69 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 70 Atan2 = ActiveBasic.Math.Atan2(y, x) 119 71 End Function 120 72 … … 131 83 132 84 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) 85 Cos = ActiveBasic.Math.Cos(x) 140 86 End Function 141 87 142 88 Static Function Cosh(value As Double) As Double 143 89 Dim t = Math.Exp(value) 144 return (t + 1 / t) * 0.590 Return (t + 1 / t) * 0.5 145 91 End Function 146 92 147 93 Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long 148 94 ret = x Mod y 149 return x \ y95 Return x \ y 150 96 End Function 151 97 … … 155 101 End Function 156 102 157 'Equals158 159 103 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) 104 Exp = ActiveBasic.Math.Exp(x) 188 105 End Function 189 106 … … 216 133 217 134 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 135 Log = ActiveBasic.Math.Log(x) 233 136 End Function 234 137 235 138 Static Function Log10(x As Double) As Double 236 Return Math.Log(x) * _System_InverseLn10139 Log = ActiveBasic.Math.Log10(x) 237 140 End Function 238 141 239 142 Static Function Max(value1 As Byte, value2 As Byte) As Byte 240 If value1>value2 then143 If value1>value2 Then 241 144 return value1 242 145 Else … … 246 149 247 150 Static Function Max(value1 As SByte, value2 As SByte) As SByte 248 If value1>value2 then151 If value1>value2 Then 249 152 return value1 250 153 Else … … 254 157 255 158 Static Function Max(value1 As Word, value2 As Word) As Word 256 If value1>value2 then159 If value1>value2 Then 257 160 return value1 258 161 Else … … 262 165 263 166 Static Function Max(value1 As Integer, value2 As Integer) As Integer 264 If value1>value2 then167 If value1>value2 Then 265 168 return value1 266 169 Else … … 270 173 271 174 Static Function Max(value1 As DWord, value2 As DWord) As DWord 272 If value1>value2 then175 If value1>value2 Then 273 176 return value1 274 177 Else … … 278 181 279 182 Static Function Max(value1 As Long, value2 As Long) As Long 280 If value1>value2 then183 If value1>value2 Then 281 184 return value1 282 185 Else … … 286 189 287 190 Static Function Max(value1 As QWord, value2 As QWord) As QWord 288 If value1>value2 then191 If value1>value2 Then 289 192 return value1 290 193 Else … … 294 197 295 198 Static Function Max(value1 As Int64, value2 As Int64) As Int64 296 If value1>value2 then199 If value1>value2 Then 297 200 return value1 298 201 Else … … 302 205 303 206 Static Function Max(value1 As Single, value2 As Single) As Single 304 If value1>value2 then207 If value1>value2 Then 305 208 return value1 306 209 Else … … 310 213 311 214 Static Function Max(value1 As Double, value2 As Double) As Double 312 If value1>value2 then215 If value1>value2 Then 313 216 return value1 314 217 Else … … 318 221 319 222 Static Function Min(value1 As Byte, value2 As Byte) As Byte 320 If value1<value2 then223 If value1<value2 Then 321 224 return value1 322 225 Else … … 326 229 327 230 Static Function Min(value1 As SByte, value2 As SByte) As SByte 328 If value1<value2 then231 If value1<value2 Then 329 232 return value1 330 233 Else … … 334 237 335 238 Static Function Min(value1 As Word, value2 As Word) As Word 336 If value1<value2 then239 If value1<value2 Then 337 240 return value1 338 241 Else … … 342 245 343 246 Static Function Min(value1 As Integer, value2 As Integer) As Integer 344 If value1<value2 then247 If value1<value2 Then 345 248 return value1 346 249 Else … … 350 253 351 254 Static Function Min(value1 As DWord, value2 As DWord) As DWord 352 If value1<value2 then255 If value1<value2 Then 353 256 return value1 354 257 Else … … 358 261 359 262 Static Function Min(value1 As Long, value2 As Long) As Long 360 If value1<value2 then263 If value1<value2 Then 361 264 return value1 362 265 Else … … 366 269 367 270 Static Function Min(value1 As QWord, value2 As QWord) As QWord 368 If value1<value2 then271 If value1<value2 Then 369 272 return value1 370 273 Else … … 374 277 375 278 Static Function Min(value1 As Int64, value2 As Int64) As Int64 376 If value1<value2 then279 If value1<value2 Then 377 280 return value1 378 281 Else … … 382 285 383 286 Static Function Min(value1 As Single, value2 As Single) As Single 384 If value1<value2 then287 If value1<value2 Then 385 288 return value1 386 289 Else … … 390 293 391 294 Static Function Min(value1 As Double, value2 As Double) As Double 392 If value1<value2 then295 If value1<value2 Then 393 296 return value1 394 297 Else … … 404 307 405 308 Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。 406 If value+0.5<>Int(value+0.5) then309 If value+0.5<>Int(value+0.5) Then 407 310 value=Int(value+0.5) 408 ElseIf Int(value+0.5)=Int(value*2+1)/2 then311 ElseIf Int(value+0.5)=Int(value*2+1)/2 Then 409 312 value=Int(value+0.5) 410 313 Else … … 414 317 415 318 Static Function Sign(value As Double) As Long 416 If value = 0 then417 return 0 418 ElseIf value > 0 then419 return 1 420 Else 421 return -1 422 End If 423 End Function 424 319 If value = 0 Then 320 return 0 321 ElseIf value > 0 Then 322 return 1 323 Else 324 return -1 325 End If 326 End Function 327 /* 425 328 Static Function Sign(value As SByte) As Long 426 If value = 0 then427 return 0 428 ElseIf value > 0 then329 If value = 0 Then 330 return 0 331 ElseIf value > 0 Then 429 332 return 1 430 333 Else … … 434 337 435 338 Static Function Sign(value As Integer) As Long 436 If value = 0 then437 return 0 438 ElseIf value > 0 then339 If value = 0 Then 340 return 0 341 ElseIf value > 0 Then 439 342 return 1 440 343 Else … … 444 347 445 348 Static Function Sign(value As Long) As Long 446 If value = 0 then447 return 0 448 ElseIf value > 0 then349 If value = 0 Then 350 return 0 351 ElseIf value > 0 Then 449 352 return 1 450 353 Else … … 454 357 455 358 Static Function Sign(value As Int64) As Long 456 If value = 0 then457 return 0 458 ElseIf value > 0 then359 If value = 0 Then 360 return 0 361 ElseIf value > 0 Then 459 362 return 1 460 363 Else … … 464 367 465 368 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 369 If value = 0 Then 370 return 0 371 ElseIf value > 0 Then 372 return 1 373 Else 374 return -1 375 End If 376 End Function 377 */ 378 Static Function Sin(x As Double) As Double 379 Sin = ActiveBasic.Math.Sin(x) 493 380 End Function 494 381 495 382 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 383 Sinh = ActiveBasic.Math.Sinh(x) 503 384 End Function 504 385 505 386 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 387 Sqrt = ActiveBasic.Math.Sqrt(x) 529 388 End Function 530 389 531 390 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 391 Tan = ActiveBasic.Math.Tan(x) 550 392 End Function 551 393 552 394 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 395 Tanh = ActiveBasic.Math.Tanh(x) 396 End Function 563 397 564 398 Static Function Truncate(x As Double) As Double 565 399 Return Fix(x) 566 400 End Function 567 568 'Private569 Static Function urTan(x As Double, ByRef k As Long) As Double570 Dim i As Long571 Dim t As Double, x2 As Double572 573 If x >= 0 Then574 k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long575 Else576 k = ( Fix(x * _System_InverseHalfPI) - 0.5 ) As Long577 End If578 x = (x - (3217.0 / 2048.0) * k) + _System_D * k579 x2 = x * x580 t = 0581 For i = _System_UrTan_N To 3 Step -2582 t = x2 / (i - t)583 Next i584 urTan = x / (1 - t)585 End Function586 Private587 Static Const _System_Atan_N = 20 As Long588 Static Const _System_UrTan_N = 17 As Long589 Static Const _System_D = 4.4544551033807686783083602485579e-6 As Double590 Static Const _System_EPS5 = 0.001 As Double591 401 End Class 592 402 593 403 End Namespace 594 595 Const _System_HalfPI = (_System_PI * 0.5)596 Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)597 Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)598 Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)
Note:
See TracChangeset
for help on using the changeset viewer.
