Paste: multi-way cross-product

Author: Simon Richard Clarkstone
Mode: factor
Date: Sun, 22 Feb 2009 19:57:08
Plain Text | 
TUPLE: cross first rest ;
C: <cross> cross ( seq cross -- cross )
: >cross< ( cross -- first rest )  dup first>> swap rest>> ;
INSTANCE: cross sequence
: indexes ( n cross -- first-n rest-n )  rest>> length /mod ;
: 2nth ( n1 n2 seq1 seq2 -- elt1 elt2 )  swapd [ nth ] 2bi@ ;
M: cross nth  [ indexes ] keep >cross< 2nth swap prefix ;
M: cross length  dup first>> length swap rest>> length * ;
: n<cross> ( seqs -- cross )
    [ { { } } clone ] [ unclip swap n<cross> <cross> ] if-empty ;

Annotation: Unit tests for cross-product

Author: Simon Richard Clarkstone
Mode: factor
Date: Sun, 22 Feb 2009 19:58:59
Plain Text | 
{ { { 5 } { 42 } } } [ { 5 42 } { { } } <cross> >array ] unit-test
{ { "am" "an" "bm" "bn" "cm" "cn" } }
  [ "abc" "mn" { "" } <cross> <cross>  >array ] unit-test
{ { "amx" "amy" "amz" "anx" "any" "anz" "aox" "aoy" "aoz"
    "bmx" "bmy" "bmz" "bnx" "bny" "bnz" "box" "boy" "boz"
    "cmx" "cmy" "cmz" "cnx" "cny" "cnz" "cox" "coy" "coz" } }
  [ "abc" "mno" "xyz" { "" } <cross> <cross> <cross>  >array ] unit-test
{ { "amx" "amy" "amz" "anx" "any" "anz" "aox" "aoy" "aoz"
    "bmx" "bmy" "bmz" "bnx" "bny" "bnz" "box" "boy" "boz"
    "cmx" "cmy" "cmz" "cnx" "cny" "cnz" "cox" "coy" "coz" } }
[ { "abc" "mno" "xyz" } n<cross> >array [ >string ] map ] unit-test

New Annotation

Summary:
Author:
Mode:
Body: