jbr.tcl/set.tcl at main · jbroll/jbr.tcl · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

proc lintersect {a b} {
     foreach e $a {
 	set x($e) {}
     }
     set result {}
     foreach e $b {
 	if {[info exists x($e)]} {
 	    lappend result $e
 	}
     }
     return $result
 }

 proc lunion {a b} {
     foreach e $a {
 	set x($e) {}
     }
     foreach e $b {
 	if {![info exists x($e)]} {
 	    lappend a $e
 	}
     }
     return $a
 }

 proc ldifference {a b} {
     set result {}
     foreach e $a {
 	if {$e ni $b} {lappend result $e}
     }
     return $result
 }

 # Modified to combine the call by name and returned list of 3 lists API.
 #
 proc intersect3 {list1 list2 { inList1 {} } { inList2 {} } { inBoth {} } } {
    if { $inList1 ne {} } {
	upvar $inList1 in1
	upvar $inList2 in2
	upvar $inBoth  inB
    }

    set in1 [list]
    set in2 [list]
    set inB [list]

    set list1 [lsort $list1]
    set list2 [lsort $list2]

    # Shortcut for identical lists is faster
    if { $list1 == $list2 } {
	set inB $list1
    } else {
	set i 0
	    foreach element $list1 {
		if {[set p [lsearch [lrange $list2 $i end] $element]] == -1} {
		    lappend in1 $element
		} else {
		    if { $p > 0 } {
			set e [expr {$i + $p -1}]
			    foreach entry [lrange $list2 $i $e] {
				lappend in2 $entry
			    }
			incr i $p
		    }
		    incr i
			lappend inB $element
		}
	    }
	foreach entry [lrange $list2 $i end] {
	    lappend in2 $entry
	}
    }

    return [list $in1 $in2 $inB]
} ;# David Easton