scripts/intersect3.tcl

   1 if {[catch {lsearch -sorted {a b c} b}]} {
   2         proc tlc::intersect3 {list1 list2} {
   3                 set firstonly       {}
   4                 set intersection    {}
   5                 set secondonly      {}
   6
   7                 catch {
   8                         set list1       [lsort -unique $list1]
   9                         set list2       [lsort -unique $list2]
  10                 }
  11
  12                 foreach item $list1 {
  13                         if {[lsearch $list2 $item] == -1} {
  14                                 lappend firstonly $item
  15                         } else {
  16                                 lappend intersection $item
  17                         }
  18                 }
  19
  20                 foreach item $list2 {
  21                         if {[lsearch $intersection $item] == -1} {
  22                                 lappend secondonly $item
  23                         }
  24                 }
  25
  26                 return [list $firstonly $intersection $secondonly]
  27         }
  28 } else {
  29         proc tlc::intersect3 {list1 list2} {
  30                 set firstonly       {}
  31                 set intersection    {}
  32                 set secondonly      {}
  33
  34                 set list1       [lsort -unique $list1]
  35                 set list2       [lsort -unique $list2]
  36
  37                 foreach item $list1 {
  38                         if {[lsearch -sorted $list2 $item] == -1} {
  39                                 lappend firstonly $item
  40                         } else {
  41                                 lappend intersection $item
  42                         }
  43                 }
  44
  45                 foreach item $list2 {
  46                         if {[lsearch -sorted $intersection $item] == -1} {
  47                                 lappend secondonly $item
  48                         }
  49                 }
  50
  51
  52                 return [list $firstonly $intersection $secondonly]
  53         }
  54 }
  55
  56
  57 proc tlc::afast_intersect3 {list1 list2} {
  58     set firstonly       {}
  59     set intersection    {}
  60         set map                         {}
  61
  62         set list1       [lsort -unique $list1]
  63         set list2       [lsort -unique $list2]
  64
  65         foreach i $list2 {
  66                 lappend map     $i 1
  67         }
  68
  69         array set b $map
  70
  71     foreach i $list1 {
  72         if {[info exists b($i)]} {
  73             lappend intersection $i
  74                         unset b($i)
  75         } else {
  76             lappend firstonly $i
  77         }
  78     }
  79
  80     return [list $firstonly $intersection [array names b]]
  81 }
  82
  83