Как проверить смежные значения в списке 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 

EDIT: У меня есть список таких данных, как:

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

Это работает для меня :)

Выход (обратите внимание, что я отсортированный список первой, так что вы должны беспокоиться только о увеличении $number или $match2 пока не докучать слишком много о $pattern):

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 

Можно даже написать новую структуру управления, аналогичную 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