Utilitaires de listes
#1
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:
tcl
# 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:
tcl
# 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
tcl
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]}}]
}


Répondre
#2
On pourrait avoir un exemple d'utilisation ?
Répondre
#3
tcl
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
Répondre
#4
Ok j'ai compris, merci Smile
Répondre
#5
J'ajoute trois procédures:

lremove
Cette procédure sert à retirer un élément d'une liste
tcl
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
tcl
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)
tcl
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.
Répondre
#6
Une nouvelle petite procédure : lshuffle, qui permet de randomiser une liste:
tcl
proc lshuffle {sorted} {
   set shuffled {}
   while { [llength $sorted] > 0} {
      set j [expr {int(rand() * [llength $sorted])}]
      lappend shuffled [lindex $sorted $j]
      set sorted [lreplace $sorted $j $j]
   }
   return $shuffled
}



Exemple d'utilisation:
Code :
% set abc {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}
% puts $abc
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
% puts [lshuffle $abc]
k z o v j a t u q p g f l d e n c y r i w b h s x m
% puts [lshuffle $abc]
p g l x c b r y h o t j z d q w s k a v i f n u m e
Répondre


Atteindre :


Utilisateur(s) parcourant ce sujet : 1 visiteur(s)
Tchat 100% gratuit -Discutez en toute liberté