core/assocs/assocs-tests.factor

   1 USING: kernel math namespaces make tools.test vectors sequences
   2 sequences.private hashtables io prettyprint assocs
   3 continuations specialized-arrays ;
   4 SPECIALIZED-ARRAY: double
   5 IN: assocs.tests
   6
   7 [ t ] [ H{ } dup assoc-subset? ] unit-test
   8 [ f ] [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test
   9 [ t ] [ H{ } H{ { 1 3 } } assoc-subset? ] unit-test
  10 [ t ] [ H{ { 1 3 } } H{ { 1 3 } } assoc-subset? ] unit-test
  11 [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } assoc-subset? ] unit-test
  12 [ f ] [ H{ { 1 f } } H{ } assoc-subset? ] unit-test
  13 [ t ] [ H{ { 1 f } } H{ { 1 f } } assoc-subset? ] unit-test
  14
  15 ! Test some combinators
  16 [
  17     { 4 14 32 }
  18 ] [
  19     [
  20         H{
  21             { 1 2 }
  22             { 3 4 }
  23             { 5 6 }
  24         } [ * 2 + , ] assoc-each
  25     ] { } make
  26 ] unit-test
  27
  28 [ t ] [ H{ } [ 2drop f ] assoc-all? ] unit-test
  29 [ t ] [ H{ { 1 1 } } [ = ] assoc-all? ] unit-test
  30 [ f ] [ H{ { 1 2 } } [ = ] assoc-all? ] unit-test
  31 [ t ] [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test
  32 [ f ] [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test
  33
  34 [ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test
  35 [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
  36     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
  37     [ drop 3 >= ] assoc-filter
  38 ] unit-test
  39
  40 [ 21 ] [
  41     0 H{
  42         { 1 2 }
  43         { 3 4 }
  44         { 5 6 }
  45     } [
  46         + +
  47     ] assoc-each
  48 ] unit-test
  49
  50 H{ } clone "cache-test" set
  51
  52 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  53 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  54 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  55 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  56
  57 [
  58     H{ { "factor" "rocks" } { 3 4 } }
  59 ] [
  60     H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } }
  61     H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } }
  62     assoc-intersect
  63 ] unit-test
  64
  65 [
  66     H{ { 1 2 } { 2 3 } { 6 5 } }
  67 ] [
  68     H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } }
  69     assoc-union
  70 ] unit-test
  71
  72 [ H{ { 1 2 } { 2 3 } } t ] [
  73     f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
  74 ] unit-test
  75
  76 [
  77     H{ { 1 f } }
  78 ] [
  79     H{ { 1 f } } H{ { 1 f } } assoc-intersect
  80 ] unit-test
  81
  82 [ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test
  83
  84 [ H{ { "hi" 2 } { 3 4 } } ]
  85 [ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
  86 unit-test
  87
  88 [ H{ { 1 2 } { 3 4 } } ]
  89 [ "hi" 5 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
  90 unit-test
  91
  92 [
  93     H{ { 1.0 1.0 } { 2.0 2.0 } }
  94 ] [
  95     double-array{ 1.0 2.0 } [ dup ] H{ } map>assoc
  96 ] unit-test
  97
  98 [ { 3 } ] [
  99     [
 100         3
 101         H{ } clone
 102         2 [
 103             2dup [ , f ] cache drop
 104         ] times
 105         2drop
 106     ] { } make
 107 ] unit-test
 108
 109 [
 110     H{
 111         { "bangers" "mash" }
 112         { "fries" "onion rings" }
 113     }
 114 ] [
 115     { "bangers" "fries" } H{
 116         { "fish" "chips" }
 117         { "bangers" "mash" }
 118         { "fries" "onion rings" }
 119         { "nachos" "cheese" }
 120     } extract-keys
 121 ] unit-test
 122
 123 [ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } ] [
 124     H{
 125         { "a" [ 1 ] }
 126         { "b" [ 2 ] }
 127         { "c" [ 3 ] }
 128         { "d" [ 4 ] }
 129     } [ nip first even? ] assoc-partition
 130 ] unit-test
 131
 132 [ 1 f ] [ 1 H{ } ?at ] unit-test
 133 [ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test
 134
 135 [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 136 [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 137 [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
 138
 139 [ H{ { 1 2 } { 2 3 } } ] [
 140     {
 141         H{ { 1 3 } }
 142         H{ { 2 3 } }
 143         H{ { 1 2 } }
 144     } assoc-combine
 145 ] unit-test
 146
 147 [ H{ { 1 7 } } ] [
 148     {
 149         H{ { 1 2 } { 2 4 } { 5 6 } }
 150         H{ { 1 3 } { 2 5 } }
 151         H{ { 1 7 } { 5 6 } }
 152     } assoc-refine
 153 ] unit-test