如何检查tcl列表中的相邻值？

Question

我有这样

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

列表现在我希望把它放在一个循环，并在每个范围内执行某些命令

像

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" 
    } 
} 

我无法得到这个工作输出应该像ech对或奇异值一样发现

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

编辑：我有一个像这样的数据的列表：

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

在那里你可以说每一个数据可以Gi3/0/类型或Gi2/0/或Fa2/0/这些reperesent每一个类型，我需要一些范围思科swicth.Now端口的为范围执行一些命令。再拿上面的列表我可以得到。

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 

同样，

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

Answer 1

#!/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 
*/ 

希望这是你所请求的内容部分。我使用数组“count”来删除输出中的重复条目，这是需要避免的。希望有人能提出更好的建议。而FYI我正在使用8.4版本的TCL。

Answer 2

你为什么不遍历对的列表中的？

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

您会看一下这两个值是相似的，提取需要等

Answer 3

我想到了我自己的一个尴尬的解决方案： 其中reslut是列表：

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 4

如果你不知道如何阵列，工作，你可以编辑您发布的代码作为此代码的答案：

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 
    } 
} 

这适用于我:)

输出（请注意，我第一次排序的列表，所以你只需要担心，而不必理会太多的$pattern增加$number或$match2）：

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

Answer 5

这里是我的解决方案，它不使用数组（数组没有任何问题，我的解决方案不需要它），并且它在一次通过（即只有一个循环）。

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 6

如果你想相邻列表元素比较，它可能是更清洁使用C风格for循环：

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

    # ... 
} 

或者多一点深奥

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

输出

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

你甚至可以写一个新的控制结构，类似于Ruby的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 7

该解决方案是有点短，但需要的Tcl 8.5。

首先，创建一个字典结构与前两个领域为重点和子项，并从第三场收集值的列表作为字典值：

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] 
    } 
} 

然后在该字典结构迭代，调用someproc命令，用于键，子键，第一个和最后一个值的每个组合。

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

文档：dict，foreach，if，lappend，lassign，lindex，set，split