how to check adjacent values in tcl list?

Question

I have a list like

set val [ list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 ]

now i want to put it in a loop and execute some commands over each range

like

set number 0
set pattern 0
foreach n $val {
    if {$pattern == 0} {
        set current $n
        regexp {(.*/)(\d+)} $n - pattern number
        continue
    }

    regexp {(.*/)(\d+)} $n - match1 match2
    if {$match1 == $pattern} {
        #puts "someproc $current - match2"
    }
}

I am unable to get this work the output should be like for ech pair or singular value found

someproc Fa2/0/1 - 24
someproc Gi1/0/13 - 23
someproc Gi1/1/1 - 1       #for singular values
someproc Gi2/0/1 - 1

EDIT : i have a list of such data like :

  Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1

where you can say each data can be of type Gi3/0/ or Gi2/0/ or Fa2/0/ these reperesent some range of ports on cisco swicth.Now for every type i need to execute some command for a range.Again taking the above list i can get.

somecommand Gi3/0/1 - 1 # there is only one `Gi3/0/` with number 1.
somecommand Fa2/0/1 - 24 # range of `Fa2/0/` is 1 to 24

similarly,

somecommand Gi1/0/13 - 23
somecommand Gi1/1/1 - 1
and so on

Answer 1

This solution is a little shorter, but requires Tcl 8.5.

First, create a dictionary structure with the first two fields as key and subkey, and collect lists of values from the third field as dictionary values:

set data {}
foreach v $val {
    lassign [split $v /] a b c
    if {![dict exists $data $a $b]} {
        dict set data $a $b {}
    }
    dict with data $a {
        lappend $b $c
        set b [lsort –integer $b]
    }
}

Then iterate over this dictionary structure, calling the someproc command for each combination of key, subkey, first and last value.

dict for {a v} $data {
    dict for {b v} $v {
        someproc $a/$b/[lindex $v 0] - [lindex $v end]
    }
}

Documentation: dict, foreach, if, lappend, lassign, lindex, set, split

Answer 2

If you want to compare adjacent list elements, it might be cleaner to use a C-style for loop:

for {set i 0} {$i < [llength $val] - 1} {incr i} {
    set current [lindex $val $i]
    set next    [lindex $val [expr {$i+1}]]

    # ...
}

Or, a bit more esoteric

set l {a b c d e f g}
foreach current [lrange $l 0 end-1] \
        next    [lrange $l 1 end] {
    puts "$current $next"
}

outputs

a b
b c
c d
d e
e f
f g

You could even write a new control structure, similar to Ruby's each_cons

proc foreach_cons {vars list body} {
    foreach varname $vars {upvar 1 $varname $varname}
    set numvars [llength $vars]
    for {set i 0} {$i <= [llength $list]-$numvars} {incr i} {
        lassign [lrange $list $i [expr {$i + $numvars}]] {*}$vars
        uplevel 1 $body
    }
}
foreach_cons {a b c} $l {puts "$a $b $c"}

a b c
b c d
c d e
d e f
e f g

Answer 3

Here is my solution, which does not use array (nothing is wrong with array, my solution just don't need it), and it does it in one pass (i.e. only one loop).

set val [ list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 ]
set lastPattern ""
set lastNumber 0
lappend val x/1/1; # Add a trailer to ease processing

foreach item $val {
    # If item=Fa2/0/1, then pattern=Fa2/0 and number=1
    set pattern [file dirname $item]
    set number  [file tail $item]

    if {$pattern == $lastPattern} {
        # We have seen this pattern before
        puts "$pattern/$lastNumber - $number"
        set lastPattern ""
    } else {
        # This is a new pattern, print the old one if applicable then
        # save the pattern and number for later processing
        if {$lastPattern != ""} {
            puts "$lastPattern/$lastNumber - $lastNumber"
        }
        set lastPattern $pattern
        set lastNumber $number
    }
}
set val [lrange $val end-1]; # Remove the trailer

Answer 4

If you are not sure how arrays, work, you can edit the code you posted as an answer to this code:

set number 0
set pattern 0
set current 0
set result [list Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1]

foreach n [lsort $result] {
  if {$pattern == 0} {
        set current $n
    regexp {(.*/)(\d+)} $n - pattern number
    continue
  }
  regexp {(.*/)(\d+)} $n - match1 match2
    if {$match1 == $pattern} {
        set number $match2
    } else {
        puts "$current - $number"
        set pattern $match1
        set number $match2
        set current $n
    }
}

That works for me :)

The output (note that I sorted the list first so you only have to worry about the increasing $number or $match2 while not having to bother too much about the $pattern):

Fa2/0/1 - 24
Gi1/0/13 - 23
Gi1/1/1 - 1
Gi2/0/1 - 1
Gi3/0/1 - 1

Answer 5

#!/usr/bin/tcl

## Assumptions:
## The pattern will always be X/X/X
##  The values are given in list
set val_list [list Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1]

array set pattern {}

foreach item $val_list {
set parent [file dir $item]
set val [file tail $item]
if {[info exists pattern($parent,L)] && [info exists pattern($parent,H)]  } {
    if {$pattern($parent,L) > $val } {
    set pattern($parent,L) $val
    } elseif { $pattern($parent,H) < $val} {
    set pattern($parent,H) $val
    }
} else {  
    set pattern($parent,L) $val
    set pattern($parent,H) $val 
}
}
array set count {}
foreach pat  [array names pattern] {
set pat [lindex [split $pat ,] 0]
if {![info exists count($pat)] } {
    puts "$pat $pattern($pat,L) - $pattern($pat,H)"
    set count($pat) 1
}
}


/*The output will be 
Gi1/0 13 - 23
Fa2/0 1 - 24
Gi2/0 1 - 1
Gi1/1 1 - 1
*/

Hope this is what you are requesting for. I used array "count" to remove duplicate entries in output, which needs to be avoided. Hope if someone can suggest any better way. And FYI I am using 8.4 version of TCL.

Answer 6

I came up with a awkward solution of my own : where reslut is the list :

  Gi3/0/1 Fa2/0/1 Fa2/0/24 Gi1/0/13 Gi1/0/23 Gi1/1/1 Gi2/0/1 Te1/0/1

#

set number 0
set pattern 0
set last_element [lindex $result end]
set first_element [lindex $result 0]
foreach n $result {
    if {$pattern == 0} {
        set current $n
        set count 0
        regexp {(.*/)(\d+)} $n - pattern number
        continue
    }
    regexp {(.*/)(\d+)} $n - match1 match2
    if {$match1 == $pattern} {
    set count 0
    puts " $current - $match2"
        continue
     } else {
             if {"$last_element" == "$n"} {
             puts "$last_element"
             }
             if {"$first_element" == "$current"} {
             puts "$first_element"
             }
             incr count
             if {"$count" == 1} {
             set pattern $match1
             set current $n
             continue
             } else {
                     if {$match1 != $pattern} {
                     puts "$current"
                     }

             }
     set pattern $match1
     }
        set current $n

}

Answer 7

Why don't you loop over pairs of the list?

foreach {v1 v2} $val {
     someproc $v1 $v2
}

You might check if both values are similar, extract the parts that you need etc.