core/math/intervals/intervals-tests.factor

   1 USING: math.intervals kernel sequences words math arrays
   2 prettyprint tools.test random ;
   3 IN: temporary
   4
   5 [ T{ interval f { 1 t } { 2 t } } ] [ 1 2 [a,b] ] unit-test
   6
   7 [ T{ interval f { 1 t } { 2 f } } ] [ 1 2 [a,b) ] unit-test
   8
   9 [ T{ interval f { 1 f } { 2 f } } ] [ 1 2 (a,b) ] unit-test
  10
  11 [ T{ interval f { 1 f } { 2 t } } ] [ 1 2 (a,b] ] unit-test
  12
  13 [ T{ interval f { 1 t } { 1 t } } ] [ 1 [a,a] ] unit-test
  14
  15 [ t ] [ { 3 t } { 3 f } endpoint< ] unit-test
  16 [ t ] [ { 2 f } { 3 f } endpoint< ] unit-test
  17 [ f ] [ { 3 f } { 3 t } endpoint< ] unit-test
  18 [ t ] [ { 4 f } { 3 t } endpoint> ] unit-test
  19 [ f ] [ { 3 f } { 3 t } endpoint> ] unit-test
  20
  21 [ t ] [
  22     1 2 [a,b] -3 3 [a,b] interval+ -2 5 [a,b] =
  23 ] unit-test
  24
  25 [ t ] [
  26     1 2 [a,b] -3 3 (a,b) interval+ -2 5 (a,b) =
  27 ] unit-test
  28
  29 [ t ] [
  30     1 2 [a,b] 0 1 [a,b] interval- 0 2 [a,b] =
  31 ] unit-test
  32
  33 [ t ] [
  34     1 2 [a,b] 0 4 [a,b] interval* 0 8 [a,b] =
  35 ] unit-test
  36
  37 [ t ] [
  38     1 2 [a,b] -4 4 [a,b] interval* -8 8 [a,b] =
  39 ] unit-test
  40
  41 [ t ] [
  42     1 2 [a,b] -1/2 1/2 [a,b] interval* -1 1 [a,b] =
  43 ] unit-test
  44
  45 [ t ] [
  46     1 2 [a,b] -1/2 1/2 (a,b] interval* -1 1 (a,b] =
  47 ] unit-test
  48
  49 [ t ] [
  50     -1 1 [a,b] -1 1 (a,b] interval* -1 1 [a,b] =
  51 ] unit-test
  52
  53 [ t ] [
  54     0 1 (a,b) 0 1 [a,b] interval-union 0 1 [a,b] =
  55 ] unit-test
  56
  57 [ t ] [
  58     0 1 (a,b) 1 2 [a,b] interval-union 0 2 (a,b] =
  59 ] unit-test
  60
  61 [ f ] [ 0 1 (a,b) f interval-union ] unit-test
  62
  63 [ t ] [
  64     0 1 (a,b) 0 1 [a,b] interval-intersect 0 1 (a,b) =
  65 ] unit-test
  66
  67 [ f ] [ 0 5 [a,b] -1 [a,a] interval-intersect ] unit-test
  68
  69 [ f ] [ 0 5 (a,b] 0 [a,a] interval-intersect ] unit-test
  70
  71 [ t ] [
  72     0 1 (a,b) 0 1 [a,b] interval-subset?
  73 ] unit-test
  74
  75 [ f ] [
  76     0 0 1 (a,b) interval-contains?
  77 ] unit-test
  78
  79 [ t ] [
  80     1/2 0 1 (a,b) interval-contains?
  81 ] unit-test
  82
  83 [ f ] [
  84     1 0 1 (a,b) interval-contains?
  85 ] unit-test
  86
  87 [ f ] [ -1 1 (a,b) -1 1 (a,b) interval/ ] unit-test
  88
  89 [ f ] [ -1 1 (a,b) 0 1 (a,b) interval/ ] unit-test
  90
  91 [ t ] [
  92     -1 1 (a,b) 1/2 1 (a,b) interval/ -2 2 (a,b) =
  93 ] unit-test
  94
  95 [ t ] [ 0 5 [a,b] 5 interval<= ] unit-test
  96
  97 [ incomparable ] [ 0 5 [a,b] 5 interval< ] unit-test
  98
  99 [ t ] [ 0 5 [a,b) 5 interval< ] unit-test
 100
 101 [ f ] [ 0 5 [a,b] -1 interval< ] unit-test
 102
 103 [ incomparable ] [ 0 5 [a,b] 1 interval< ] unit-test
 104
 105 [ t ] [ -1 1 (a,b) -1 interval> ] unit-test
 106
 107 [ t ] [ -1 1 (a,b) -1 interval>= ] unit-test
 108
 109 [ f ] [ -1 1 (a,b) -1 interval< ] unit-test
 110
 111 [ f ] [ -1 1 (a,b) -1 interval<= ] unit-test
 112
 113 [ t ] [ -1 1 (a,b] 1 interval<= ] unit-test
 114
 115 ! Interval random tester
 116 : random-element ( interval -- n )
 117     dup interval-to first swap interval-from first tuck -
 118     random + ;
 119
 120 : random-interval ( -- interval )
 121     1000 random dup 1 1000 random + + [a,b] ;
 122
 123 : random-op
 124     {
 125         { + interval+ }
 126         { - interval- }
 127         { * interval* }
 128         { / interval/ }
 129         { /i interval/i }
 130         { shift interval-shift }
 131         { min interval-min }
 132         { max interval-max }
 133     } random ;
 134
 135 : interval-test
 136     random-interval random-interval random-op
 137     0 pick interval-contains? over first { / /i } member? and [
 138         3drop t
 139     ] [
 140         [ >r [ random-element ] 2apply r> first execute ] 3keep
 141         second execute interval-contains?
 142     ] if ;
 143
 144 [ t ] [ 1000 [ drop interval-test ] all? ] unit-test