Nityanand's Weblog

  • view my stats

    free page hit counter
  • Earn Money by viewing ads

  • Useful Links

Archive for March, 2010

Useful TCL Procedures for array/list handling Part 1

Posted by Nityanand Dubey on March 9, 2010


We have to Use different array/list processing during Scripting.

Here are some TCL Procedures for list/array processing.

1. To find the commin elements between two arrays –

proc get_common_in_lists { list1 list2 } {
 set common_list “”
 if { [llength $list1] > [llength $list2] } {
  set list_temp1 $list2
  set list_temp2 $list1
 } else {
  set list_temp1 $list1
  set list_temp2 $list2
 }
 for { set i 0 } { $i < [llength $list_temp1] } { incr i } {
  set found_flag [lsearch -exact $list_temp2 [lindex $list_temp1 $i]]
  if { $found_flag != -1 } {
    set common_list [concat $common_list [lindex $list_temp1 $i]]
  }
 }
 return $common_list
}

2. To find a union of all the lists provided.

proc get_union_of_all_lists { list0 args } {
 set list2 “”
 if { [llength $args] == 0 } {
  puts “*** Error : At least 2 lists are required”;
  return
 }
 for { set i 0 } { $i < [llength $args] } { incr i } {
  for { set j 0 } { $j < [llength [lindex $args $i]] } { incr j } {
   lappend list2 [lindex [lindex $args $i] $j]
  }
 }
 set list2 [concat $list2 $list0]
 set list2 [lsort $list2]
  set union_list [lindex $list2 0]
 for { set i 1 } { $i < [llength $list2] } { incr i } {
  if { [lindex $list2 $i] != [lindex $list2 [expr $i – 1]] } {
   lappend union_list [lindex $list2 $i]
  }
 }
 return $union_list
}

3. To find a list of common elements among given list ( It could be more than two)

proc get_common_in_all_lists { list0 args } {
 set common_list “”
  if { [llength $args] == 0 } {
   puts “*** Error : At least 2 lists are required”;
  return
 }
 for { set i 1 } { $i <= [llength $args] } { incr i } {
  set list($i) [lindex $args [expr $i – 1]]
 }
 for { set i 1 } { $i <= [llength $args] } { incr i } {
  if { [llength $list($i)] < [llength $list0 ] } {
   set temp_list $list($i)
   set list($i) $list0
   set list0 $temp_list
  }
 }
 for { set i 0 } { $i < [llength $list0] } { incr i } {
  set found 1
  for { set j 1 } { $j <= [llength $args] } { incr j } {
   set found_flag [lsearch -exact $list($j) [lindex $list0 $i]]
   if { $found_flag == -1 } {
    set found 0
   }
  }
  if { $found == 1 } {
   set common_list [concat $common_list [lindex $list0 $i]]
  }
 }
 return $common_list
}

Posted in TCL | Tagged: , , , , | Leave a Comment »