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