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