core/assocs/assocs-tests.factor

   1 IN: assocs.tests
   2 USING: kernel math namespaces make tools.test vectors sequences
   3 sequences.private hashtables io prettyprint assocs
   4 continuations specialized-arrays.double ;
   5
   6 [ t ] [ H{ } dup assoc-subset? ] unit-test
   7 [ f ] [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test
   8 [ t ] [ H{ } H{ { 1 3 } } assoc-subset? ] unit-test
   9 [ t ] [ H{ { 1 3 } } H{ { 1 3 } } assoc-subset? ] unit-test
  10 [ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } assoc-subset? ] unit-test
  11 [ f ] [ H{ { 1 f } } H{ } assoc-subset? ] unit-test
  12 [ t ] [ H{ { 1 f } } H{ { 1 f } } assoc-subset? ] unit-test
  13
  14 ! Test some combinators
  15 [
  16     { 4 14 32 }
  17 ] [
  18     [
  19         H{
  20             { 1 2 }
  21             { 3 4 }
  22             { 5 6 }
  23         } [ * 2 + , ] assoc-each
  24     ] { } make
  25 ] unit-test
  26
  27 [ t ] [ H{ } [ 2drop f ] assoc-all? ] unit-test
  28 [ t ] [ H{ { 1 1 } } [ = ] assoc-all? ] unit-test
  29 [ f ] [ H{ { 1 2 } } [ = ] assoc-all? ] unit-test
  30 [ t ] [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test
  31 [ f ] [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test
  32
  33 [ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test
  34 [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
  35     H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
  36     [ drop 3 >= ] assoc-filter
  37 ] unit-test
  38
  39 [ 21 ] [
  40     0 H{
  41         { 1 2 }
  42         { 3 4 }
  43         { 5 6 }
  44     } [
  45         + +
  46     ] assoc-each
  47 ] unit-test
  48
  49 H{ } clone "cache-test" set
  50
  51 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  52 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  53 [ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
  54 [ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
  55
  56 [
  57     H{ { "factor" "rocks" } { 3 4 } }
  58 ] [
  59     H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } }
  60     H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } }
  61     assoc-intersect
  62 ] unit-test
  63
  64 [
  65     H{ { 1 2 } { 2 3 } { 6 5 } }
  66 ] [
  67     H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } }
  68     assoc-union
  69 ] unit-test
  70
  71 [ H{ { 1 2 } { 2 3 } } t ] [
  72     f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
  73 ] unit-test
  74
  75 [
  76     H{ { 1 f } }
  77 ] [
  78     H{ { 1 f } } H{ { 1 f } } assoc-intersect
  79 ] unit-test
  80
  81 [ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test
  82
  83 [ H{ { "hi" 2 } { 3 4 } } ]
  84 [ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
  85 unit-test
  86
  87 [ H{ { 1 2 } { 3 4 } } ]
  88 [ "hi" 5 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
  89 unit-test
  90
  91 [
  92     H{ { 1.0 1.0 } { 2.0 2.0 } }
  93 ] [
  94     double-array{ 1.0 2.0 } [ dup ] H{ } map>assoc
  95 ] unit-test
  96
  97 [ { 3 } ] [
  98     [
  99         3
 100         H{ } clone
 101         2 [
 102             2dup [ , f ] cache drop
 103         ] times
 104         2drop
 105     ] { } make
 106 ] unit-test
 107
 108 [
 109     H{
 110         { "bangers" "mash" }
 111         { "fries" "onion rings" }
 112     }
 113 ] [
 114     { "bangers" "fries" } H{
 115         { "fish" "chips" }
 116         { "bangers" "mash" }
 117         { "fries" "onion rings" }
 118         { "nachos" "cheese" }
 119     } extract-keys
 120 ] unit-test
 121
 122 [ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } ] [
 123     H{
 124         { "a" [ 1 ] }
 125         { "b" [ 2 ] }
 126         { "c" [ 3 ] }
 127         { "d" [ 4 ] }
 128     } [ nip first even? ] assoc-partition
 129 ] unit-test
 130
 131 [ 1 f ] [ 1 H{ } ?at ] unit-test
 132 [ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test
 133
 134 [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 135 [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 136 [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test