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 alien.c-types ;
   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{ } ] [ H{ { t f } { f t } } clone dup [ 2drop f ] assoc-filter! drop ] unit-test
  36 [ H{ } ] [ H{ { t f } { f t } } clone [ 2drop f ] assoc-filter! ] unit-test
  37
  38 [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
  39     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
  40     [ drop 3 >= ] assoc-filter
  41 ] unit-test
  42
  43 [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
  44     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone
  45     [ drop 3 >= ] assoc-filter!
  46 ] unit-test
  47
  48 [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
  49     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone dup
  50     [ drop 3 >= ] assoc-filter! drop
  51 ] unit-test
  52
  53 [ H{ { 1 2 } { 2 3 } } ] [
  54     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
  55     [ drop 3 >= ] assoc-reject
  56 ] unit-test
  57
  58 [ H{ { 1 2 } { 2 3 } } ] [
  59     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone
  60     [ drop 3 >= ] assoc-reject!
  61 ] unit-test
  62
  63 [ 21 ] [
  64     0 H{
  65         { 1 2 }
  66         { 3 4 }
  67         { 5 6 }
  68     } [
  69         + +
  70     ] assoc-each
  71 ] unit-test
  72
  73 H{ } clone "cache-test" set
  74
  75 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  76 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  77 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  78 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  79
  80 [
  81     H{ { "factor" "rocks" } { 3 4 } }
  82 ] [
  83     H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } }
  84     H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } }
  85     assoc-intersect
  86 ] unit-test
  87
  88 [
  89     H{ { 1 2 } { 2 3 } { 6 5 } }
  90 ] [
  91     H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } }
  92     assoc-union
  93 ] unit-test
  94
  95 [
  96     H{ { 1 2 } { 2 3 } { 6 5 } }
  97 ] [
  98     H{ { 2 4 } { 6 5 } } clone dup H{ { 1 2 } { 2 3 } }
  99     assoc-union! drop
 100 ] unit-test
 101
 102 [
 103     H{ { 1 2 } { 2 3 } { 6 5 } }
 104 ] [
 105     H{ { 2 4 } { 6 5 } } clone H{ { 1 2 } { 2 3 } }
 106     assoc-union!
 107 ] unit-test
 108
 109 [ H{ { 1 2 } { 2 3 } } t ] [
 110     f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
 111 ] unit-test
 112
 113 [
 114     H{ { 1 f } }
 115 ] [
 116     H{ { 1 f } } H{ { 1 f } } assoc-intersect
 117 ] unit-test
 118
 119 [
 120     H{ { 3 4 } }
 121 ] [
 122     H{ { 1 2 } { 3 4 } } H{ { 1 3 } } assoc-diff
 123 ] unit-test
 124
 125 [
 126     H{ { 3 4 } }
 127 ] [
 128     H{ { 1 2 } { 3 4 } } clone dup H{ { 1 3 } } assoc-diff! drop
 129 ] unit-test
 130
 131 [
 132     H{ { 3 4 } }
 133 ] [
 134     H{ { 1 2 } { 3 4 } } clone H{ { 1 3 } } assoc-diff!
 135 ] unit-test
 136
 137 [ H{ { "hi" 2 } { 3 4 } } ]
 138 [ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
 139 unit-test
 140
 141 [ H{ { 1 2 } { 3 4 } } ]
 142 [ "hi" 5 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
 143 unit-test
 144
 145 [
 146     H{ { 1.0 1.0 } { 2.0 2.0 } }
 147 ] [
 148     double-array{ 1.0 2.0 } [ dup ] H{ } map>assoc
 149 ] unit-test
 150
 151 [ { 3 } ] [
 152     [
 153         3
 154         H{ } clone
 155         2 [
 156             2dup [ , f ] cache drop
 157         ] times
 158         2drop
 159     ] { } make
 160 ] unit-test
 161
 162 [
 163     H{
 164         { "bangers" "mash" }
 165         { "fries" "onion rings" }
 166     }
 167 ] [
 168     { "bangers" "fries" } H{
 169         { "fish" "chips" }
 170         { "bangers" "mash" }
 171         { "fries" "onion rings" }
 172         { "nachos" "cheese" }
 173     } extract-keys
 174 ] unit-test
 175
 176 [ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } ] [
 177     H{
 178         { "a" [ 1 ] }
 179         { "b" [ 2 ] }
 180         { "c" [ 3 ] }
 181         { "d" [ 4 ] }
 182     } [ nip first even? ] assoc-partition
 183 ] unit-test
 184
 185 [ 1 f ] [ 1 H{ } ?at ] unit-test
 186 [ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test
 187
 188 [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 189 [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 190 [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
 191
 192 [ H{ { 1 2 } { 2 3 } } ] [
 193     {
 194         H{ { 1 3 } }
 195         H{ { 2 3 } }
 196         H{ { 1 2 } }
 197     } assoc-combine
 198 ] unit-test
 199
 200 [ H{ { 1 7 } } ] [
 201     {
 202         H{ { 1 2 } { 2 4 } { 5 6 } }
 203         H{ { 1 3 } { 2 5 } }
 204         H{ { 1 7 } { 5 6 } }
 205     } assoc-refine
 206 ] unit-test
 207
 208 [ f ] [ "a" { } assoc-stack ] unit-test
 209 [ 1 ] [ "a" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 210 [ 2 ] [ "b" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 211 [ f ] [ "c" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 212
 213
 214 {
 215     { { 1 f } }
 216 } [
 217     { { 1 f } { f 2 } } sift-keys
 218 ] unit-test
 219
 220 {
 221     { { f 2 } }
 222 } [
 223     { { 1 f } { f 2 } } sift-values
 224 ] unit-test
 225
 226 ! zip, zip-as
 227 {
 228     { { 1 4 } { 2 5 } { 3 6 } }
 229 } [ { 1 2 3 } { 4 5 6 } zip ] unit-test
 230
 231 {
 232     { { 1 4 } { 2 5 } { 3 6 } }
 233 } [ V{ 1 2 3 } { 4 5 6 } zip ] unit-test
 234
 235 {
 236     { { 1 4 } { 2 5 } { 3 6 } }
 237 } [ { 1 2 3 } { 4 5 6 } { } zip-as ] unit-test
 238
 239 {
 240     { { 1 4 } { 2 5 } { 3 6 } }
 241 } [ B{ 1 2 3 } { 4 5 6 } { } zip-as ] unit-test
 242
 243 {
 244     V{ { 1 4 } { 2 5 } { 3 6 } }
 245 } [ { 1 2 3 } { 4 5 6 } V{ } zip-as ] unit-test
 246
 247 {
 248     V{ { 1 4 } { 2 5 } { 3 6 } }
 249 } [ BV{ 1 2 3 } BV{ 4 5 6 } V{ } zip-as ] unit-test
 250
 251 { { { 1 3 } { 2 4 } }
 252 } [ { 1 2 } { 3 4 } { } zip-as ] unit-test
 253
 254 {
 255     V{ { 1 3 } { 2 4 } }
 256 } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
 257
 258 {
 259     H{ { 1 3 } { 2 4 } }
 260 } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
 261
 262 ! zip-index, zip-index-as
 263 {
 264     { { 11 0 } { 22 1 } { 33 2 } }
 265 } [ { 11 22 33 } zip-index ] unit-test
 266
 267 {
 268     { { 11 0 } { 22 1 } { 33 2 } }
 269 } [ V{ 11 22 33 } zip-index ] unit-test
 270
 271 {
 272     { { 11 0 } { 22 1 } { 33 2 } }
 273 } [ { 11 22 33 } { } zip-index-as ] unit-test
 274
 275 {
 276     { { 11 0 } { 22 1 } { 33 2 } }
 277 } [ V{ 11 22 33 } { } zip-index-as ] unit-test
 278
 279 {
 280     V{ { 11 0 } { 22 1 } { 33 2 } }
 281 } [ { 11 22 33 } V{ } zip-index-as ] unit-test