1  ' Classes/System/Math.ab


2 


3  #ifndef __SYSTEM_MATH_AB__


4  #define __SYSTEM_MATH_AB__


5 


6  Const _System_EPS5 = 0.001


7 


8  Class Math


9  Public


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  If value<0 then


20  return value


21  Else


22  return value


23  End If


24  End Function


25 


26  Static Function Abs(value As Single) As Single


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 Char) As Char


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


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


51  If value<0 then


52  return value


53  Else


54  return value


55  End If


56  End Function


57 


58  Static Function Abs(value As Int64) As Int64


59  If value<0 then


60  return value


61  Else


62  return value


63  End If


64  End Function


65 


66  Static Function Acos(x As Double) As Double


67  If x < 1 Or x > 1 Then


68  Acos = _System_GetNaN()


69  Else


70  Acos = _System_HalfPI  ASin(x)


71  End If


72  End Function


73 


74  Static Function Asin(x As Double) As Double


75  If x < 1 Or x > 1 Then


76  Asin = _System_GetNaN()


77  Else


78  Asin = ATan(x / Sqrt(1  x * x))


79  End If


80  End Function


81 


82  Static Function Atan(x As Double) As Double


83  If IsNaN(x) Then


84  Atan = x


85  Exit Function


86  ElseIf IsInf(x) Then


87  Atan = CopySign(_System_PI, x)


88  Exit Function


89  End If


90  Dim i As Long


91  Dim sgn As Long


92  Dim dbl = 0 As Double


93 


94  If x > 1 Then


95  sgn = 1


96  x = 1 / x


97  ElseIf x < 1 Then


98  sgn = 1


99  x = 1 / x


100  Else


101  sgn = 0


102  End If


103 


104  For i = _System_Atan_N To 1 Step 1


105  Dim t As Double


106  t = i * x


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


108  Next


109 


110  If sgn > 0 Then


111  Atan = _System_HalfPI  x / (1 + dbl)


112  ElseIf sgn < 0 Then


113  Atan = _System_HalfPI  x / (1 + dbl)


114  Else


115  Atan = x / (1 + dbl)


116  End If


117  End Function


118 


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


120  If x = 0 Then


121  Atan2 = Sgn(y) * _System_HalfPI


122  Else


123  Atan2 = Atn(y / x)


124  If x < 0 Then


125  Atn2 += CopySign(_System_PI, y)


126  End If


127  End If


128  End Function


129 


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


131  Return (x As Int64) * y


132  End Function


133 


134  Static Function Ceiling(x As Double) As Long


135  If Floor(x) = x then


136  Return x


137  Else


138  Return Floor(x) + 1


139  End If


140  End Function


141 


142  Static Function Cos(x As Double) As Double


143  If IsNaN(x) Then


144  Return x


145  ElseIf IsInf(x) Then


146  Return _System_GetNaN()


147  End If


148 


149  Return Sin(_System_HalfPI  Abs(x))


150  End Function


151 


152  Static Function Cosh(value As Double) As Double


153  Dim t As Double


154  t = Exp(value)


155  return (t + 1 / t) * 0.5


156  End Function


157 


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


159  ret = x Mod y


160  return x \ y


161  End Function


162 


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


164  ret = x  (x \ y) * y


165  return x \ y


166  End Function


167 


168  'Equals


169 


170  Static Function Exp(x As Double) As Double


171  If IsNaN(x) Then


172  Return x


173  Else If IsInf(x) Then


174  If 0 > x Then


175  Return 0


176  Else


177  Return x


178  End If


179  End If


180  Dim i As Long, k As Long


181  Dim x2 As Double, w As Double


182 


183  If x >= 0 Then


184  k = Fix(x / _System_LOG2 + 0.5)


185  Else


186  k = Fix(x / _System_LOG2  0.5)


187  End If


188 


189  x = k * _System_LOG2


190 


191  x2 = x * x


192  w = x2 / 22


193 


194  i = 18


195  While i >= 6


196  w = x2 / (w + i)


197  i = 4


198  Wend


199 


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


201  End Function


202 


203  Static Function Floor(value As Double) As Long


204  return Int(value)


205  End Function


206 


207  'GetHashCode


208 


209  'GetType


210 


211  Static Function IEEERemainder(value1 As Double,value2 As Double) As Double


212  Dim q As Double


213  If value2=0 then return _System_GetNaN()


214  q=value1/value2


215  If q<>Int(q) then


216  If q+0.5<>Int(q+0.5) then


217  q=Int(q+0.5)


218  ElseIf Int(q+0.5)=Int(q*2+1)/2 then


219  q=Int(q+0.5)


220  Else


221  q=Int(q0.5)


222  End If


223  End If


224  If xy*q=0 then


225  If x>0 then


226  return +0


227  Else


228  return 0


229  End If


230  Else


231  return xy*q


232  End If


233  End Function


234 


235  Static Function Log(x As Double) As Double


236  If x = 0 Then


237  Log = _System_GetInf(TRUE)


238  ElseIf x < 0 Or IsNaN(x) Then


239  Log = _System_GetNaN()


240  ElseIf IsInf(x) Then


241  Log = x


242  Else


243  Dim i As Long, k As Long


244  Dim s As Double, t As Double


245  frexp(x / _System_SQRT2, k)


246  x /= ldexp(1, k)


247 


248  x


249  s = 0


250  i = _System_Log_N


251  While i >= 1


252  t = i * x


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


254  i


255  Wend


256 


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


258  End If


259  End Function


260 


261  Static Function Log10(x As Double) As Double


262  Return Log(x) / Log(10)


263  End Function


264 


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


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


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


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


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


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


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


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


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


330  If value1>value2 then


331  return value1


332  Else


333  return value2


334  End If


335  End Function


336 


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


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


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


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


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


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


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


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


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


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


410  If value1<value2 then


411  return value1


412  Else


413  return value2


414  End If


415  End Function


416 


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


418  If value1<value2 then


419  return value1


420  Else


421  return value2


422  End If


423  End Function


424 


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


426  return pow(x, y)


427  End Function


428 


429  'ReferenceEquals


430 


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


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


433  value=Int(value+0.5)


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


435  value=Int(value+0.5)


436  Else


437  value=Int(value0.5)


438  End If


439  End Function


440 


441  Static Function Sign(value As Double) 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 Char) 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 Integer) 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 Long) 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 Int64) 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 Sign(value As Single) As Long


492  If value = 0 then


493  return 0


494  ElseIf value > 0 then


495  return 1


496  Else


497  return 1


498  End If


499  End Function


500 


501  Static Function Sin(value As Double) As Double


502  If IsNaN(number) Then


503  Return number


504  ElseIf IsInf(number) Then


505  Return _System_GetNaN()


506  Exit Function


507  End If


508 


509  Dim k As Integer


510  Dim t As Double


511 


512  t = urTan(x * 0.5, k)


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


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


515  Return t


516  Else


517  Return t


518  End If


519  End Function


520 


521  Static Function Sinh(x As Double) As Double


522  If Abs(x) > _System_EPS5 Then


523  Dim t As Double


524  t = Exp(x)


525  Return (t  1 / t) * 0.5


526  Else


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


528  End If


529  End Function


530 


531  Static Function Sqrt(x As Double) As Double


532  Dim s As Double, last As Double


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


534  If x > 0 Then


535  If IsInf(x) Then


536  Sqrt = x


537  Else


538  Sqrt = x


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


540  jj = GetWord(i)


541  j = jj >> 5


542  k = jj And &h0000001f


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


544  SetWord(i, j)


545  Do


546  last = Sqrt


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


548  Loop While s <> last


549  End If


550  ElseIf x < 0 Then


551  Sqr = _System_GetNaN()


552  Else


553  'x = 0 Or NaN


554  Sqrt = x


555  End If


556  End Function


557 


558  Static Function Tan(x As Double) As Double


559  If IsNaN(x) Then


560  Tan = x


561  Exit Function


562  ElseIf IsInf(x) Then


563  Tan = _System_GetNaN()


564  Exit Function


565  End If


566 


567  Dim k As Long


568  Dim t As Double


569  t = urTan(x, k)


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


571  Return t


572  ElseIf t <> 0 Then


573  Return 1 / t


574  Else


575  Return CopySign(_System_GetInf(FALSE), t)


576  End If


577  End Function


578 


579  Static Function Tanh(x As Double) As Double


580  If x > _System_EPS5 Then


581  Return 2 / (1 + Exp(2 * x))  1


582  ElseIf x < _System_EPS5 Then


583  Return 1  2 / (Exp(2 * x) + 1)


584  Else


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


586  End If


587  End Function


588 


589  'ToString


590 


591  Static Function Truncate(x As Double) As Double


592  return Fix(x)


593  End Function


594 


595  'Private


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


597  Dim i As Long


598  Dim t As Double, x2 As Double


599 


600  If x >= 0 Then


601  k = Fix(x * _System_InverseHalfPI) + 0.5


602  Else


603  k = Fix(x * _System_InverseHalfPI)  0.5


604  End If


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


606  x2 = x * x


607  t = 0


608  For i = _System_UrTan_N To 3 Step 2


609  t = x2 / (i  t)


610  Next i


611  urTan = x / (1  t)


612  End Function


613  End Class


614 


615  Const _System_Log_N = 7


616  Const _System_Atan_N = 20


617  Const _System_UrTan_N = 17


618  Const _System_D = 4.4544551033807686783083602485579e6


619  Const _System_HalfPI = (_System_PI * 0.5)


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


621 


622  #endif '__SYSTEM_MATH_AB__

