Jeux Técleux Janvier 2009

gerard sookahet

unread,

Jan 9, 2009, 1:18:06 PM1/9/09

to

Hello,

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

Miko

unread,

Jan 9, 2009, 1:36:30 PM1/9/09

to

gerard sookahet a écrit :
> Hello,
....
>
> Suite 1 5
>
> donnera:
>
...explications
> 312211

Hello,

je comprends pas, il y a six nombres ą l'arrivée...

Miko?

gerard sookahet

unread,

Jan 9, 2009, 2:18:42 PM1/9/09

to

Miko wrote:
> gerard sookahet a écrit :
>> Hello,
> ....
>> Suite 1 5
>>
>> donnera:
>>
> ...explications
>> 312211
>
> 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

Kroc

unread,

Jan 9, 2009, 2:35:27 PM1/9/09

to

Preums :

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

Jack.R

unread,

Jan 9, 2009, 3:08:23 PM1/9/09

to

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

Jack.R

unread,

Jan 9, 2009, 3:58:01 PM1/9/09

to

Le Fri, 09 Jan 2009 11:35:27 -0800, Kroc a écrit:

> 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

Jack.R

unread,

Jan 9, 2009, 3:19:53 PM1/9/09

to

Le Fri, 09 Jan 2009 11:35:27 -0800, Kroc a écrit:

> 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

Kroc

unread,

Jan 10, 2009, 5:56:02 AM1/10/09

to

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

Message has been deleted

postm...@florentmerlet.com

unread,

Feb 19, 2009, 7:53:51 PM2/19/09

to

J'ai été surpris par l'indentation du site, je recommence
Variante liste / lsearch / récursion

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 ? .

postm...@florentmerlet.com

unread,

Feb 19, 2009, 9:38:21 PM2/19/09

to

Bref, plus les commandes sont simples, plus l'algorithme est rapide :
la boucle for étant la plus efficace. Dernière version

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

postm...@florentmerlet.com

unread,

Feb 19, 2009, 10:47:24 PM2/19/09

to

Dernière optimisation :

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

gerard sookahet

unread,

Feb 25, 2009, 2:04:36 PM2/25/09

to

Hello,

Bravo !

Ces diverses optimisations commentées sont très intéressantes.

En grand adepte de la récursion, j'apprécie beaucoup :-)

GS