比较两个列表并返回差异

时间:2014-02-03 10:15:04

标签: list variables loops tcl

我有两个列表列表,我匹配它们并打印任何差异。这两个列表是FPGA站内的电缆连接。我需要确保:

  1. $list1上的所有连接都存在于$list2上,如果没有,则应将错误保存在其他列表中

  2. $list2上的$list1上的所有连接都存在于{{A.B2} {B.B3}} ,因此我没有任何'错误'连接。

  3. 任何列表中不存在的任何连接都应保存到另一个变量中。

  4. 列表采用以下格式:

    {{B.B3} {A.B2}}
    

    和$ list2等价物可能是:

    if {
        $physical == "$project" && $physical2 == "$project2"
        || $physical == "$project2" && $physical2 == "$project"
    } then {
        lappend verified "$project ($project2) VERIFIED\n"
        #incr cablecounter
        set h 0
    } elseif {
        $physical == "$project" && $physical2 != "$project2"
        || $physical != "$project" && $physical2 == "project2"
        || $physical == "$project2" && $physical2 != "project"
        || $physical != "$project2" && $physical2 == "project"
    } then {
        lappend nonverified "$project to $project2 NOT connected. Please check $physical and $physical2\n"
    } else {
        set g [expr $g - 1]
        incr h
        #puts "\n [llength configuredConnections]"      
        if {
            $h > [llength $configuredConnections] && $project != "$physical" && $project2 != "$physical2"
            || $h > [llength $configuredConnections] && $project != "physical2" && $project2 != "$physical"
        } {
            lappend nonverified "$project to $project2 wrong connection found. Please remove.\n"
            set h 0; incr g
        }   
    }
    

    ^即使连接被交换,它仍然有效!我将这两个保存在循环内的不同变量上:

    $list1

    这给了我所有错误的连接等但是,而不是告诉我$list2上的$nonverified上的元素不存在,它将它存储到$project,而列表是作为“错误的连接”,而不是将其列为“未连接”。

    我是新来的TCL idk该做什么!

    编辑:$project2$list1$physical $physical2中的两个元素,$list2是{{1}}中的元素。

    我正在使用Tcl 8.4

2 个答案:

答案 0 :(得分:1)

ldiff命令可以帮助你(编辑:我将Tcl 8.6实现替换为Tcl 8.4可行(假设您使用下面的lmap替换)one):

proc ldiff {a b} {
    lmap elem $a {
        expr {[lsearch -exact $b $elem] > -1 ? [continue] : $elem}
    }
}

调用

ldiff $list1 $list2

list1中的所有元素提供list2中未出现的内容,反之亦然。

任何一个列表中不存在的项目应该位于一个名为list0的列表中,您可以通过调用找到它们

ldiff [ldiff $list0 $list1] $list2

Tcl 8.4用户lmap的快速替换:

proc lmap {varname listval body} {
    upvar 1 $varname var
    set temp [list]
    foreach var $listval {
        lappend temp [uplevel 1 $body]
    }
    set temp
}

它不允许多个varname-listval对,但ldiff不需要它。

这应该为Tcl 8.4上的完整lmap命令提供工作替代,除非在使用8.6时仍然存在未出现的问题:

proc lmap args {
    set body [lindex $args end]
    set args [lrange $args 0 end-1]
    set n 0
    set pairs [list]
    foreach {varname listval} $args {
        upvar 1 $varname var$n
        lappend pairs var$n $listval
        incr n
    }
    set temp [list]
    eval foreach $pairs [list {
        lappend temp [uplevel 1 $body]
    }]
    set temp
}

我仍然建议在这种情况下使用第一个替换建议:它可能会出现问题。

答案 1 :(得分:0)

此proc将返回交集和2个列表之间的差异。对于Tcl 8.4,请将其称为

foreach {intersection not_in_list2 not_in_list1} \
        [intersect3 $list1 $list2] \
        break

if {[llength $not_in_list2] > 0} {
    puts "NOT All the connections on the list1 exist on list2"
    puts $not_in_list2
}

if {[llength $not_in_list1] > 0} {
    puts "NOT All the connections on the list2 exist on list1"
    puts $not_in_list1
}

(Tcl 8.5及以上,你会

lassign [intersect3 $list1 $list2] intersection not_in_list2 not_in_list1

intersect3 proc是:

#
# intersect3 - perform the intersecting of two lists, returning a list
# containing three lists.  The first list is everything in the first
# list that wasn't in the second, the second list contains the intersection
# of the two lists, the third list contains everything in the second list
# that wasn't in the first.
#

proc intersect3 {list1 list2} {
    array set la1 {}
    array set lai {}
    array set la2 {}
    foreach v $list1 {
        set la1($v) {}
    }
    foreach v $list2 {
        set la2($v) {}
    }
    foreach elem [concat $list1 $list2] {
        if {[info exists la1($elem)] && [info exists la2($elem)]} {
            unset la1($elem)
            unset la2($elem)
            set lai($elem) {}
        }
    }
    list [lsort [array names la1]] [lsort [array names lai]] \
         [lsort [array names la2]]
}

我相信我几年前从TclX那里偷走了它。你可以(应该?)使用tcllib

package require struct::set
set l1 {a b c d e f g}
set l2 {c d e f g h i}
puts [struct::set intersect3 $l1 $l2]
{c d e f g} {a b} {h i}