[SS] 16Apr2004: I wrote these two functions some time ago because someone posted in comp.lang.python a related question, i.e. just for fun, but probably this can be of real use. The functions are useful to compute the permutations of a set, actually you in theory only need [[permutations]] - that returns a list of permutations of the input set (also a Tcl list), but it's very memory-consuming to generate the permutations and then use [foreach] against it, so there is another function called [[foreach-permutation]] that runs all the permutations of the set and run a script against every one. The code is Copyright(C) 2004 Salvatore Sanfilippo, and is under the Tcl 8.4 license. '''Examples''' % !source source antilib.tcl % permutations {a b c} {a b c} {a c b} {b a c} {b c a} {c a b} {c b a} % foreach-permutation p {a b c} {puts \$p} a b c a c b b a c b c a c a b c b a % '''Code''' # Return a list with all the permutations of elements in list 'items'. # # Example: permutations {a b} > {{a b} {b a}} proc permutations items { set l [llength \$items] if {[llength \$items] < 2} { return \$items } else { for {set j 0} {\$j < \$l} {incr j} { foreach subcomb [permutations [lreplace \$items \$j \$j]] { lappend res [concat [lindex \$items \$j] \$subcomb] } } return \$res } } # Like foreach but call 'body' for every permutation of the elements # in the list 'items', setting the variable 'var' to the permutation. # # Example: foreach-permutation x {a b} {puts \$x} # Will output: # a b # b a proc foreach-permutation {var items body} { set l [llength \$items] if {\$l < 2} { uplevel [list set \$var [lrange \$items 0 0]] uplevel \$body } else { for {set j 0} {\$j < \$l} {incr j} { foreach-permutation subcomb [lreplace \$items \$j \$j] { uplevel [list set \$var [concat [lrange \$items \$j \$j] \$subcomb]] uplevel \$body } } } } ---- [RS]: Here's my take, a tiny hot summer day balcony fun project: proc permute {list {prefix ""}} { if ![llength \$list] {return [list \$prefix]} set res {} foreach e \$list { lappend res [permute [l- \$list \$e] [concat \$prefix \$e]] } join \$res } proc l- {list e} { set pos [lsearch \$list \$e] lreplace \$list \$pos \$pos } [Lars H]: RS's '''permute''', tidied up: proc permute {list {prefix ""}} { if {![llength \$list]} then {return [list \$prefix]} set res [list] set n 0 foreach e \$list { eval [list lappend res]\ [permute [lreplace \$list \$n \$n] [linsert \$prefix end \$e]] incr n } return \$res } [Vince] says that once upon a time he came across a very clever algorithm which had a state-based approach to generating permutations, which worked something like this: while {[getNextPermutation privateState permVar]} { puts \$permVar } i.e. the procedure maintains some state 'privateState' which allows it to iterate through the permutations one by one, and therefore avoids the need to pass in a ''\$script'' as in the foreach-permutation example above. Unfortunately, I can't remember that algorithm right now... ---- [Category Mathematics]