}
} ;
+HELP: cartesian-find
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation ( ... elt1 elt2 -- ... ? ) } } { "elt1" object } { "elt2" object } }
+{ $description "Applies the quotation to every possible pairing of elements from the two sequences, returning the first two elements where the quotation returns a true value." } ;
+
HELP: cartesian-each
{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation ( ... elt1 elt2 -- ... ) } } }
{ $description "Applies the quotation to every possible pairing of elements from the two sequences." } ;
{ $subsections
cartesian-each
cartesian-map
+ cartesian-find
}
"Computing the cartesian product of two sequences:"
{ $subsections
{ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } }
[ { 1 2 } { "a" "b" } cartesian-product ] unit-test
+{ 2 4 } [ { 1 2 3 } { 4 5 6 } [ [ even? ] both? ] cartesian-find ] unit-test
+{ f f } [ { 1 2 3 } { 4 5 6 } [ [ 10 > ] both? ] cartesian-find ] unit-test
+
[ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
[ { } [ ] [ + ] map-reduce ] must-fail
{ 4 } [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
: cartesian-product ( seq1 seq2 -- newseq )
[ { } 2sequence ] cartesian-map ;
+: cartesian-find ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... elt1 elt2 )
+ [ f ] 3dip [ with find swap ] 2curry [ nip ] prepose find nip swap ; inline
+
<PRIVATE
: select-by ( ... seq quot: ( ... elt -- ... x ) compare: ( obj1 obj2 -- ? ) -- ... elt )