T-99 : Quatre Vingt Dix Neuf Problèmes en Tcl - Les listes

 

T-99 : Quatre Vingt Dix Neuf Problèmes en Tcl - Les listes

* P1.01 (*) Trouver le dernier élément d'une liste Réponse:

 lindex [list a b c d] end

* P1.02 (*) Trouver l'avant-dernier élément d'une liste Réponse:

 lindex [list a b c d] end-1

* P1.03 (*) Trouver le k-ième élément d'une liste Réponse:

 lindex [list a b c d] 3

* P1.04 (*) Trouver le nombre d'éléments d'une liste Réponse:

 llength [list a b c d]

* P1.05 (*) Inverser une liste Réponse:

 proc lreverse {list} {
  for {set i [expr [llength $list] - 1]} {$i >= 0} {incr i -1} {
     lappend temp [lindex $list $i]
  }
  return $temp
 }

 lreverse [list a b c d]

ou

 package require struct::list
 struct::list reverse [list a b c d]

* P1.06 (*) Trouver si la liste est un palindrome Réponse:

 string compare [set l [list x a m a x]] [lreverse $l]

* P1.07 (**) Applatir une liste imbriquée Réponse:

 proc flatten list {string map {\{ "" \} ""} $list}

 flatten [list a [list b [list c d]]]

ou

 package require struct::list
 ::struct::list flatten -full [list a [list b [list c d]]]

* P1.08 (**) Eliminer les doublons consécutifs dans une liste Réponse:

 proc compress l {
  set x ""
  foreach y $l {
     if {$x ne $y} {lappend res $y}
     set x $y
  }
  return $res
 }

 compress [list a a a a b b c c c a a d d d e e e e b b b f]

* P1.09 (**) Grouper les doublons consécutifs dans une liste Réponse:

* P1.10 (*) Run-length encoding (codage par plages) sur une liste Réponse:

 proc encode l {
  set prev {}
  set res {}
  foreach c $l {
     if {$c eq $prev} {
       incr ct
     } else {
       if {$prev ne {}} {lappend res [list $ct $prev]}
       set ct 1
     }
     set prev $c
  }
  if {$prev ne {}} {lappend res [list $ct $prev]}
  set res
 }

 encode [list a a a a b c c a a d e e e e]

* P1.11 (*) Run-length encoding (codage par plages) modifié sur une liste Réponse:

 proc encode l {
  set prev {}
  set res {}
  foreach c $l {
         if {$c eq $prev} {
           incr ct
         } else {
           if {$prev ne {}} {lappend res [expr {$ct>1?[list $ct $prev]:$prev}]}
           set ct 1
         }
         set prev $c
  }
  if {$prev ne {}} {lappend res [expr {$ct>1?[list $ct $prev]:$prev}]}
  set res
 }

 encode [list a a a a b c c a a d e e e e]

* P1.12 (**) Décoder un run-length encoding (codage par plages) Réponse:

 proc decode l {
  set res {}
  set re {([1-9][0-9]*)([^0-9]+)}
  foreach {- ct c} [regexp -all -inline $re $l] {
         lappend res [string repeat $c $ct]
  }
  return $res
 }

 decode [list 4 a b 2 c 2 a d 4 e]

* P1.13 (**) Run-length encoding (codage par plages). Solution directe Réponse:

* P1.14 (*) Dupliquer les éléments d'une liste Réponse:

 set l [list a b c c d]
 foreach i $l {lappend res $i $i}
 set res

* P1.15 (**) Répliquer les éléments d'une liste k-fois Réponse:

 proc replicate {l k} {
  foreach i $l {lappend res [lrepeat 3 $i]}
  set res [join $res]
 }

 replicate [list a b c c d] 3

* P1.16 (**) Enlever tous les k-ième éléments d'une liste Réponse:

 proc drop {l k} {
  foreach i $l {if [expr {[incr n]%$k}] {lappend res $i}}
  set res
 }

 drop [list a b c d e f g h i j k] 3

* P1.17 (*) Scinder une liste en deux; la longueur de la première partie étant fournie Réponse:

 proc splitk {l k} {return [list [lrange $l 0 [expr {$k-1}]] [lrange $l $k end]]}

 splitk [list a b c d e f g h i k] 3

* P1.18 (**) Extraire une tranche de liste comprise entre deux indices i et k Réponse:

 proc slice {l i k} {return [lrange $l [incr i -1] [incr k -1]]}

 slice [list a b c d e f g h i k] 3 7

* P1.19 (**) Rotation circulaire d'une liste de k places Réponse:

 proc rotate {l k} {return [concat [lrange $l $k end] [lrange $l 0 [expr {$k-1}]]]}

 rotate [list a b c d e f g h] 3

* P1.20 (*) Supprimer le k-ième élément d'une liste Réponse:

 proc remove_at {l k} {return [lreplace $l [expr {$k-1}] [expr {$k-1}]]}

 remove_at [list a b c d] 2

* P1.21 (*) Insérer un élément à une position donnée dans une liste Réponse:

 proc insert_at {l k s} {return [linsert $l [incr k -1] $s]}

 insert_at [list a b c d] 2 alpha

* P1.22 (*) Créer une liste contenant des entiers compris entre deux bornes Réponse:

 proc range {j k} {
  set res {}
  for {set i $j} {$i<=$k} {incr i} {lappend res $i}
  set res
 }

 range 4 9

* P1.23 (**) Extraire un nombre donné d'éléments d'une liste choisis aléatoirement Réponse:

 proc rnd_select {l k} {
  set i 0
  set res {}
  while {$i < $k} {
       set j [expr {int([llength $l]*rand())}]
       lappend res [lindex $l $j]
       set l [lreplace $l $j $j]
       incr i
  }
  set res
 }

 rnd_select [list a b c d e f g h] 3

* P1.24 (*) Loto: Tirer au sort n nombres dans un ensemble 1..k Réponse:

 proc loto_select {n k} {
  if {$n > $k} return
  set res {}
  set l [range 1 $k]
  set i 0
  while {$i < $n} {
       set j [expr {int([llength $l]*rand())}]
       lappend res [lindex $l $j]
       set l [lreplace $l $j $j]
       incr i
  }
  set res
 }

 loto_select 6 49

* P1.25 (**) Générer une permutation aléatoire des éléments d'une liste Réponse:

 proc permut {l {p ""}} {
  set res {}
  set j 0
  foreach i $l {
     eval [list lappend res] [permute [lreplace $l $j $j] [linsert $p end $i]]
     incr j
  }
  set res
 }

 proc rnd_permut l {
  return [lindex [set res [permut $l]] [expr {int([llength $res]*rand())}]]
 }

 rnd_permut [list a b c d e f]

ou

 package require struct::list

 proc rnd_permut l {
  return [lindex [set res [::struct::list permutations $l]] [expr {int([llength $res]*rand())}]]
 }

 rnd_permut [list a b c d e f]

* P1.26 (**) Générer toutes les combinaisons de k éléments d'une liste Réponse:

 proc combination {k l} {
  if {$k == 1} {return $l}
  set res {}
  incr k -1
  foreach i [lrange $l 0 end-$k] {
     set l [lrange $l 1 end]
     foreach j [combination $k $l] {
        lappend res [linsert $j 0 $i]
     }
  }
  set res
 }

 combination 3 [list a b c d e f]

* P1.27 (**) Grouper les éléments d'un ensemble en sous-ensembles disjoints Réponse:

* P1.28 (**) Trier une liste de listes selon la longueur des sous-listes Réponse:

a)

 proc lsort-indices l {
  set i -1
  foreach e $l {lappend tmp [list [incr i] $e]}
  foreach e [lsort -index 1 $tmp] {lappend res [lindex $e 0]}
  set res
 }

 proc lsort_length_sub l {
  set idx {}
  set res {}
  foreach i $l {lappend idx [llength $i]}
  foreach i [lsort-indices $idx] {lappend res [lindex $l $i]}
  set res
 }

 lsort_length_sub {{a b c} {d e} {f g h} {d e} {i j k l} {m n} o}

b)

 proc lsort_length_freq l {
  foreach i $l {lappend idx [llength $i]}
  foreach i [lsort -uniq $idx] {append f($i) ""}
  foreach i $idx {append f($i) .}
  foreach i [array names f] {lappend lf [list $i [string length $f($i)]]}
  foreach i [lsort -integer -index 1 $lf] {
     foreach j $l {if {[lindex $i 0] == [llength $j]} {lappend res $j}}
  }
  set res
 }

 lsort_length_freq {{a b c} {d e} {f g h} {d e} {i j k l} {m n} o}

---

T-99 : Quatre Vingt Dix Neuf Problèmes en Tcl