Comparing two lists and returning the difference

问题

I've got two lists of lists, I match them and print any differences. The two lists are cable connections within a FPGA station. I need to ensure:

All the connections on the $list1 exist on $list2, if not, it should save the error on another list
All the connections on $list2 exist on $list1, so I don't get any 'wrong' connections.
Any connections that don't exist on either list should be saved onto another variable.

The lists are in this format:

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

and the the $list2 equivalent could be:

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

^ Even though the connections are swapped around, it is still valid! I save both of these on different variables inside a loop to do this:

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

This gives me all the wrong connections etc, BUT instead of telling me that an element on $list1 doesn't exist on $list2, it stores it onto $nonverified, and lists is as a 'wrong connection' rather than listing it as 'NOT' connected.

I am new to TCL idk what to do!

EDIT: $project and $project2 are the two elements in $list1, and $physical $physical2 are elements in $list2.

I'm using Tcl 8.4

回答1:

The ldiff command can help you (EDIT: I replaced the Tcl 8.6 implementation with a Tcl 8.4-workable (provided you use the lmap replacement below) one):

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

The invocation

ldiff $list1 $list2

gives you all elements in list1 that don't occur in list2, and vice versa.

Items that don't exist on either of the lists should presumably be in a list named, say, list0, and you can find them with the invocation

ldiff [ldiff $list0 $list1] $list2

A quick-and-dirty replacement for lmap for Tcl 8.4 users:

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

It doesn't allow multiple varname-listval pairs, but you don't need that for ldiff.

This ought to provide a working replacement for the full lmap command on Tcl 8.4, unless there are still issues that don't show up when using 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
}

I still recommend the first replacement suggestion in this case, though: there's less that can go wrong with it.

回答2:

This proc will return the intersection and the differences between 2 lists. For Tcl 8.4, call it like

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 and above, you would

lassign [intersect3 $list1 $list2] intersection not_in_list2 not_in_list1

)

And the intersect3 proc is:

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

I belive I stole that from TclX some years ago. You could (should?) use 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}

来源：https://stackoverflow.com/questions/21524552/comparing-two-lists-and-returning-the-difference

标签

list

variables

loops

tcl