extra/assocs/extras/extras-tests.factor

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