Pour bien commencer l'année un Jeux Técleux :-)
Il porte sur le tri des longueurs de listes en fonction de leur
fréquence d'apparition.
Soit une liste contenant des sous-listes:
set l {{a b c} {d e} {f g h} {d e} {i j k l} {m n} o {p q r}}
Ecrire une procédure (TriFreqLong) qui trie cette liste en fonction
de la fréquence des longueurs des sous-listes de la moins fréquente
à la plus fréquente.
TriFreqLong $l
donne
{i j k l} o {d e} {m n} {a b c} {f g h} {p q r}
Bon téclage :-)
GS
En fait dans l'énoncé, il fallait lire:
set l {{a b c} {d e} {f g h} {i j k l} {m n} o {p q r}}
pour obtenir le résultat plus bas.
Voilà ma proposition de code pour initier le jeux.
On doit pouvoir faire plus astucieux car c'est un festival de
foreach :)
proc TriFreqLong 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)]]}
set lf [lsort -integer -index 1 $lf]
foreach i $lf {
foreach j $l {
if {[lindex $i 0] == [llength $j]} {lappend res $j}
}
}
return $res
}
TriFreqLong $l
% {i j k l} o {d e} {m n} {a b c} {f g h} {p q r}
GS
proc TriFreqLong {l} {
while {[llength $l]} {
unset -nocomplain r
foreach p $l {
lappend r([llength $p]) $p
}
set m [llength $l]
foreach p [array names r] {
if {[llength $r($p)] <= $m} {
set m [llength $r($p)]
set t $p
if {$m == 1} {break}
}
}
for {set i 0} {$i<[llength $l]} {incr i} {
set e [lindex $l $i]
if {[llength $e] == $t} {
lappend R $e
set l [lreplace $l $i $i]
}
}
}
return $R
}
% TriFreqLong $l
{i j k l} o {d e} {m n} {a b c} {p q r} {f g h}
--
David Zolli
proc TriFreqLong {l} {
foreach p $l {
lappend r([llength $p]) $p
}
while {[array size r]} {
set m 100000
foreach p [array names r] {
if {[llength $r($p)] < $m} {
set m [llength $r($p)]
set t $p
}
}
lappend R {*}$r($t)
unset r($t)
}
return $R
}
% TriFreqLong $l
{i j k l} o {d e} {m n} {a b c} {f g h} {p q r}
--
David Zolli
proc TriFreqLong {ListeRecue} {
#Tableau des frequences d'apparitions selon les longueurs
array set Freq {}
#Tableau des liste lues, rangées par longeurs
array set Listes {}
#Pour tous les éléments de la liste recue
foreach Element $ListeRecue {
#Calcul de la longueur
set Long [ llength $Element ]
#Si on a déja repéré une telle longueur
if {[info exists Freq($Long)]} {
#On ajoute à la liste
lappend Listes($Long) $Element
#on incrémente la fréquence
incr Freq($Long) 1
} else {
#Sinon on cree les éléments de tableau
set Listes($Long) [ list $Element ]
set Freq($Long) 1
}
}
#Inversion du tableau Freq, pour obtenir un tableau
#de longueurs rangés par fréquence
array set Longueurs {}
#Pour tous les éléments lus dans le tableau de Fréquences
foreach { Long Frequence } [ array get Freq ] {
#Si la fréquence est déja connue
if {[info exists Longueurs($Frequence)]} {
#Alors on ajoutera cette longueur
set Ordre lappend
} else {
#Sinon, on créera l'élement de tableau
set Ordre set
}
#Application de l'ordre (ajout ou création)
eval $Ordre Longueurs($Frequence) \$Long
}
#Construction de la liste finale
set FinaListe {}
#POur toutes les fréquences d'apparitions des longueurs, rangées
dans l'ordre croissant
foreach Frequences [ lsort -increasing [ array names Longueurs ] ] {
#pour toutes les longueurs associées à cette fréquence
foreach Longs $Longueurs($Frequences) {
#Ajouter l'élément au résultat final
set FinaListe [ concat $FinaListe $Listes($Longs) ]
}
}
#Par sécurité, on élimine les tableaux
unset Freq
unset Longueurs
unset Listes
#Retour de la liste finale
return $FinaListe
}
Mick
--
Michael Magoga. e-mail : drm...@magoga.net
---------------------------------------------------------------
"Perauriol" | Tel : 09 52 42 76 04
31220 Montberaud |
---------------------------------------------------------------
/\
( ;`~v/~~~ ;._
,/'"/^) ' < o\ '\--, Until the color of a man skin
,/",/W u '`. ~ >, )) Has no more significance
,/' w ,U^v ;//^\/\)' Than the color of his eyes
,/"'/ W` ^v W |; I got to say :
;'' | v' v`" W } \\ WAR.
" .'\ v `v/^W,) '/\/)
`\ ,/,)' '''-;' "War",B. Marley
\
set m 100000
par
set m Inf
comme ça ça marche aussi avec des sous-listes de plus de 100000
éléments.
--
David Zolli
Ca fait des années que je n'ai pas joué mais l'ami Kroc essaye de me
faire revenir dans le droit chemin :)
Je propose ça :
proc TriFreqLong l {
foreach v $l {lappend res([llength $v]) $v}
foreach {k v} [array get res] {lappend final $v}
proc pouet {a b} {return [expr [llength $a] - [llength $b]]}
join [lsort -command pouet $final]
}
set l {{a b c} {d e} {f g h} {i j k l} {m n} o {p q r}}
TriFreqLong $l
Molop,
--
Xavier Garreau
L'intérêt principal et l'art de ce jeux est justement de montrer
différents styles.
Une petite remarque: à la sortie d'une procédure, toutes les variables
locales à celle-ci sont détruites. Alors les 3 unset de fin sont peut-
être
une précaution de trop.
GS
Dans la théorie, oui, je suis d'accord.
Dans la pratique, j'ai perdu pas mal de temps à chercher quelques bugs
du à des tableaux détruit seulement en apparence, alors depuis je ne
prends plus de risques :).
> Dans la théorie, oui, je suis d'accord.
>
> Dans la pratique, j'ai perdu pas mal de temps à chercher quelques bugs
> du à des tableaux détruit seulement en apparence, alors depuis je ne
> prends plus de risques.
Si tu veux ne jamais prendre de risque, qualifie toujours pleinement
tes variables globales (par exemple ::tableau ou ::monNS::maVar) ce
qui permet au premier coup d'œil de savoir ce qu'il est inutile de
nettoyer en quittant ta procédure.
--
David Zolli
> Ca fait des années que je n'ai pas joué mais l'ami Kroc essaye de me
> faire revenir dans le droit chemin :)
Et ça valait le coup ! ;)
--
David Zolli
Oui ok, mais moi je parlais d'un vrai petit bug : tableau local, qui
n'est plus censé exister, mais qui est toujours référencable quand on
revient dans la procédure, ou dont certains éléments existent encore.
Personne n'a jamais eu ce cas ? Ca m'est arrivé une ou deux fois, c'est
pourquoi je ne prends plus de risques.
> Oui ok, mais moi je parlais d'un vrai petit bug : tableau local, qui
> n'est plus censé exister, mais qui est toujours référencable quand on
> revient dans la procédure, ou dont certains éléments existent encore.
>
> Personne n'a jamais eu ce cas ?
Je n'ai jamais rencontré un problème de ce genre imputable à Tcl (il y
avait toujours un global, upvar ou uplevel coupable quelque part). Si
tu as encore un bout de code dans ce cas, je serai vraiment curieux
d'examiner ça !
--
David Zolli
Kroc a écrit :
Ben en fait non, ca fait partie d'une énorme appli, et j'ai corrigé ca
depuis longtemps (alors bon, la spéléo dans subversion pour retrouver
une version en cause, désolé, mais la c'est au dessus de mes forces :)).
Peut-être lié au fait que j'utilise beaucoup les tableaux locaux, dans
toutes mes fonctions ?
En tout cas, je n'utilise JAMAIS l'upvar ou l'uplevel, et jamais de
tableau en global, donc ce n'était pas les fautifs.
Puis, comme je ne prends plus de risques, cela ne se produit plus, de
toutes facons.
> En tout cas, je n'utilise JAMAIS l'upvar ou l'uplevel, et jamais de
> tableau en global, donc ce n'était pas les fautifs.
Un autre coupable possible (et vicieux) c'est la commande variable
utilisée dans une procédure :
proc A {} {
variable toto
array set toto [list A 1 B 2 C 3]
}
proc B {} {
variable toto
parray toto
}
% A ; B
toto(A) = 1
toto(B) = 2
toto(C) = 3
Le genre d'erreur qui peut facilement passer pour un bug, surtout si A
et B sont assez longues et pas dans le même script.
Enfin, on ne saura jamais. ;^)
--
David Zolli
Ouaip, c'est pourquoi je n'utilise pas de tableaux en variable globale.
Trop "dangereux" pour moi. Et pis trop facile aussi :).
> Enfin, on ne saura jamais. ;^)
S'il n'y a que ca, ne t'inquiete pas, je trouve régulierement des bugs
rigolos comme ca :).
> S'il n'y a que ca, ne t'inquiete pas, je trouve régulierement des bugs
> rigolos comme ca :).
Chouette ! Parce qu'on manque cruellement de défis ces derniers
temps !
--
David Zolli