Attachment "list.tcl.patch" to
ticket [776010ffff]
added by
cleverly
2003-07-23 09:34:26.
--- modules/struct/list.tcl 2003-07-22 19:56:57.000000000 -0600
+++ modules/struct/list.tcl.new 2003-07-22 20:53:07.000000000 -0600
@@ -39,6 +39,7 @@
namespace export Lrepeat
namespace export LdbJoin
namespace export LdbJoinOuter
+ namespace export LcommonElements
}
}
@@ -1299,3 +1300,43 @@
foreach row $keyedtable {lappend table [lindex $row 1]}
return $table
}
+
+
+# Given a list of lists, return a sorted list of only those element(s)
+# which are members of each and every sublist.
+proc ::struct::list::LcommonElements {list_of_lists} {
+ set common [lindex $list_of_lists 0]
+ set length [llength $list_of_lists]
+
+ if { [package vcompare [package provide Tcl] 8.4] < 0} {
+ for {set i 1} {$i < $length && [llength $common]} {incr i} {
+ set curr_list [lindex $list_of_lists $i]
+ array set remaining {}
+
+ foreach element $common {
+ if {[lsearch -exact $curr_list $element] != -1} {
+ set remaining($element) ""
+ }
+ }
+
+ set common [array names remaining]
+ unset remaining
+ }
+ } else {
+ for {set i 1} {$i < $length && [llength $common]} {incr i} {
+ set curr_list [lsort [lindex $list_of_lists $i]]
+ array set remaining {}
+
+ foreach element $common {
+ if {[lsearch -exact -sorted $curr_list $element] != -1} {
+ set remaining($element) ""
+ }
+ }
+
+ set common [array names remaining]
+ unset remaining
+ }
+ }
+
+ return [lsort $common]
+}
