extra/assocs/extras/extras-tests.factor

   1 USING: arrays assocs.extras kernel math math.order sequences tools.test ;
   2
   3 { f } [ f { } deep-at ] unit-test
   4 { f } [ f { "foo" } deep-at ] unit-test
   5 { f } [ H{ } { 1 2 3 } deep-at ] unit-test
   6 { f } [ H{ { "a" H{ { "b" 1 } } } } { "a" "c" } deep-at ] unit-test
   7 { 1 } [ H{ { "a" H{ { "b" 1 } } } } { "a" "b" } deep-at ] unit-test
   8 { 4 } [ H{ { 1 H{ { 2 H{ { 3 4 } } } } } } { 1 2 3 } deep-at ] unit-test
   9
  10 { H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
  11
  12 { H{ { "a" V{ 2 5 } } { "b" V{ 3 } } { "c" V{ 10 } } } }
  13 [
  14     { H{ { "a" 2 } { "b" 3 } } H{ { "a" 5 } { "c" 10 } } }
  15     [ ] [ assoc-collect ] map-reduce
  16 ] unit-test
  17
  18 { H{ } } [ H{ { 1 2 } } 2 over delete-value-at ] unit-test
  19 { H{ { 1 2 } } } [ H{ { 1 2 } } 3 over delete-value-at ] unit-test
  20
  21 {
  22     H{ { 1 3 } { 2 3 } }
  23 } [
  24     {
  25         { { 1 2 } 3 }
  26     } expand-keys-set-at
  27 ] unit-test
  28
  29 {
  30     H{ { 3 4 } }
  31 } [
  32     {
  33         { 3 { 1 2 } } { 3 4 }
  34     } expand-values-set-at
  35 ] unit-test
  36
  37 {
  38     H{ { 1 V{ 3 } } { 2 V{ 3 } } }
  39 } [
  40     {
  41         { { 1 2 } 3 }
  42     } expand-keys-push-at
  43 ] unit-test
  44
  45 {
  46     H{ { 3 V{ 1 2 4 } } }
  47 } [
  48     {
  49         { 3 { 1 2 } } { 3 4 }
  50     } expand-values-push-at
  51 ] unit-test
  52
  53 {
  54     H{ { 1 [ sq ] } { 2 [ sq ] } }
  55 } [
  56     { { { 1 2 { 1 } { 2 } { 1 1 } } [ sq ] } } flatten-keys
  57 ] unit-test
  58
  59 {
  60     H{ { "1" 1 } { "2" 2 } }
  61 } [
  62     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  63     { "1" "2" "2" }
  64     rekey-new-assoc
  65 ] unit-test
  66
  67 { f } [
  68     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  69     [ { "1" "2" "2" } rekey-new-assoc ] keep eq?
  70 ] unit-test
  71
  72 {
  73     H{ { "1" 1 } { "2" 2 } }
  74 } [
  75     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  76     { "1" "2" "2" }
  77     rekey-assoc
  78 ] unit-test
  79
  80 { t } [
  81     H{ { "1" 1 } { "2" 2 } { "3" 3 } }
  82     [ { "1" "2" "2" } rekey-assoc ] keep eq?
  83 ] unit-test
  84
  85 { H{ { 1 11 } { 2 22 } { 3 33 } } } [
  86     H{ { 1 11 } { 2 20 } }
  87     H{ { 2 22 } { 3 33 } }
  88     [ max ] assoc-merge
  89 ] unit-test
  90
  91 { H{ { 1 11 } { 2 22 } { 3 33 } } } [
  92     H{ { 2 22 } { 3 33 } }
  93     H{ { 1 11 } { 2 20 } }
  94     [ max ] assoc-merge
  95 ] unit-test
  96
  97 { H{ { 1 11 } { 2 20 } { 3 33 } } } [
  98     H{ { 1 11 } { 2 20 } }
  99     H{ { 2 22 } { 3 33 } }
 100     [ min ] assoc-merge
 101 ] unit-test
 102
 103 { f } [ f f [ min ] assoc-merge ] unit-test
 104
 105 ! Ensure non-destructive
 106 {
 107     H{ { 1 11 } { 2 20 } }
 108     H{ { 2 22 } { 3 33 } }
 109     H{ { 1 11 } { 2 20 } { 3 33 } }
 110 } [
 111     H{ { 1 11 } { 2 20 } }
 112     H{ { 2 22 } { 3 33 } } 2dup
 113     [ min ] assoc-merge
 114 ] unit-test
 115
 116 ! Ensure destructive
 117 {
 118     H{ { 1 11 } { 2 20 } { 3 33 } }
 119     H{ { 2 22 } { 3 33 } }
 120     H{ { 1 11 } { 2 20 } { 3 33 } }
 121 } [
 122     H{ { 1 11 } { 2 20 } }
 123     H{ { 2 22 } { 3 33 } } 2dup
 124     [ min ] assoc-merge!
 125 ] unit-test
 126
 127 ! assoc-collapse
 128 { f } [ f [ min ] assoc-collapse ] unit-test
 129
 130 {
 131     H{ { 1 11 } { 2 20 } }
 132     H{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 133 } [
 134     H{ { 1 11 } { 2 20 } } dup
 135     H{ { 2 22 } { 3 33 } }
 136     H{ { 3 30 } { 4 40 } } 3array
 137     [ min ] assoc-collapse
 138 ] unit-test
 139
 140 {
 141     H{ { 2 22 } { 3 30 } { 4 40 } }
 142 } [
 143     f
 144     H{ { 2 22 } { 3 33 } }
 145     H{ { 3 30 } { 4 40 } } 3array
 146     [ min ] assoc-collapse
 147 ] unit-test
 148
 149 {
 150     H{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 151 } [
 152     H{ { 1 11 } { 2 20 } } dup
 153     H{ { 2 22 } { 3 33 } }
 154     H{ { 3 30 } { 4 40 } } 3array
 155     [ min ] assoc-collapse!
 156 ] unit-test
 157
 158 {
 159     H{ { 1 11 } { 2 20 } }
 160     V{ { 1 11 } { 2 20 } { 3 30 } { 4 40 } }
 161 } [
 162     H{ { 1 11 } { 2 20 } } dup
 163     H{ { 2 22 } { 3 33 } }
 164     H{ { 3 30 } { 4 40 } } 3array
 165     [ min ] V{ } assoc-collapse-as
 166 ] unit-test
 167
 168 {
 169     H{ { 1 V{ 10 } } { 2 V{ 10 } } { 3 V{ 10 } } { 4 V{ 10 } } { 5 V{ 10 } } }
 170 } [
 171     H{ } clone 10 { 1 2 3 4 5 } pick push-at-each
 172 ] unit-test
 173
 174 {
 175     H{
 176         { 1 V{ 10 20 30 40 50 60 } }
 177         { 2 V{ 10 20 30 40 50 60 } }
 178         { 3 V{ 10 20 30 40 50 60 } }
 179         { 4 V{ 10 20 30 40 50 60 } }
 180         { 5 V{ 10 20 30 40 50 60 } }
 181     }
 182 } [
 183     { 10 20 30 } [ drop { 1 2 3 4 5 } ] collect-by-multi
 184     { 40 50 60 } [ drop { 1 2 3 4 5 } ] collect-by-multi!
 185 ] unit-test