1  ' Classes/System/Math.ab


2 


3  #ifndef __SYSTEM_MATH_AB__


4  #define __SYSTEM_MATH_AB__


5 


6  Class Math


7  Public


8  Static Function E() As Double


9  return 2.7182818284590452354


10  End Function


11 


12  Static Function PI() As Double


13  return _System_PI


14  End Function


15 


16  Static Function Abs(value As Double) As Double


17  SetQWord(VarPtr(Abs), GetQWord(VarPtr(value)) And &h7fffffffffffffff)


18  End Function


19 


20  Static Function Abs(value As Single) As Single


21  SetDWord(VarPtr(Abs), GetDWord(VarPtr(value)) And &h7fffffff)


22  End Function


23 


24  Static Function Abs(value As SByte) As SByte


25  If value<0 then


26  return value


27  Else


28  return value


29  End If


30  End Function


31 


32  Static Function Abs(value As Integer) As Integer


33  If value<0 then


34  return value


35  Else


36  return value


37  End If


38  End Function


39 


40  Static Function Abs(value As Long) As Long


41  If value<0 then


42  return value


43  Else


44  return value


45  End If


46  End Function


47 


48  Static Function Abs(value As Int64) As Int64


49  If value<0 then


50  return value


51  Else


52  return value


53  End If


54  End Function


55 


56  Static Function Acos(x As Double) As Double


57  If x < 1 Or x > 1 Then


58  Acos = _System_GetNaN()


59  Else


60  Acos = _System_HalfPI  Asin(x)


61  End If


62  End Function


63 


64  Static Function Asin(x As Double) As Double


65  If x < 1 Or x > 1 Then


66  Asin = _System_GetNaN()


67  Else


68  Asin = Math.Atan(x / Sqrt(1  x * x))


69  End If


70  End Function


71 


72  Static Function Atan(x As Double) As Double


73  If IsNaN(x) Then


74  Atan = x


75  Exit Function


76  ElseIf IsInf(x) Then


77  Atan = CopySign(_System_PI, x)


78  Exit Function


79  End If


80  Dim i As Long


81  Dim sgn As Long


82  Dim dbl = 0 As Double


83 


84  If x > 1 Then


85  sgn = 1


86  x = 1 / x


87  ElseIf x < 1 Then


88  sgn = 1


89  x = 1 / x


90  Else


91  sgn = 0


92  End If


93 


94  For i = _System_Atan_N To 1 Step 1


95  Dim t As Double


96  t = i * x


97  dbl = (t * t) / (2 * i + 1 + dbl)


98  Next


99 


100  If sgn > 0 Then


101  Atan = _System_HalfPI  x / (1 + dbl)


102  ElseIf sgn < 0 Then


103  Atan = _System_HalfPI  x / (1 + dbl)


104  Else


105  Atan = x / (1 + dbl)


106  End If


107  End Function


108 


109  Static Function Atan2(y As Double, x As Double) As Double


110  If x = 0 Then


111  Atan2 = Sgn(y) * _System_HalfPI


112  Else


113  Atan2 = Atn(y / x)


114  If x < 0 Then


115  Atan2 += CopySign(_System_PI, y)


116  End If


117  End If


118  End Function


119 


120  Static Function BigMul(x As Long, y As Long) As Int64


121  Return (x As Int64) * y


122  End Function


123 


124  Static Function Ceiling(x As Double) As Long


125  If Floor(x) = x then


126  Return x As Long


127  Else


128  Return Floor(x) + 1


129  End If


130  End Function


131 


132  Static Function Cos(x As Double) As Double


133  If IsNaN(x) Then


134  Return x


135  ElseIf IsInf(x) Then


136  Return _System_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 As Double


144  t = Math.Exp(value)


145  return (t + 1 / t) * 0.5


146  End Function


147 


148  Static Function DivRem(x As Long, y As Long, ByRef ret As Long) As Long


149  ret = x Mod y


150  return x \ y


151  End Function


152 


153  Static Function DivRem(x As Int64, y As Int64, ByRef ret As Int64) As Int64


154  ret = x  (x \ y) * y


155  return x \ y


156  End Function


157 


158  'Equals


159 


160  Static Function Exp(x As Double) As Double


161  If IsNaN(x) Then


162  Return x


163  Else If IsInf(x) Then


164  If 0 > x Then


165  Return 0


166  Else


167  Return x


168  End If


169  End If


170  Dim i As Long, k As Long


171  Dim x2 As Double, w As Double


172 


173  If x >= 0 Then


174  k = Fix(x / _System_LOG2 + 0.5)


175  Else


176  k = Fix(x / _System_LOG2  0.5)


177  End If


178 


179  x = k * _System_LOG2


180 


181  x2 = x * x


182  w = x2 / 22


183 


184  i = 18


185  While i >= 6


186  w = x2 / (w + i)


187  i = 4


188  Wend


189 


190  Return ldexp((2 + w + x) / (2 + w  x), k)


191  End Function


192 


193  Static Function Floor(value As Double) As Long


194  Return Int(value)


195  End Function


196 


197  'GetHashCode


198 


199  'GetType


200 


201  Static Function IEEERemainder(x As Double, y As Double) As Double


202  If y = 0 Then Return _System_GetNaN()


203  Dim q = x / y


204  If q <> Int(q) Then


205  If q + 0.5 <> Int(q + 0.5) Then


206  q = Int(q + 0.5)


207  ElseIf Int(q + 0.5) = Int(q * 2 + 1) / 2 Then


208  q = Int(q + 0.5)


209  Else


210  q = Int(q  0.5)


211  End If


212  End If


213  If x  y * q = 0 Then


214  If x > 0 Then


215  Return +0


216  Else


217  Return 0


218  End If


219  Else


220  Return xy*q


221  End If


222  End Function


223 


224  Static Function Log(x As Double) As Double


225  If x = 0 Then


226  Log = _System_GetInf(True)


227  ElseIf x < 0 Or IsNaN(x) Then


228  Log = _System_GetNaN()


229  ElseIf IsInf(x) Then


230  Log = x


231  Else


232  Dim tmp = x * _System_InverseSqrt2


233  Dim p = VarPtr(tmp) As *QWord


234  Dim m = p[0] And &h7FF0000000000000


235  Dim k = ((m >> 52) As DWord) As Long  1022


236  p[0] = m + &h0010000000000000


237  x /= tmp


238 


239  x


240  Dim s = 0 As Double


241  Dim i = _System_Log_N As Long


242  While i >= 1


243  Dim t = (i * x) As Double


244  s = t / (2 + t / (2 * i + 1 + s))


245  i


246  Wend


247  Log = _System_LOG2 * k + x / (1 + s)


248  End If


249  End Function


250 


251  Static Function Log10(x As Double) As Double


252  Return Math.Log(x) * _System_InverseLn10


253  End Function


254 


255  Static Function Max(value1 As Byte, value2 As Byte) As Byte


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 SByte, value2 As SByte) As SByte


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 Word, value2 As Word) As Word


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 Integer, value2 As Integer) As Integer


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 DWord, value2 As DWord) As DWord


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 Long, value2 As Long) As Long


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 QWord, value2 As QWord) As QWord


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 Int64, value2 As Int64) As Int64


312  If value1>value2 then


313  return value1


314  Else


315  return value2


316  End If


317  End Function


318 


319  Static Function Max(value1 As Single, value2 As Single) As Single


320  If value1>value2 then


321  return value1


322  Else


323  return value2


324  End If


325  End Function


326 


327  Static Function Max(value1 As Double, value2 As Double) As Double


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 Byte, value2 As Byte) As Byte


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 SByte, value2 As SByte) As SByte


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 Word, value2 As Word) As Word


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 Integer, value2 As Integer) As Integer


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 DWord, value2 As DWord) As DWord


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 Long, value2 As Long) As Long


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 QWord, value2 As QWord) As QWord


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 Int64, value2 As Int64) As Int64


392  If value1<value2 then


393  return value1


394  Else


395  return value2


396  End If


397  End Function


398 


399  Static Function Min(value1 As Single, value2 As Single) As Single


400  If value1<value2 then


401  return value1


402  Else


403  return value2


404  End If


405  End Function


406 


407  Static Function Min(value1 As Double, value2 As Double) As Double


408  If value1<value2 then


409  return value1


410  Else


411  return value2


412  End If


413  End Function


414 


415  Static Function Pow(x As Double, y As Double) As Double


416  return pow(x, y)


417  End Function


418 


419  'ReferenceEquals


420 


421  Static Function Round(value As Double) As Double'他のバージョン、誰か頼む。


422  If value+0.5<>Int(value+0.5) then


423  value=Int(value+0.5)


424  ElseIf Int(value+0.5)=Int(value*2+1)/2 then


425  value=Int(value+0.5)


426  Else


427  value=Int(value0.5)


428  End If


429  End Function


430 


431  Static Function Sign(value As Double) As Long


432  If value = 0 then


433  return 0


434  ElseIf value > 0 then


435  return 1


436  Else


437  return 1


438  End If


439  End Function


440 


441  Static Function Sign(value As SByte) As Long


442  If value = 0 then


443  return 0


444  ElseIf value > 0 then


445  return 1


446  Else


447  return 1


448  End If


449  End Function


450 


451  Static Function Sign(value As Integer) As Long


452  If value = 0 then


453  return 0


454  ElseIf value > 0 then


455  return 1


456  Else


457  return 1


458  End If


459  End Function


460 


461  Static Function Sign(value As Long) As Long


462  If value = 0 then


463  return 0


464  ElseIf value > 0 then


465  return 1


466  Else


467  return 1


468  End If


469  End Function


470 


471  Static Function Sign(value As Int64) As Long


472  If value = 0 then


473  return 0


474  ElseIf value > 0 then


475  return 1


476  Else


477  return 1


478  End If


479  End Function


480 


481  Static Function Sign(value As Single) As Long


482  If value = 0 then


483  return 0


484  ElseIf value > 0 then


485  return 1


486  Else


487  return 1


488  End If


489  End Function


490 


491  Static Function Sin(value As Double) As Double


492  If IsNaN(value) Then


493  Return value


494  ElseIf IsInf(value) Then


495  Return _System_GetNaN()


496  Exit Function


497  End If


498 


499  Dim k As Long


500  Dim t As Double


501 


502  t = urTan((value * 0.5) As Double, k)


503  t = 2 * t / (1 + t * t)


504  If (k And 1) = 0 Then 'k mod 2 = 0 Then


505  Return t


506  Else


507  Return t


508  End If


509  End Function


510 


511  Static Function Sinh(x As Double) As Double


512  If Math.Abs(x) > _System_EPS5 Then


513  Dim t As Double


514  t = Math.Exp(x)


515  Return (t  1 / t) * 0.5


516  Else


517  Return x * (1 + x * x * 0.166666666666667) ' x * (1 + x * x / 6)


518  End If


519  End Function


520 


521  Static Function Sqrt(x As Double) As Double


522  Dim s As Double, last As Double


523  Dim i As *Word, j As Long, jj As Long, k As Long


524  If x > 0 Then


525  If IsInf(x) Then


526  Sqrt = x


527  Else


528  Sqrt = x


529  i = (VarPtr(Sqrt) + 6) As *Word


530  jj = GetWord(i)


531  j = jj >> 5


532  k = jj And &h0000001f


533  j = (j+ 511) << 4 + k


534  SetWord(i, j)


535  Do


536  last = Sqrt


537  Sqrt = (x /Sqrt + Sqrt) * 0.5


538  Loop While Sqrt <> last


539  End If


540  ElseIf x < 0 Then


541  Sqrt = _System_GetNaN()


542  Else


543  'x = 0 Or NaN


544  Sqrt = x


545  End If


546  End Function


547 


548  Static Function Tan(x As Double) As Double


549  If IsNaN(x) Then


550  Tan = x


551  Exit Function


552  ElseIf IsInf(x) Then


553  Tan = _System_GetNaN()


554  Exit Function


555  End If


556 


557  Dim k As Long


558  Dim t As Double


559  t = urTan(x, k)


560  If (k And 1) = 0 Then 'k mod 2 = 0 Then


561  Return t


562  ElseIf t <> 0 Then


563  Return 1 / t


564  Else


565  Return CopySign(_System_GetInf(FALSE), t)


566  End If


567  End Function


568 


569  Static Function Tanh(x As Double) As Double


570  If x > _System_EPS5 Then


571  Return 2 / (1 + Math.Exp(2 * x))  1


572  ElseIf x < _System_EPS5 Then


573  Return 1  2 / (Math.Exp(2 * x) + 1)


574  Else


575  Return x * (1  x * x * 0.333333333333333) 'x * (1  x * x / 3)


576  End If


577  End Function


578 


579  'ToString


580 


581  Static Function Truncate(x As Double) As Double


582  Return Fix(x)


583  End Function


584 


585  'Private


586  Static Function urTan(x As Double, ByRef k As Long) As Double


587  Dim i As Long


588  Dim t As Double, x2 As Double


589 


590  If x >= 0 Then


591  k = ( Fix(x * _System_InverseHalfPI) + 0.5 ) As Long


592  Else


593  k = ( Fix(x * _System_InverseHalfPI)  0.5 ) As Long


594  End If


595  x = (x  (3217.0 / 2048.0) * k) + _System_D * k


596  x2 = x * x


597  t = 0


598  For i = _System_UrTan_N To 3 Step 2


599  t = x2 / (i  t)


600  Next i


601  urTan = x / (1  t)


602  End Function


603  Private


604  Static Const _System_Log_N = 7 As Long


605  Static Const _System_Atan_N = 20 As Long


606  Static Const _System_UrTan_N = 17 As Long


607  Static Const _System_D = 4.4544551033807686783083602485579e6 As Double


608  Static Const _System_EPS5 = 0.001 As Double


609  End Class


610 


611  Const _System_HalfPI = (_System_PI * 0.5)


612  Const _System_InverseHalfPI = (2 / _System_PI) '1 / (PI / 2)


613  Const _System_InverseLn10 = 0.43429448190325182765112891891661 '1 / (ln 10)


614  Const _System_InverseSqrt2 = 0.70710678118654752440084436210485 '1 / (√2)


615 


616 


617  #endif '__SYSTEM_MATH_AB__

