Nityanand's Weblog

  • view my stats

    free page hit counter
  • Earn Money by viewing ads

  • Useful Links

Posts Tagged ‘common in array’

Useful TCL Procedures for array/list handling Part 2

Posted by Nityanand Dubey on April 7, 2010

 

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
   }

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