Utilitaires de listes

[CrazyCat]

Voici un petit bout de code qui est parfois utile: trouver tous les éléments d'une liste qui sont présents dans une autre liste:

tclcopier

# Recherche les éléments de list1 contenus dans list2
proc lintersect {list1 list2} {
   foreach element $list1 {
      if { ($element in $list2) } { lappend intersect $element }
   }
   return $intersect
}

Différence de liste:

tclcopier

# version de #MenzAgitat
proc ldiff {list1 list2} {
   foreach element $list1 {
      if { !($element in $list2) } {
         lappend diff $element
      }
   }
   return $diff
}

Les mêmes en utilisant lmap

tclcopier

proc lintersect {list1 list2 {option -exact}} {
   if {$option ne "-nocase"} { set option -exact }
   return [lmap x $list1 {expr {[lsearch $option $list2 $x] >= 0 ? $x : [continue]}}]
}
 
proc ldiff {list1 list2 {option -exact}} {
   if {$option ne "-nocase"} { set option -exact }
   return [lmap x $list1 {expr {[lsearch $option $list2 $x] < 0 ? $x : [continue]}}]
}

[Amand]

On pourrait avoir un exemple d'utilisation ?

[CrazyCat]

tclcopier

set list1 {a b c d e f g h i j k l m n o p q r s t u v w x y z}
set list2 {a z e r t y u i o p}
 
puts "Différence : [ldiff $list1 $list2]"
puts "Intersection : [lintersect $list1 $list2]"

Code :

Différence : b c d f g h j k l m n q s v w x
Intersection : a e i o p r t u y z

[Amand]

Ok j'ai compris, merci

[CrazyCat]

J'ajoute trois procédures:

lremove
Cette procédure sert à retirer un élément d'une liste

tclcopier

proc lremove {datas needle {option -exact}} {
   if {$option ne "-nocase"} { set option -exact }
   return [lsearch -all -inline -not $option $datas $needle]
}

Code :

% set a {a b c d e f g h i j}
a b c d e f g h i j
% puts [lremove $a e]
a b c d f g h i j

lireplace
Cette procédure remplace un élément par un autre de manière non sensible à la casse

tclcopier

proc lireplace {datas needle {replacement ""}} {
   if {$needle eq ""} { return $datas }
   set idx [lsearch -nocase $datas $needle]
   if {$idx > -1} {
      return [lreplace $datas $idx $idx $replacement]
   } else {
      return $datas
   }
}

Code :

% set a {a b c d e f g h i j}
a b c d e f g h i j
% puts [::utils::lireplace $a B z]
a z c d e f g h i j

lereplace
Cette dernière procédure est le pendant de la précédente mais de manière sensible (-exact)

tclcopier

proc lereplace {datas needle {replacement ""}} {
   if {$needle eq ""} { return $datas }
   set idx [lsearch -exact $datas $needle]
   if {$idx > -1} {
      return [lreplace $datas $idx $idx $replacement]
   } else {
      return $datas
   }
}

Code :

% set a {a b c d e f g h i j}
a b c d e f g h i j
% puts [::utils::lereplace $a B z]
a b c d e f g h i j
# b != B
% puts [::utils::lereplace $a b z]
a z c d e f g h i j

Notez que si vous ne passez pas l'argument replacement à lireplace et lereplace, elles agissent comme lremove.