basis/sequences/generalizations/generalizations-tests.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: tools.test generalizations kernel math arrays sequences
   3 sequences.generalizations ascii fry math.parser io io.streams.string ;
   4 IN: sequences.generalizations.tests
   5
   6 { 1 2 3 4 } [ { 1 2 3 4 } 4 firstn ] unit-test
   7 { { 1 2 3 4 } } [ 1 2 3 4 { f f f f } [ 4 set-firstn ] keep ] unit-test
   8 [ 1 2 3 4 { f f f } [ 4 set-firstn ] keep ] must-fail
   9 { } [ { } 0 firstn ] unit-test
  10 { "a" } [ { "a" } 1 firstn ] unit-test
  11
  12 { [ 1 2 ] } [ 1 2 2 [ ] nsequence ] unit-test
  13
  14 { { 1 2 3 4 } } [ { 1 } { 2 } { 3 } { 4 } 4 nappend ] unit-test
  15 { V{ 1 2 3 4 } } [ { 1 } { 2 } { 3 } { 4 } 4 V{ } nappend-as ] unit-test
  16
  17 [ 4 nappend ] must-infer
  18 [ 4 { } nappend-as ] must-infer
  19
  20 : neach-test ( a b c d -- )
  21     [ 4 nappend print ] 4 neach ;
  22 : nmap-test ( a b c d -- e )
  23     [ 4 nappend ] 4 nmap ;
  24 : nmap-as-test ( a b c d -- e )
  25     [ 4 nappend ] [ ] 4 nmap-as ;
  26 : mnmap-3-test ( a b c d -- e f g )
  27     [ append ] 4 3 mnmap ;
  28 : mnmap-2-test ( a b c d -- e f )
  29     [ [ append ] 2bi@ ] 4 2 mnmap ;
  30 : mnmap-as-test ( a b c d -- e f )
  31     [ [ append ] 2bi@ ] { } [ ] 4 2 mnmap-as ;
  32 : mnmap-1-test ( a b c d -- e )
  33     [ 4 nappend ] 4 1 mnmap ;
  34 : mnmap-0-test ( a b c d -- )
  35     [ 4 nappend print ] 4 0 mnmap ;
  36 : nproduce-as-test ( n -- a b )
  37     [ dup zero? not ]
  38     [ [ 2 - ] [ ] [ 1 - ] tri ] { } B{ } 2 nproduce-as
  39     [ drop ] 2dip ;
  40 : nproduce-test ( n -- a b )
  41     [ dup zero? not ]
  42     [ [ 2 - ] [ ] [ 1 - ] tri ] 2 nproduce
  43     [ drop ] 2dip ;
  44
  45 { "A1a!
  46 B2b@
  47 C3c#
  48 D4d$
  49 " } [
  50     { "A" "B" "C" "D" }
  51     { "1" "2" "3" "4" }
  52     { "a" "b" "c" "d" }
  53     { "!" "@" "#" "$" }
  54     [ neach-test ] with-string-writer
  55 ] unit-test
  56
  57 { { "A1a!" "B2b@" "C3c#" "D4d$" } }
  58 [
  59     { "A" "B" "C" "D" }
  60     { "1" "2" "3" "4" }
  61     { "a" "b" "c" "d" }
  62     { "!" "@" "#" "$" }
  63     nmap-test
  64 ] unit-test
  65
  66 { [ "A1a!" "B2b@" "C3c#" "D4d$" ] }
  67 [
  68     { "A" "B" "C" "D" }
  69     { "1" "2" "3" "4" }
  70     { "a" "b" "c" "d" }
  71     { "!" "@" "#" "$" }
  72     nmap-as-test
  73 ] unit-test
  74
  75 {
  76     { "A" "B" "C" "D" }
  77     { "1" "2" "3" "4" }
  78     { "a!" "b@" "c#" "d$" }
  79 } [
  80     { "A" "B" "C" "D" }
  81     { "1" "2" "3" "4" }
  82     { "a" "b" "c" "d" }
  83     { "!" "@" "#" "$" }
  84     mnmap-3-test
  85 ] unit-test
  86
  87 {
  88     { "A1" "B2" "C3" "D4" }
  89     { "a!" "b@" "c#" "d$" }
  90 } [
  91     { "A" "B" "C" "D" }
  92     { "1" "2" "3" "4" }
  93     { "a" "b" "c" "d" }
  94     { "!" "@" "#" "$" }
  95     mnmap-2-test
  96 ] unit-test
  97
  98 {
  99     { "A1" "B2" "C3" "D4" }
 100     [ "a!" "b@" "c#" "d$" ]
 101 } [
 102     { "A" "B" "C" "D" }
 103     { "1" "2" "3" "4" }
 104     { "a" "b" "c" "d" }
 105     { "!" "@" "#" "$" }
 106     mnmap-as-test
 107 ] unit-test
 108
 109 { { "A1a!" "B2b@" "C3c#" "D4d$" } }
 110 [
 111     { "A" "B" "C" "D" }
 112     { "1" "2" "3" "4" }
 113     { "a" "b" "c" "d" }
 114     { "!" "@" "#" "$" }
 115     mnmap-1-test
 116 ] unit-test
 117
 118 { "A1a!
 119 B2b@
 120 C3c#
 121 D4d$
 122 " } [
 123     { "A" "B" "C" "D" }
 124     { "1" "2" "3" "4" }
 125     { "a" "b" "c" "d" }
 126     { "!" "@" "#" "$" }
 127     [ mnmap-0-test ] with-string-writer
 128 ] unit-test
 129
 130 { { 10 8 6 4 2 } B{ 9 7 5 3 1 } }
 131 [ 10 nproduce-as-test ] unit-test
 132
 133 { { 10 8 6 4 2 } { 9 7 5 3 1 } }
 134 [ 10 nproduce-test ] unit-test
 135
 136 { 45 } [
 137     { 1 2 3 } { 4 5 6 } { 7 8 9 } [ + + ] [ + ] 3 nmap-reduce
 138 ] unit-test
 139
 140 { t } [
 141     { 1 3 5 } { 2 4 6 } { 4 8 12 } [ + + odd? ] 3 nall?
 142 ] unit-test
 143
 144 { t } [
 145     { 2 4 5 } { 4 6 7 } { 6 8 9 }
 146     [ [ odd? ] tri@ and and ] 3 nany?
 147 ] unit-test
 148
 149 { f } [
 150     { 1 2 3 } { 4 5 6 } { 7 8 9 }
 151     [ [ odd? ] tri@ and and ] 3 nany?
 152 ] unit-test