extra/assocs/extras/extras-tests.factor

   1 USING: arrays assocs assocs.extras kernel math math.order
   2 sequences tools.test ;
   3
   4 {
   5     H{ { 1 V{ 10 } } { 2 V{ 10 } } { 3 V{ 10 } } { 4 V{ 10 } } { 5 V{ 10 } } }
   6 } [
   7     H{ } clone 10 { 1 2 3 4 5 } pick push-at-each
   8 ] unit-test
   9
  10 { f } [ f { } deep-of ] unit-test
  11 { f } [ f { "foo" } deep-of ] unit-test
  12 { f } [ H{ } { 1 2 3 } deep-of ] unit-test
  13 { f } [ H{ { "a" H{ { "b" 1 } } } } { "a" "c" } deep-of ] unit-test
  14 { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-of ] unit-test
  15 { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-of ] unit-test
  16
  17 { H{ { 1 H{ { 2 H{ { 3 44 } } } } } } } [
  18     H{ { 1 H{ { 2 H{ { 3 4 } } } } } } dup { 1 2 3 } [ 40 + ] deep-change-of
  19 ] unit-test
  20
  21 { H{ { 1 H{ { 2 H{ { 3 40 } } } } } } } [
  22     H{ { 1 H{ { 2 H{ { 3 4 } } } } } } dup { 1 2 3 } 40 deep-set-of
  23 ] unit-test
  24
  25 { H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
  26
  27 { H{ { "a" V{ 2 5 } } { "b" V{ 3 } } { "c" V{ 10 } } } }
  28 [
  29     { H{ { "a" 2 } { "b" 3 } } H{ { "a" 5 } { "c" 10 } } }
  30     [ ] [ assoc-collect ] map-reduce
  31 ] unit-test
  32
  33 { H{ } } [ H{ { 1 2 } } 2 over delete-value-at ] unit-test
  34 { H{ { 1 2 } } } [ H{ { 1 2 } } 3 over delete-value-at ] unit-test
  35
  36 {
  37     H{ { 1 3 } { 2 3 } }
  38 } [
  39     {
  40         { { 1 2 } 3 }
  41     } expand-keys-set-at
  42 ] unit-test
  43
  44 {
  45     H{ { 3 4 } }
  46 } [
  47     {
  48         { 3 { 1 2 } } { 3 4 }
  49     } expand-values-set-at
  50 ] unit-test
  51
  52 {
  53     H{ { 1 V{ 3 } } { 2 V{ 3 } } }
  54 } [
  55     {
  56         { { 1 2 } 3 }
  57     } expand-keys-push-at
  58 ] unit-test
  59
  60 {
  61     H{ { 3 V{ 1 2 4 } } }
  62 } [
  63     {
  64         { 3 { 1 2 } } { 3 4 }
  65     } expand-values-push-at
  66 ] unit-test
  67
  68 {
  69     H{ { 1 [ sq ] } { 2 [ sq ] } }
  70 } [
  71     { { { 1 2 { 1 } { 2 } { 1 1 } } [ sq ] } } flatten-keys
  72 ] unit-test
  73
  74 {
  75     H{ { "1" 1 } { "2" 2 } }
  76 } [
  77     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  78     { "1" "2" "2" }
  79     rekey-new-assoc
  80 ] unit-test
  81
  82 { f } [
  83     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  84     [ { "1" "2" "2" } rekey-new-assoc ] keep eq?
  85 ] unit-test
  86
  87 {
  88     H{ { "1" 1 } { "2" 2 } }
  89 } [
  90     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  91     { "1" "2" "2" }
  92     rekey-assoc
  93 ] unit-test
  94
  95 { t } [
  96     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  97     [ { "1" "2" "2" } rekey-assoc ] keep eq?
  98 ] unit-test
  99
 100 { H{ { 1 11 } { 2 22 } { 3 33 } } } [
 101     H{ { 1 11 } { 2 20 } }
 102     H{ { 2 22 } { 3 33 } }
 103     [ max ] assoc-merge
 104 ] unit-test
 105
 106 { H{ { 1 11 } { 2 22 } { 3 33 } } } [
 107     H{ { 2 22 } { 3 33 } }
 108     H{ { 1 11 } { 2 20 } }
 109     [ max ] assoc-merge
 110 ] unit-test
 111
 112 { H{ { 1 11 } { 2 20 } { 3 33 } } } [
 113     H{ { 1 11 } { 2 20 } }
 114     H{ { 2 22 } { 3 33 } }
 115     [ min ] assoc-merge
 116 ] unit-test
 117
 118 { f } [ f f [ min ] assoc-merge ] unit-test
 119
 120 ! Ensure non-destructive
 121 {
 122     H{ { 1 11 } { 2 20 } }
 123     H{ { 2 22 } { 3 33 } }
 124     H{ { 1 11 } { 2 20 } { 3 33 } }
 125 } [
 126     H{ { 1 11 } { 2 20 } }
 127     H{ { 2 22 } { 3 33 } } 2dup
 128     [ min ] assoc-merge
 129 ] unit-test
 130
 131 ! Ensure destructive
 132 {
 133     H{ { 1 11 } { 2 20 } { 3 33 } }
 134     H{ { 2 22 } { 3 33 } }
 135     H{ { 1 11 } { 2 20 } { 3 33 } }
 136 } [
 137     H{ { 1 11 } { 2 20 } }
 138     H{ { 2 22 } { 3 33 } } 2dup
 139     [ min ] assoc-merge!
 140 ] unit-test
 141
 142 ! assoc-collapse
 143 { f } [ f [ min ] assoc-collapse ] unit-test
 144
 145 {
 146     H{ { 1 11 } { 2 20 } }
 147     H{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 148 } [
 149     H{ { 1 11 } { 2 20 } } dup
 150     H{ { 2 22 } { 3 33 } }
 151     H{ { 3 30 } { 4 40 } } 3array
 152     [ min ] assoc-collapse
 153 ] unit-test
 154
 155 {
 156     H{ { 2 22 } { 3 30 } { 4 40 } }
 157 } [
 158     f
 159     H{ { 2 22 } { 3 33 } }
 160     H{ { 3 30 } { 4 40 } } 3array
 161     [ min ] assoc-collapse
 162 ] unit-test
 163
 164 {
 165     H{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 166 } [
 167     H{ { 1 11 } { 2 20 } } dup
 168     H{ { 2 22 } { 3 33 } }
 169     H{ { 3 30 } { 4 40 } } 3array
 170     [ min ] assoc-collapse!
 171 ] unit-test
 172
 173 {
 174     H{ { 1 11 } { 2 20 } }
 175     V{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 176 } [
 177     H{ { 1 11 } { 2 20 } } dup
 178     H{ { 2 22 } { 3 33 } }
 179     H{ { 3 30 } { 4 40 } } 3array
 180     [ min ] V{ } assoc-collapse-as
 181 ] unit-test
 182
 183
 184 {
 185     H{
 186         { 41 V{ 401 } }
 187         { 10 V{ 100 } }
 188         { 20 V{ 200 } }
 189         { 30 V{ 300 } }
 190     }
 191 } [
 192     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 193     [ ] collect-assoc-by
 194 ] unit-test
 195
 196 {
 197     H{ { t V{ 100 200 300 } } { f V{ 401 } } }
 198 } [
 199     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 200     [ [ even? ] dip ] collect-assoc-by
 201 ] unit-test
 202
 203 {
 204     H{
 205         { t V{ { 10 100 } { 20 200 } { 30 300 } } }
 206         { f V{ { 41 401 } } }
 207     }
 208 } [
 209     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 210     [ [ drop even? ] [ 2array ] 2bi ] collect-assoc-by
 211 ] unit-test
 212
 213
 214 {
 215     H{ { t V{ 10 21 } } { f V{ 30 41 } } }
 216 } [
 217     { { 10 100 } { 21 200 } { 30 301 } { 41 401 } }
 218     [ nip even? ] collect-key-by
 219  ] unit-test
 220
 221 {
 222     H{ { t V{ 10 30 } } { f V{ 21 41 } } }
 223 } [
 224     { { 10 100 } { 21 200 } { 30 301 } { 41 401 } }
 225     [ drop even? ] collect-key-by
 226  ] unit-test
 227
 228
 229 {
 230     H{ { t V{ 100 200 } } { f V{ 301 401 } } }
 231 } [
 232     { { 10 100 } { 21 200 } { 30 301 } { 41 401 } }
 233     [ nip even? ] collect-value-by
 234  ] unit-test
 235
 236 {
 237     H{ { t V{ 100 301 } } { f V{ 200 401 } } }
 238 } [
 239     { { 10 100 } { 21 200 } { 30 301 } { 41 401 } }
 240     [ drop even? ] collect-value-by
 241  ] unit-test
 242
 243 {
 244     H{
 245         { 1 V{ 10 20 30 40 50 60 } }
 246         { 2 V{ 10 20 30 40 50 60 } }
 247         { 3 V{ 10 20 30 40 50 60 } }
 248         { 4 V{ 10 20 30 40 50 60 } }
 249         { 5 V{ 10 20 30 40 50 60 } }
 250     }
 251 } [
 252     { 10 20 30 } [ drop { 1 2 3 4 5 } ] collect-by-multi
 253     { 40 50 60 } [ drop { 1 2 3 4 5 } ] collect-by-multi!
 254 ] unit-test
 255
 256
 257
 258 {
 259     H{
 260         { 20 V{ 20 } }
 261         { 21 V{ 20 } }
 262         { 41 V{ 41 } }
 263         { 10 V{ 10 } }
 264         { 11 V{ 10 } }
 265         { 42 V{ 41 } }
 266         { 30 V{ 30 } }
 267         { 31 V{ 30 } }
 268     }
 269 } [
 270     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 271     [ drop dup 1 + 2array ] collect-key-by-multi
 272 ] unit-test
 273
 274
 275 {
 276     H{
 277         { 401 V{ 401 } }
 278         { 402 V{ 401 } }
 279         { 100 V{ 100 } }
 280         { 101 V{ 100 } }
 281         { 200 V{ 200 } }
 282         { 201 V{ 200 } }
 283         { 300 V{ 300 } }
 284         { 301 V{ 300 } }
 285     }
 286 } [
 287     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 288     [ nip dup 1 + 2array ] collect-value-by-multi
 289 ] unit-test
 290
 291
 292 {
 293     H{
 294         { 20 V{ 200 } }
 295         { 21 V{ 200 } }
 296         { 41 V{ 401 } }
 297         { 10 V{ 100 } }
 298         { 11 V{ 100 } }
 299         { 42 V{ 401 } }
 300         { 30 V{ 300 } }
 301         { 31 V{ 300 } }
 302     }
 303 } [
 304     { { 10 100 } { 20 200 } { 30 300 } { 41 401 } }
 305     [ [ dup 1 + 2array ] dip ] collect-assoc-by-multi
 306 ] unit-test
 307
 308 { H{ { 1 2 } { 3 4 } } } [
 309     H{ { 1 2 } { 3 4 } { 5 6 } }
 310     { 1 3 } intersect-keys
 311 ] unit-test
 312
 313 { { { 1 2 } { 3 4 } } } [
 314     H{ { 1 2 } { 3 4 } { 5 6 } }
 315     { 1 3 } { } intersect-keys-as
 316 ] unit-test
 317
 318
 319 { H{ { 1 100 } } } [
 320     H{ } clone 1 100 set-of
 321 ] unit-test
 322
 323 { H{ { 1 V{ 100 200 } } } } [
 324     H{ } clone 1 100 push-of 1 200 push-of
 325 ] unit-test
 326
 327 { H{ { 123 556 } } } [
 328     H{ { 123 456 } } 123 [ 100 + ] change-of
 329 ] unit-test
 330
 331 { H{ { 123 556 } } } [
 332     H{ { 123 456 } } 123 [ 100 + ] ?change-of
 333 ] unit-test
 334
 335 { H{ { 123 456 } } } [
 336     H{ { 123 456 } } 1234 [ 100 + ] ?change-of
 337 ] unit-test
 338
 339 { H{ { 10 2 } } } [
 340     H{ { 10 1 } } 10 inc-of
 341 ] unit-test
 342
 343 { H{ { 10 1001 } } } [
 344     H{ { 10 1 } } 10 1000 of+
 345 ] unit-test
 346
 347 { H{ { 1 100 } } f } [
 348     H{ { 1 100 } } 1 100 maybe-set-of
 349 ] unit-test
 350
 351 { H{ { 1 100 } { 2 100 } } t } [
 352     H{ { 1 100 } } 2 100 maybe-set-of
 353 ] unit-test
 354
 355 { H{ { 1 100 } } t } [
 356     H{ { 1 100 } } 1 101 maybe-set-of
 357 ] unit-test