Pour bien commencer l'année un Jeux Técleux :-)
Il s'agit de créer un programme qui génère à partir d'un chiffre A
une suite de N nombres de telle sorte que le prochain nombre se
déduit du précédent en énoncant les chiffres contenus à haute voix.
Bon, je crois que cela vaut la peine de donner un exemple:
Donc avec A=1 et N=5:
Suite 1 5
donnera:
1 soit (un,un)
11 soit (deux un)
21 soit (un deux, un un)
1211 soit (un un,un deux,deux un)
111221 soit (trois un,deux deux,un un)
312211
Bon téclage !
GS
Hello,
je comprends pas, il y a six nombres ą l'arrivée...
Miko?
Euh,
Le 1er (le un) ne compte pas puisque c'est celui de départ.
GS
proc compte {quoi} {
set r {}
set p [string index $quoi 0]
set c 0
foreach n [split $quoi {}] {
if {$n eq $p} {
incr c
} else {
append r ${c}$p
set p $n
set c 1
}
}
return $r$c$p
}
proc boucle {d n} {
puts $d
for {set i 1} {$i <= $n} {incr i} {
set d [compte $d]
puts $d
}
}
% boucle 1 5
1
11
21
1211
111221
312211
--
David Zolli
proc syntax {} {
set nom [file tail [info script]]
puts "Concours TCL janvier 2009"
puts "*************************"
puts "Utilisation:"
puts " $nom premier_nombre nombre_d_iteration"
puts "Exemple:"
puts " $nom 1 5"
puts ""
}
proc iterate {v n} {
puts $v
for {set i 0} {$i < $n} {incr i} {
set result ""
if {[string length $v] == 1} {
set v "1$v"
puts $v
} else {
set lst [split $v ""]
set ref [lindex $lst 0]
set c 1
for {set j 1} {$j < [llength $lst]} {incr j} {
set cur [lindex $lst $j]
if {$cur == $ref} {
incr c
} else {
append result $c $ref
set ref $cur
set c 1
}
}
append result $c $ref
set v $result
set result ""
puts $v
}
}
}
if {$argc != 2} {
syntax
} else {
set valeur [lindex $argv 0]
set iteration [lindex $argv 1]
if {(![string is integer -strict $valeur]) \
|| (![string is integer -strict $iteration])} {
syntax
} else {
iterate $valeur $iteration
}
}
exit
--
Jack.R
http://jack.r.free.fr
> Preums :
> append r ${c}$p
Pourquoi les accolades autour de c ?
Je viens d'essayer avec et sans et je n'ai pas vu la différence.
--
Jack.R
> Preums :
>
8< Du code super concis >8
> % boucle 1 5
> 1
> 11
> 21
> 1211
> 111221
> 312211
Wouaa, j'ai encore du chemin a faire pour écrire du concis plutôt que tu
verbeux !
--
Jack.R
C'était un précaution inutile pour borner le nom de la variable : un
réflexe quand un truc est accolé à un nom de variable. Avec un $ ça ne
risquait rien.
--
David Zolli
proc suite {S l} {
lassign {-1 0} i NextIndex
if {[incr l -1]==-1} {return $S}
foreach e $S {
if {[incr i] < $NextIndex} continue
lappend Res \
[expr {[set NextIndex \
[lsearch -integer -start [expr $i+1] -not $S $e]] >= 0 ?
\
$NextIndex-$i : [lindex $S end] eq $e ?
\
[set NextIndex [llength $S]]-$i : 1 }] $e
if {$NextIndex == [llength $S]} break
}
set S [suite $Res $l]
}
version sans récursion :
proc suite1 {S l} {
for {set j 0 } {$j < $l} {incr j} {
lassign {-1 0} i NextIndex
foreach e $S {
if {[incr i] < $NextIndex} continue
lappend Res \
[expr {[set NextIndex \
[lsearch -integer -start [expr $i+1] -not $S $e]] >=
0 ? \
$NextIndex-$i : [lindex $S end] eq $e ? \
[set NextIndex [llength $S]]-$i : 1 }] $e
if {$NextIndex == [llength $S]} break
}
lassign [list $Res ""] S Res
}
set S
}
# tests (pentium IV bi-proc)
time {suite 1 20} 100
# 4060.0 microseconds per iteration
time {suite1 1 20} 100
# 3910.0 microseconds per iteration
time {boucle 1 20} 100
# 21870.0 microseconds per iteration
time {iterate 1 20} 100
# 21560.0 microseconds per iteration
# si on enlève les "puts" :
time {boucle 1 20} 100
# 790.0 microseconds per iteration
time {iterate 1 20} 100
# 780.0 microseconds per iteration
c'est où donc que je perd du temps ? liste ?
iterate / version list
proc iterate {v n} {
for {set i 0} {$i < $n} {incr i} {
set result ""
if {[llength $v] == 1} {
set v [list 1 $v]
} else {
set ref [lindex $v 0]
set c 1
for {set j 1} {$j < [llength $v]} {incr j} {
set cur [lindex $v $j]
if {$cur == $ref} {
incr c
} else {
lappend result $c $ref
set ref $cur
set c 1
}
}
lappend result $c $ref
set v $result
set result ""
}
}
return $v
}
time {iterate 1 20} 100
# 620.0 microseconds per iteration
proc compte {quoi} {
set r ""
set c 1
foreach n [lassign $quoi p] {
if {$n eq $p} {
incr c
} else {
lappend r $c $p
set p $n
set c 1
}
}
return [list {*}$r $c $p]
}
proc boucle {d n} {
for {set i 1} {$i <= $n} {incr i} {
set d [compte $d]
}
return $d
}
time {boucle 1 20} 100
# 630.0 microseconds per iteration
Non, ce n'est pas les listes, qui sont légèrement plus rapides que les
chaines
lsearch ? expr ? .
proc suite3 {S l} {
for {set j 0 } {$j < $l} {incr j} {
for {set i 0} {$i < [llength $S]} {} {
set e [lindex $S $i]
for {set c 1} {[lindex $S [incr i]] == $e} {incr c} {}
lappend Res $c $e
}
lassign [list $Res ""] S Res
}
return $S
}
time {suite3 1 45} 5
# 509400.0 microseconds per iteration
time {iterate 1 45} 5
# 553000.0 microseconds per iteration
time {boucle 1 45} 5
# 862600.0 microseconds per iteration
la commande "[llength $S]" de la deuxième boucle ne nécessite pas
d'être exécutée a chaque fois.
De plus une commande composée "lassign [list]" ... est plus longue que
deux commandes "set" séparées.
proc suite3 {S l} {
for {set j 0 } {$j < $l} {incr j} {
for {set i 0; set lg [llength $S] } {$i < $lg} {} {
set e [lindex $S $i]
for {set c 1} {[lindex $S [incr i]] == $e} {incr c} {}
lappend Res $c $e
}
set S $Res
set Res ""
}
return $S
}
time {suite3 1 45} 5
# 478200.0 microseconds per iteration
le même, en récursif
proc suite3 {S l} {
for {set i 0; set lg [llength $S] } {$i < $lg} {} {
set e [lindex $S $i]
for {set c 1} {[lindex $S [incr i]] == $e} {incr c} {}
lappend Res $c $e
}
if {$l == 1} {return $Res} else {suite3 $Res [incr l -1]}
}
time {suite3 1 45} 5
# 497000.0 microseconds per iteration
Le récursif est légèrement plus lent
Hello,
Bravo !
Ces diverses optimisations commentées sont très intéressantes.
En grand adepte de la récursion, j'apprécie beaucoup :-)
GS