Useful TCL Procedures for array/list handling Part 2

 

This post is in a continuation of previous post, which describes the useful procedures for array/list processing in TCL

1. Reducing elements of a given list from other lists.

 proc list1_minus_restlists { list1 args } {
   set list1_less_restlists “”
   set found 0
   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]
     }
   }
      for { set i 0 } { $i < [llength $list1] } { incr i } {
      set found_flag [lsearch -exact $list2 [lindex $list1 $i]]
      if { $found_flag == -1 } {
      set list1_less_restlists [concat $list1_less_restlists [lindex $list1 $i]]
      }
   }
   return $list1_less_restlists
 }

2. To Sort the elementsa in the array.

proc sort_array_of_lists { array1 } {
    set arr_args “”
    upvar $array1 org_array
    if { [array exists org_array] == 0 } {
       puts “*** Error : Please assign an array argument”
    }
    set size [array size org_array]
    set i 0
    foreach { key value } [array get org_array] {
       set sorted_array($i) $value
       set temp_array($key) $value
    incr i
    }
    for { set i 0 } { $i < [expr $size – 1] } { incr i } {
    for { set j [expr $i + 1] } { $j [llength $sorted_array($j)] } {
           set temp $sorted_array($i)
          set sorted_array($i) $sorted_array($j)
       set sorted_array($j) $temp
    }
    }
    }
    for { set i 0 } { $i < $size } { incr i } {
       set index_value [expr [lsearch -exact [array get temp_array] $sorted_array($i)] – 1 ]
       set arg_value [lindex [array get temp_array] $index_value]
       lappend arr_args $arg_value
       set temp_array($arg_value) "ho nahin sakta"
    }
    return $arr_args
   }

3. To find the union of lists in an array

proc union_of_lists_in_array { array1 } {
    set union_lists ""
    global union_of_all_lists
    upvar $arr1 org_array
    if { [array exists org_array] == 0 } {
       puts "*** Error : Please Provide an array"
    }
    set size [array size org_array]
    set i 0
    foreach { key value } [array get org_array] {
       set union_lists [union_of_all_lists $union_lists $value]
    }
    return $union_lists
   }

Useful TCL Procedures for array/list handling Part 1

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
}