All combinations in columnal order - algorithm

Question

I have a grid where the columns we can represent as ABC and the rows can be represented as x, y, z types for example.
There could be multiple rows that are all classified as the same type. This is not true of the columns.
Rows of the same type should not be combined or "mixed." And all combining needs to be in the order ABC, not CBA or anyhting else. Here is an example I've come up with.
I need to print out every combination (in columnal order) of the following table:
A B C
--------------
x | 10 20 30
x | 11 21 31
y | 40 50 60
y | 41 51 61
z | 70 80 90
The output needs to be like this (it doesn't have to output the pattern, that's just for reference):
(Pattern) (Result)
Ax Bx Cx {10 20 30} {11 21 31} (notice no mix-combinations on same letter x)
Ax Bx Cy {10 20 60} {10 20 61} {11 21 60} {11 21 61}
Ax Bx Cz {10 20 90} {11 21 90}
Ax By Cx {10 50 30} {10 51 30} {11 50 31} {11 51 31}
Ax By Cy {10 50 60} {10 51 61} {11 50 60} {11 51 61}
Ax By Cz {10 50 90} {10 51 90} {11 50 90} {11 51 90}
Ax Bz Cx {10 80 30} {11 80 31}
Ax Bz Cy {10 80 60} {10 80 61} {11 80 60} {11 80 61}
Ax Bz Cz {10 80 90} {11 80 90}
Ay Bx Cx {40 20 30} {40 21 31} {41 20 30} {41 21 31}
Ay Bx Cy ...
Ay Bx Cz ...
Ay By Cx ...
Ay By Cy ...
Ay By Cz ...
Ay Bz Cx ...
Ay Bz Cy ...
Ay Bz Cz ...
Az Bx Cx ...
Az Bx Cy ...
Az Bx Cz ...
Az By Cx ...
Az By Cy ...
Az By Cz ...
Az Bz Cx ...
Az Bz Cy ...
Az Bz Cz {30 60 90}
I have some Tcl code I've started making to do this but its not great. It doesn't take multiple rows of the same x y or z into consideration but here's what I got so far:
set dl {0 1 2}
set op {x y z}
set debug [open "debugloop.txt" "w"]
set i 0
set j 0
set k 0
set e 0
set r 0
set s 0
set g yes
while {$g} {
puts $debug A[lindex $op $i][lindex $dl $e]B[lindex $op $j][lindex $dl $r]C[lindex $op $k][lindex $dl $s]
incr s
if {$s > 2} {
puts $debug ""
incr r
set s 0
if {$r > 2} {
puts $debug ""
incr e
set r 0
if {$e > 2} {
puts $debug ""
incr k
set e 0
if {$k > 2} {
puts $debug ""
incr j
set k 0
if {$j > 2} {
puts $debug ""
incr i
set j 0
if {$i > 2} {
set g no
}
}
}
}
}
}
}
does anyone have a better way to do this than a series of hardcoded nested loops? I've had a lot of trouble with this

Answer 1

There are 2 main parts to your problem:
Generating all of the (Pattern) combinations
Storing the data in a way that allows you to look up the (Result) for each combination.
For the first of these you need to generate all of the permutations with repetition allowed of your Pattern values, x,y,z, in your example. There is some code for this on the tcl wiki.
In your case order is important, {x,y,z} is not the same as {z,y,x} so the algorithm needs to take that into account. Here is some code that uses a simple algorithm to generate the repeating permutations, it uses the idea that you can generate all of the permutations by counting up modulo the number of elements. The number of permutations grows pretty quickly, look at the way permCount is calculated!
# Permutaions
proc NextPerm {perm values} {
set result {}
set needIncr 1
foreach val $perm {
if { $needIncr == 1} {
set newVal [lindex $values [expr {[lsearch -exact $values $val] + 1}]]
if {$newVal != ""} {
# New value was found
lappend result $newVal
set needIncr 0
} else {
# No next value found so we need to carry
lappend result [lindex $values 0]
}
} else {
lappend result $val
}
}
return $result
}
set values {x y z}
set perm {x x x}
puts $perm
set permCount [expr {[llength $perm] ** [llength $perm]}]
for {set i 1} {$i < $permCount} {incr i} {
set perm [NextPerm $perm $values]
puts $perm
}
NB: I've made no attempt to optimise this code.
If the pattern values never change then rather than generate them yourself you could use an online resource like this (there are lots of other sites if you do a search) to generate the values and hard-code them into your program.
For 2 I'd look at storing the values in an array or a dict with a key that allows you to pull back the relevant values.