Rolf Ade posted a question to the chat asking how to form the Cartesian product of a set of lists. That is, given a list like,
{ { a b c } { d e f } }he wanted
{{a d} {a e} {a f} {b d} {b e} {b f} {c d} {c e} {c f}}He also wanted it to generalize to higher dimension: given
{{a b} {c d} {e f}}he wanted
{{a c e} {a c f} {a d e} {a d f} {b c e} {b c f} {b d e} {b d f}}and so on.
Kevin Kenny proposed the following:
proc crossProduct { listOfLists } {
if { [llength $listOfLists] == 0 } {
return [list [list]]
} else {
set result [list]
foreach elt [lindex $listOfLists 0] {
foreach combination [crossProduct [lrange $listOfLists 1 end]] {
lappend result [linsert $combination 0 $elt]
}
}
return $result
}
}
puts [crossProduct {{a b c} {d e f} {g h i}}]This solution is by no means the fastest available, but it appears to work for the purpose. Using (instead of recursion) another foreach for the loop over the listOfLists, the above can also be coded as
proc crossProduct { listOfLists } { # args might be better in a real-life API
set result [list [list]] ; # The set of one 0-tuple
foreach factor $listOfLists {
set newResult [list] ; # Empty set
foreach combination $result {
foreach elt $factor {
lappend newResult [linsert $combination end $elt]
}
}
set result $newResult
}
return $result
}KBK 2004-07-28: Note that expanding a large Cartesian product can consume large amounts of memory. It's often more useful to iterate some script for each element of the cross product.
Something like the following code gives a rough approximation of a control structure to do so.
proc rforeach { varlist vallist args } {
set i 0
foreach v $varlist {
set localName x$[incr i]
lappend localNames $localName
upvar 1 $v $localName
}
foreach $localNames $vallist {
if { [llength $args] <= 1 } {
set status [catch {
uplevel 1 [lindex $args 0]
} result]
} else {
set status [catch {
uplevel 1 [linsert $args 0 rforeach_nested]
} result]
}
if { $status != 0 && $status != 4 } break
}
switch -exact -- $status {
0 - 3 - 4 {
return
}
1 {
return -code error -errorcode $::errorCode $result
}
2 {
return -code return $result
}
}
}
proc rforeach_nested { varlist vallist args } {
set i 0
foreach v $varlist {
set localName x$[incr i]
lappend localNames $localName
upvar 1 $v $localName
}
foreach $localNames $vallist {
if { [llength $args] <= 1 } {
set status [catch {
uplevel 1 [lindex $args 0]
} result]
} else {
set status [catch {
uplevel 1 [linsert $args 0 rforeach_nested]
} result]
}
if { $status != 0 && $status != 4 } break
}
switch -exact -- $status {
0 - 4 {
return
}
1 {
return -code error -errorcode $::errorCode $result
}
2 {
return -code return $result
}
3 {
return -code break
}
}
}
rforeach a {a1 a2} b {b1 b2 b3} {c d} {c1 d1 c2 d2} e e1 {
puts [list $a $b $c $d $e]
if { $b eq {b3} } continue
puts "b isn't b3; didn't continue"
if { $a eq {a2} } break
puts "a isn't a2; didn't break"
}Eric Boudaillier 2004-07-29: I also needed such procedure to generate test code and wrote the following procedure, which build the foreach imbrication script and evaluate it:
proc forall {args} {
if {[llength $args] < 3 || [llength $args] % 2 == 0} {
return -code error "wrong \# args: should be \"forall varList list ?varList list ...? body\""
}
set body [lindex $args end]
set args [lrange $args 0 end-1]
while {[llength $args]} {
set varName [lindex $args end-1]
set list [lindex $args end]
set args [lrange $args 0 end-2]
set body [list foreach $varName $list $body]
}
uplevel 1 $body
}See also Nested-loop join
Arjen Markus An interesting variation on this theme: how to generate the set of subsets containing 1, 2, 3 ... elements. For example:
{a b c d e}will give rise to:
{{a} {b} {c} {d} {e}}
{{a b} {a c} {a d} {a e} {b c} {b d} {b e} {c d} {c e} {d e}}
...It does not seem quite trivial.
The answer is posted in Power set of a list.
% lcomp {[list $a $b]} for a in {a b c} for b in {d e f}
{a d} {a e} {a f} {b d} {b e} {b f} {c d} {c e} {c f}
% lcomp {[list $a $b $c]} for a in {a b} for b in {c d} for c in {e f}
{a c e} {a c f} {a d e} {a d f} {b c e} {b c f} {b d e} {b d f}You can programmatically construct arguments to lcomp for as many dimensions as you wish.
proc crossProduct2 {args} {
set i 0
set expression ""
set arguments {}
foreach list $args {
lappend arguments for $i in $list
append expression " \$$i"
incr i
}
lcomp \[list$expression\] {*}$arguments
}
% crossProduct2 {a b c} {d e f}
{a d} {a e} {a f} {b d} {b e} {b f} {c d} {c e} {c f}
% crossProduct2 {a b} {c d} {e f}
{a c e} {a c f} {a d e} {a d f} {b c e} {b c f} {b d e} {b d f}proc product args {
set xs {{}}
foreach ys $args {
set xs [concat {*}[lmap x $xs { lmap y $ys { list {*}$x $y } }]]
}
return $xs
}DKF: Unfortunately, the concat {*}… has quite a performance impact (which perhaps indicates that this is a case that ought to attract more bytecode optimisation effort). The fastest current approach seems to be this one:
proc product args {
set xs {{}}
foreach ys $args {
set result {}
foreach x $xs {
foreach y $ys {
lappend result [list {*}$x $y]
}
}
set xs $result
}
return $xs
}(This was constructed from your product by defining an lconcat, expanding it, and simplifying the results so as to minimise reiteration of lists.)