basis/math/functions/functions-tests.factor

   1 USING: kernel literals math math.constants math.functions math.libm
   2 math.order math.ranges math.private sequences tools.test math.floats.env ;
   3
   4 IN: math.functions.tests
   5
   6 { t } [ 4 4 .00000001 ~ ] unit-test
   7 { t } [ 4.0000001 4.0000001 .000001 ~ ] unit-test
   8 { f } [ -4.0000001 4.0000001 .00001 ~ ] unit-test
   9 { t } [ -.0000000000001 0 .0000000001 ~ ] unit-test
  10 { t } [ 100 101 -.9 ~ ] unit-test
  11 { f } [ 100 120 -.09 ~ ] unit-test
  12 { t } [ 0 0 -.9 ~ ] unit-test
  13 { f } [ 0 10 -.9 ~ ] unit-test
  14
  15 ! Lets get the argument order correct, eh?
  16 { 0.0 } [ 0.0 1.0 fatan2 ] unit-test
  17 { 0.25 } [ 2.0 -2.0 fpow ] unit-test
  18
  19 { 4.0 } [ 16 sqrt ] unit-test
  20 { 2.0 } [ 4.0 0.5 ^ ] unit-test
  21 { C{ 0.0 4.0 } } [ -16 sqrt ] unit-test
  22
  23 { 4 } [ 2 2 ^ ] unit-test
  24 { 1/4 } [ 2 -2 ^ ] unit-test
  25 { t } [ 2 0.5 ^ 2 ^ 2 2.00001 between? ] unit-test
  26 { t } [ e pi i* ^ real-part -1.0 = ] unit-test
  27 { t } [ e pi i* ^ imaginary-part -0.00001 0.00001 between? ] unit-test
  28
  29 { 1/0. } [ 2.0 1024 ^ ] unit-test
  30 { 0x1.0p-1024 } [ 2.0 -1024 ^ ] unit-test
  31
  32 { t } [ 0 0 ^ fp-nan? ] unit-test
  33 { 0.0 } [ 0.0 1.0 ^ ] unit-test
  34 { 1/0. } [ 0 -2 ^ ] unit-test
  35 { t } [ 0 0.0 ^ fp-nan? ] unit-test
  36 { t } [ 0.0 0.0 ^ fp-nan? ] unit-test
  37 { 1/0. } [ 0 -2.0 ^ ] unit-test
  38 { 0 } [ 0 3.0 ^ ] unit-test
  39 { 0 } [ 0 3 ^ ] unit-test
  40
  41 : factorial ( n -- n! ) [ 1 ] [ [1,b] 1 [ * ] reduce ] if-zero ;
  42
  43 { 0.0 0 } [ 0 frexp ] unit-test
  44 { 0.5 1 } [ 1 frexp ] unit-test
  45 { -0.5 1 } [ -1 frexp ] unit-test
  46 { 0.5 2 } [ 2 frexp ] unit-test
  47 { -0.5 2 } [ -2 frexp ] unit-test
  48 { 0.75 2 } [ 3 frexp ] unit-test
  49 { -0.75 2 } [ -3 frexp ] unit-test
  50 { 0.75 0 } [ 0.75 frexp ] unit-test
  51 { -0.75 0 } [ -0.75 frexp ] unit-test
  52 { 1/0. } [ 1/0. frexp drop ] unit-test
  53 { -1/0. } [ -1/0. frexp drop ] unit-test
  54 { t } [ 0/0. frexp drop fp-nan? ] unit-test
  55 {  0.75 10,002 t } [  3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
  56 { -0.75 10,002 t } [ -3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
  57
  58 { 0.0 } [ 0.0 1 ldexp ] unit-test
  59 { -0.0 } [ -0.0 1 ldexp ] unit-test
  60 { 1/0. } [ 1/0. 1 ldexp ] unit-test
  61 { -1/0. } [ -1/0. 1 ldexp ] unit-test
  62 { t } [ NAN: 90210 dup 1 ldexp [ fp-nan-payload ] same? ] unit-test
  63 { 49152.0 } [ 12.0 12 ldexp ] unit-test
  64 { 0x1.8p-9 } [ 12.0 -12 ldexp ] unit-test
  65 { 49152 } [ 12 12 ldexp ] unit-test
  66 { 0 } [ 12 -12 ldexp ] unit-test
  67
  68 { 0.0 } [ 1 log ] unit-test
  69 { 0.0 } [ 1.0 log ] unit-test
  70 { 1.0 } [ e log ] unit-test
  71
  72 { 0.0 } [ 1 e logn ] unit-test
  73 { 0.0 } [ 1.0 e logn ] unit-test
  74 { 1.0 } [ e e logn ] unit-test
  75
  76 CONSTANT: log-factorial-1000 0x1.71820d04e2eb6p12
  77 CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
  78
  79 { $ log-factorial-1000 t } [ 1000 factorial [ log ] [ bignum? ] bi ] unit-test
  80 { C{ $ log-factorial-1000 $ pi } t } [ 1000 factorial neg [ log ] [ bignum? ] bi ] unit-test
  81
  82 { 0.0 } [ 1.0 log10 ] unit-test
  83 { 1.0 } [ 10.0 log10 ] unit-test
  84 { 2.0 } [ 100.0 log10 ] unit-test
  85 { 3.0 } [ 1000.0 log10 ] unit-test
  86 { 4.0 } [ 10000.0 log10 ] unit-test
  87 { $ log10-factorial-1000 t } [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
  88
  89 { f } [ 1 e^ 0/0. 1.e-10 ~ ] unit-test
  90 { f } [ 0/0. 1 e^ 1.e-10 ~ ] unit-test
  91 { f } [ 1/0. 1/0. 1.e-10 ~ ] unit-test
  92 { f } [ 1/0. -1/0. 1.e-10 ~ ] unit-test
  93 { f } [ 1/0. 0/0. 1.e-10 ~ ] unit-test
  94 { f } [ 0/0. -1/0. 1.e-10 ~ ] unit-test
  95
  96 { e 1.e-10 } [ 1 e^ ] unit-test~
  97 { 1.0 1.e-10 } [ -1 e^ e * ] unit-test~
  98
  99 { 0.0 } [ 0.0 e^-1 ] unit-test
 100 { -0.0 } [ -0.0 e^-1 ] unit-test
 101 { 1/0. } [ 1/0. e^-1 ] unit-test
 102 { -1.0 } [ -1/0. e^-1 ] unit-test
 103 { -1.0 } [ -1/0. e^-1 ] unit-test
 104 { t } [ NAN: 8000000000000 dup e^-1 [ fp-nan-payload ] same? ] unit-test
 105 { 5e-324 } [ 5e-324 e^-1 ] unit-test
 106 { 1e-20 } [ 1e-20 e^-1 ] unit-test
 107 { -5e-324 } [ -5e-324 e^-1 ] unit-test
 108 { -1e-20 } [ -1e-20 e^-1 ] unit-test
 109 { 1.0000000000500000e-10 } [ 1e-10 e^-1 ] unit-test
 110 { 22025.465794806718 } [ 10.0 e^-1 ] unit-test
 111 { -9.999999999500001e-11 } [ -1e-10 e^-1 ] unit-test
 112 { -0.9999546000702375 } [ -10.0 e^-1 ] unit-test
 113 { -1.0 } [ -38.0 e^-1 ] unit-test
 114 { -1.0 } [ -1e50 e^-1 ] unit-test
 115 { 1.9424263952412558e+130 } [ 300 e^-1 ] unit-test
 116 { 1.7976931346824240e+308 } [ 709.78271289328393 e^-1 ] unit-test
 117 { 1/0. } [ 1000.0 e^-1 ] unit-test
 118 { 1/0. } [ 1e50 e^-1 ] unit-test
 119 { 1/0. } [ 1.79e308 e^-1 ] unit-test
 120
 121 { 1.0 } [ 0 cosh ] unit-test
 122 { 1.0 } [ 0.0 cosh ] unit-test
 123 { 0.0 } [ 1 acosh ] unit-test
 124 { 0.0 } [ 1.0 acosh ] unit-test
 125
 126 { 1.0 } [ 0 cos ] unit-test
 127 { 1.0 } [ 0.0 cos ] unit-test
 128 { 0.0 } [ 1 acos ] unit-test
 129 { 0.0 } [ 1.0 acos ] unit-test
 130
 131 { 0.0 } [ 0 sinh ] unit-test
 132 { 0.0 } [ 0.0 sinh ] unit-test
 133 { 0.0 } [ 0 asinh ] unit-test
 134 { 0.0 } [ 0.0 asinh ] unit-test
 135
 136 { 0.0 } [ 0 sin ] unit-test
 137 { 0.0 } [ 0.0 sin ] unit-test
 138 { 0.0 } [ 0 asin ] unit-test
 139 { 0.0 } [ 0.0 asin ] unit-test
 140
 141 { 0.0 } [ 0 tan ] unit-test
 142 { t } [ pi 2 / tan 1.e10 > ] unit-test
 143
 144 { t } [ 10 atan real? ] unit-test
 145 { t } [ 10.0 atan real? ] unit-test
 146 { f } [ 10 atanh real? ] unit-test
 147 { f } [ 10.0 atanh real? ] unit-test
 148
 149 { 10 1.e-10 } [ 10 asin sin ] unit-test~
 150 { -100 1.e-10 } [ -100 atan tan ] unit-test~
 151 { 10 1.e-10 } [ 10 asinh sinh ] unit-test~
 152 { 10 1.e-10 } [ 10 atanh tanh ] unit-test~
 153 { 0.5 1.e-10 } [ 0.5 atanh tanh ] unit-test~
 154
 155 { t } [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test
 156
 157 { t } [ 0 42 divisor? ] unit-test
 158 { t } [ 42 7 divisor? ] unit-test
 159 { t } [ 42 -7 divisor? ] unit-test
 160 { t } [ 42 42 divisor? ] unit-test
 161 { f } [ 42 16 divisor? ] unit-test
 162
 163 { 3 } [ 5 7 mod-inv ] unit-test
 164 { 78572682077 } [ 234829342 342389423843 mod-inv ] unit-test
 165
 166 [ 2 10 mod-inv ] must-fail
 167
 168 { t } [ 15 37 137 ^mod 15 37 ^ 137 mod = ] unit-test
 169
 170 { t } [ 0 0 ^ fp-nan? ] unit-test
 171 { 1 } [ 10 0 ^ ] unit-test
 172 { 1/8 } [ 1/2 3 ^ ] unit-test
 173 { 1/8 } [ 2 -3 ^ ] unit-test
 174 { t } [ 1 100 shift 2 100 ^ = ] unit-test
 175
 176 { 1 } [ 7/8 ceiling ] unit-test
 177 { 2 } [ 3/2 ceiling ] unit-test
 178 { 0 } [ -7/8 ceiling ] unit-test
 179 { -1 } [ -3/2 ceiling ] unit-test
 180
 181 { 4.0 } [ 4.5 truncate ] unit-test
 182 { 4.0 } [ 4.5 floor ] unit-test
 183 { 5.0 } [ 4.5 ceiling ] unit-test
 184
 185 { -4.0 } [ -4.5 truncate ] unit-test
 186 { -5.0 } [ -4.5 floor ] unit-test
 187 { -4.0 } [ -4.5 ceiling ] unit-test
 188
 189 { t } [ -0.3 truncate double>bits 0.0 double>bits = ] unit-test
 190 { t } [ -0.3 ceiling double>bits -0.0 double>bits = ] unit-test
 191 { t } [ 0.3 floor double>bits 0.0 double>bits = ] unit-test
 192 { t } [ 0.3 truncate double>bits 0.0 double>bits = ] unit-test
 193
 194 { -4.0 } [ -4.0 truncate ] unit-test
 195 { -4.0 } [ -4.0 floor ] unit-test
 196 { -4.0 } [ -4.0 ceiling ] unit-test
 197
 198 ! first floats without fractional part
 199 { 0x1.0p52 } [ 0x1.0p52 truncate ] unit-test
 200 { 0x1.0000000000001p52 } [ 0x1.0000000000001p52 truncate ] unit-test
 201 { -0x1.0p52 } [ -0x1.0p52 truncate ] unit-test
 202 { -0x1.0000000000001p52 } [ -0x1.0000000000001p52 truncate ] unit-test
 203
 204 { -5 } [ -9/2 round ] unit-test
 205 { -4 } [ -22/5 round ] unit-test
 206 { 5 } [ 9/2 round ] unit-test
 207 { 4 } [ 22/5 round ] unit-test
 208
 209 { -5.0 } [ -4.5 round ] unit-test
 210 { -4.0 } [ -4.4 round ] unit-test
 211 { 5.0 } [ 4.5 round ] unit-test
 212 { 4.0 } [ 4.4 round ] unit-test
 213
 214 { -1 } [ -3/5 round ] unit-test
 215 { -1 } [ -1/2 round ] unit-test
 216 { 0 } [ -2/5 round ] unit-test
 217 { 0 } [ 2/5 round ] unit-test
 218 { 1 } [ 1/2 round ] unit-test
 219 { 1 } [ 3/5 round ] unit-test
 220
 221 { t } [ -0.3 round double>bits 0.0 double>bits = ] unit-test
 222 { t } [ 0.3 round double>bits 0.0 double>bits = ] unit-test
 223
 224 ! A signaling NaN should raise an exception
 225 ! XXX: disabling to get linux32 binary
 226 ! HACK: bug in factor or in vmware?
 227 ! TODO: fix this test on linux32 vmware
 228 !  { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 truncate drop ] collect-fp-exceptions ] unit-test
 229 { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 round drop ] collect-fp-exceptions ] unit-test
 230 { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 ceiling drop ] collect-fp-exceptions ] unit-test
 231 { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 floor drop ] collect-fp-exceptions ] unit-test
 232
 233 { -5 } [ -4-3/5 round-to-even ] unit-test
 234 { -4 } [ -4-1/2 round-to-even ] unit-test
 235 { -4 } [ -4-2/5 round-to-even ] unit-test
 236 { 5 } [ 4+3/5 round-to-even ] unit-test
 237 { 4 } [ 4+1/2 round-to-even ] unit-test
 238 { 4 } [ 4+2/5 round-to-even ] unit-test
 239 { -5.0 } [ -4.6 round-to-even ] unit-test
 240 { -4.0 } [ -4.5 round-to-even ] unit-test
 241 { -4.0 } [ -4.4 round-to-even ] unit-test
 242 { 5.0 } [ 4.6 round-to-even ] unit-test
 243 { 4.0 } [ 4.5 round-to-even ] unit-test
 244 { 4.0 } [ 4.4 round-to-even ] unit-test
 245
 246 { -5 } [ -4-3/5 round-to-odd ] unit-test
 247 { -5 } [ -4-1/2 round-to-odd ] unit-test
 248 { -4 } [ -4-2/5 round-to-odd ] unit-test
 249 { 5 } [ 4+3/5 round-to-odd ] unit-test
 250 { 5 } [ 4+1/2 round-to-odd ] unit-test
 251 { 4 } [ 4+2/5 round-to-odd ] unit-test
 252 { -5.0 } [ -4.6 round-to-odd ] unit-test
 253 { -5.0 } [ -4.5 round-to-odd ] unit-test
 254 { -4.0 } [ -4.4 round-to-odd ] unit-test
 255 { 5.0 } [ 4.6 round-to-odd ] unit-test
 256 { 5.0 } [ 4.5 round-to-odd ] unit-test
 257 { 4.0 } [ 4.4 round-to-odd ] unit-test
 258
 259 { 6 59967 } [ 3837888 factor-2s ] unit-test
 260 { 6 -59967 } [ -3837888 factor-2s ] unit-test
 261
 262 { 1 } [
 263     183009416410801897
 264     1067811677921310779
 265     2135623355842621559
 266     ^mod
 267 ] unit-test
 268
 269 { 1 } [
 270     183009416410801897
 271     1067811677921310779
 272     2135623355842621559
 273     [ >bignum ] tri@ ^mod
 274 ] unit-test
 275
 276 { 1.0  } [ 1.0 2.5 0.0 lerp ] unit-test
 277 { 2.5  } [ 1.0 2.5 1.0 lerp ] unit-test
 278 { 1.75 } [ 1.0 2.5 0.5 lerp ] unit-test
 279
 280 { C{ 1 2 } } [ C{ 1 2 } 1 ^ ] unit-test
 281
 282 { { t t t } } [
 283     3 3 roots {
 284         1.442249570307408
 285         C{ -0.7211247851537038 1.249024766483407 }
 286         C{ -0.7211247851537049 -1.249024766483406 }
 287     } [ .01 ~ ] 2map
 288 ] unit-test
 289
 290 { t } [ 3 15 roots [ 15 ^ 3 .01 ~ ] all? ] unit-test
 291
 292 { .5 } [ 0 sigmoid ] unit-test
 293 { t } [ 0 [ sigmoid logit ] keep .000001 ~ ] unit-test
 294
 295 { 1 } [ 12 signum ] unit-test
 296 { -1 } [ -5.0 signum ] unit-test
 297 { 0 } [ 0 signum ] unit-test
 298 { t } [ C{ 3.0 -1.5 } signum C{ 0.8944271909999157 -0.4472135954999579 } 1e-10 ~ ] unit-test
 299
 300 { 1.0 } [ 1 2 copysign ] unit-test
 301 { -1.0 } [ 1 -2 copysign ] unit-test
 302 { 1.0 } [ -1 0 copysign ] unit-test
 303 { -0.0 } [ 0 -1.0 copysign ] unit-test
 304 { -1.0 } [ -1 -0.0 copysign ] unit-test
 305 { 1.5 } [ -1.5 2 copysign ] unit-test
 306 { -1.5 } [ -1.5 -2 copysign ] unit-test