core/assocs/assocs-tests.factor

   1 USING: alien.c-types ascii assocs kernel make math namespaces
   2 sequences specialized-arrays tools.test ;
   3 IN: assocs.tests
   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 {
 152     { { 1.0 1.0 } { 2.0 2.0 } }
 153 } [
 154     double-array{ 1.0 2.0 } [ dup ] { } map>assoc
 155 ] unit-test
 156
 157 { { 3 } } [
 158     [
 159         3
 160         H{ } clone
 161         2 [
 162             2dup [ , f ] cache drop
 163         ] times
 164         2drop
 165     ] { } make
 166 ] unit-test
 167
 168 {
 169     H{
 170         { "bangers" "mash" }
 171         { "fries" "onion rings" }
 172     }
 173 } [
 174     { "bangers" "fries" } H{
 175         { "fish" "chips" }
 176         { "bangers" "mash" }
 177         { "fries" "onion rings" }
 178         { "nachos" "cheese" }
 179     } extract-keys
 180 ] unit-test
 181
 182 { H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } } [
 183     H{
 184         { "a" [ 1 ] }
 185         { "b" [ 2 ] }
 186         { "c" [ 3 ] }
 187         { "d" [ 4 ] }
 188     } [ nip first even? ] assoc-partition
 189 ] unit-test
 190
 191 { 1 f } [ 1 H{ } ?at ] unit-test
 192 { 2 t } [ 1 H{ { 1 2 } } ?at ] unit-test
 193
 194 { f } [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 195 { t } [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 196 { t } [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
 197
 198 { H{ { 1 2 } { 2 3 } } } [
 199     {
 200         H{ { 1 3 } }
 201         H{ { 2 3 } }
 202         H{ { 1 2 } }
 203     } assoc-union-all
 204 ] unit-test
 205
 206 { H{ { 1 7 } } } [
 207     {
 208         H{ { 1 2 } { 2 4 } { 5 6 } }
 209         H{ { 1 3 } { 2 5 } }
 210         H{ { 1 7 } { 5 6 } }
 211     } assoc-intersect-all
 212 ] unit-test
 213
 214 { f } [ "a" { } assoc-stack ] unit-test
 215 { 1 } [ "a" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 216 { 2 } [ "b" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 217 { f } [ "c" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
 218
 219
 220 {
 221     { { 1 f } }
 222 } [
 223     { { 1 f } { f 2 } } sift-keys
 224 ] unit-test
 225
 226 {
 227     {
 228         { { 2 } 1 }
 229     }
 230 } [
 231     {
 232         { { 2 } 1 }
 233         { { } 3 }
 234     } harvest-keys
 235 ] unit-test
 236
 237 {
 238     {
 239         { 1 { 2 } }
 240     }
 241 } [
 242     {
 243         { 1 { 2 } }
 244         { 3 { } }
 245     } harvest-values
 246 ] unit-test
 247
 248 {
 249     { { f 2 } }
 250 } [
 251     { { 1 f } { f 2 } } sift-values
 252 ] unit-test
 253
 254 ! zip, zip-as
 255 {
 256     { { 1 4 } { 2 5 } { 3 6 } }
 257 } [ { 1 2 3 } { 4 5 6 } zip ] unit-test
 258
 259 {
 260     { { 1 4 } { 2 5 } { 3 6 } }
 261 } [ V{ 1 2 3 } { 4 5 6 } zip ] unit-test
 262
 263 {
 264     { { 1 4 } { 2 5 } { 3 6 } }
 265 } [ { 1 2 3 } { 4 5 6 } { } zip-as ] unit-test
 266
 267 {
 268     { { 1 4 } { 2 5 } { 3 6 } }
 269 } [ B{ 1 2 3 } { 4 5 6 } { } zip-as ] unit-test
 270
 271 {
 272     V{ { 1 4 } { 2 5 } { 3 6 } }
 273 } [ { 1 2 3 } { 4 5 6 } V{ } zip-as ] unit-test
 274
 275 {
 276     V{ { 1 4 } { 2 5 } { 3 6 } }
 277 } [ BV{ 1 2 3 } BV{ 4 5 6 } V{ } zip-as ] unit-test
 278
 279 { { { 1 3 } { 2 4 } }
 280 } [ { 1 2 } { 3 4 } { } zip-as ] unit-test
 281
 282 {
 283     V{ { 1 3 } { 2 4 } }
 284 } [ { 1 2 } { 3 4 } V{ } zip-as ] unit-test
 285
 286 {
 287     H{ { 1 3 } { 2 4 } }
 288 } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
 289
 290 ! zip-index, zip-index-as
 291 {
 292     { { 11 0 } { 22 1 } { 33 2 } }
 293 } [ { 11 22 33 } zip-index ] unit-test
 294
 295 {
 296     { { 11 0 } { 22 1 } { 33 2 } }
 297 } [ V{ 11 22 33 } zip-index ] unit-test
 298
 299 {
 300     { { 11 0 } { 22 1 } { 33 2 } }
 301 } [ { 11 22 33 } { } zip-index-as ] unit-test
 302
 303 {
 304     { { 11 0 } { 22 1 } { 33 2 } }
 305 } [ V{ 11 22 33 } { } zip-index-as ] unit-test
 306
 307 {
 308     V{ { 11 0 } { 22 1 } { 33 2 } }
 309 } [ { 11 22 33 } V{ } zip-index-as ] unit-test
 310
 311 ! zip-with, zip-with-as
 312 {
 313     { { "cat" 3 } { "food" 4 } { "is" 2 } { "yummy" 5 } }
 314 } [
 315     { "cat" "food" "is" "yummy" } [ length ] zip-with
 316 ] unit-test
 317
 318 {
 319     H{ { "cat" 3 } { "food" 4 } { "is" 2 } { "yummy" 5 } }
 320 } [
 321     { "cat" "food" "is" "yummy" } [ length ] H{ } zip-with-as
 322 ] unit-test
 323
 324 {
 325     H{
 326         { 0 V{ 0 3 6 9 } }
 327         { 1 V{ 1 4 7 } }
 328         { 2 V{ 2 5 8 } }
 329     }
 330 } [
 331     10 <iota> [ 3 mod ] collect-by
 332 ] unit-test
 333
 334 {
 335     H{
 336         { 0 V{ 0 3 6 9 0 3 6 9 } }
 337         { 1 V{ 1 4 7 1 4 7 } }
 338         { 2 V{ 2 5 8 2 5 8 } }
 339     }
 340 } [
 341     10 <iota> [ 3 mod ] collect-by
 342     10 <iota> [ 3 mod ] collect-by!
 343 ] unit-test
 344
 345 { H{ { 1 4 } } } [ H{ { 1 2 } } 1 over [ sq ] ?change-at ] unit-test
 346 { H{ { 1 2 } } } [ H{ { 1 2 } } 2 over [ sq ] ?change-at ] unit-test
 347 { H{ { 1 3 } } } [ H{ { 1 2 } } 3 1 pick [ drop dup ] ?change-at drop ] unit-test