Communauté Eggdrop
Utilitaires de listes - Version imprimable

+- Communauté Eggdrop (https://forum.eggdrop.fr)
+-- Forum : Eggdrop et scripts (https://forum.eggdrop.fr/forumdisplay.php?fid=8)
+--- Forum : Bouts de Scripts (https://forum.eggdrop.fr/forumdisplay.php?fid=17)
+--- Sujet : Utilitaires de listes (/showthread.php?tid=1772)

Utilitaires de listes - CrazyCat - 30/01/2024

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




RE: Utilitaires de listes - Amand - 30/01/2024

On pourrait avoir un exemple d'utilisation ?

RE: Utilitaires de listes - CrazyCat - 30/01/2024

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


RE: Utilitaires de listes - Amand - 30/01/2024

Ok j'ai compris, merci Smile

RE: Utilitaires de listes - CrazyCat - 12/03/2024

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.

RE: Utilitaires de listes - CrazyCat - 12/05/2024

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