Discussion :

[cmcmc]

Sachant que input.dat contient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
a 1
a 3
a 2
a 3
b 3
b 4
c 8
c 1
a 3
a 4
x 7
b 2
b 2

qu'est ce qu'il y a dans Mystery.pm (sachant que sa taille est de 35 caractères et qu'il ne fait pas appel à d'autres modules) pour expliquer le résultat suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Taisha:~/perl/forum $ perl -MMystery -nlae '$F[0] ne $g->[0] and $g = bless [@F] or $g->[1] += $F[1]' input.dat
a 9
b 7
c 9
a 7
x 7
b 4
Taisha:~/perl/forum $

Solution sur ce fil dans quelques jours... Pour ne pas spoiler, vous pouvez m'envoyer vos réponses par MP ou les publier sur ce fil mais dans ce cas attendez lundi... Bonne chasse

[Lolo78]

Bonjour,
répondu par MP.

[cmcmc]

Quelques précisions :

1. ce n'est pas une course
2. il faut répondre à la question
3. essayez, même si vous ne vous sentez pas expert. Vous devrez sans doute vous plonger dans la doc, à commencer par celle ci, mais ce ne sera pas du temps perdu

[Philou67430]

La question est-elle bien qu'il faut t'envoyer 35 caractères correspondant au contenu de Mystery.pm ?
C'est drôle, mais plutôt que chercher dans la doc, j'ai l'impression qu'on trouve la réponse en cherchant dans ce sous-forum

Bon, comme ce n'est pas une course, je vais voir ce que je peux encore faire ce matin...

[cmcmc]

La question est-elle bien qu'il faut t'envoyer 35 caractères correspondant au contenu de Mystery.pm ?

C'est ça Allez, je laisse 20% de marge sur la taille.

[Philou67430]

Et si l'on écrit souhaite écrire quelque chose qu'il n'utilise pas Mystery.pm ?

[cmcmc]

Et si l'on écrit souhaite écrire quelque chose qu'il n'utilise pas Mystery.pm ?

alors on est hors sujet et donc forfait

[Philou67430]

Dommage, j'aime les défis où la liberté offerte par perl peut s'exprimer pleinement

[Philou67430]

J'ai répondu "hors sujet"

[cmcmc]

Bon, en premier lieu, il n'y a pas de piège. Les lignes d'entrées contiennent deux informations, une étiquette et une valeur. Le programme identifie les groupes de lignes consécutives ayant la même étiquette, et produit pour chaque groupe une ligne contenant cette étiquette commune d'une part, et la somme des valeurs des lignes constituant le groupe d'autre part.

Pour ceux qui s'interrogeraient sur l'absence de boucle dans le programme, c'est dû aux flags -n, -l et -a utilisés lors de l'invocation de perl en plus de -e (sous la forme compacte -nlae)

1. -ne '...' provoque l'insertion d'une boucle autour du code ... et est equivalent à -e 'LINE: while (<>) { ... }'
2. -l ajoute l'instruction chomp dans la boucle ce qui donne -e 'LINE: while (<>) { chomp; ... }'
3. -a ajoute l'instruction @F = split dans la boucle ce qui donne -e 'LINE: while (<>) { chomp; @F = split; ... }'

On comprend donc que le code $F[0] ne $g->[0] and $g = bless [@F] or $g->[1] += $F[1] sera exécuté pour chaque ligne du fichier d'entrée, $F[0] contenant l'étiquette et $F[1] la valeur lues pour cette ligne.

Ceci posé, le code est un peu bizarre... C'est une expression logique, de la forme A and B or C, dont on n'utilise pas le résultat... En fait, à cause des règles de précédence des opérateurs logiques, du fait que B est toujours vrai, et de l'évaluation minimale effectuée par Perl pour les expressions logiques, celle expression est ici équivalente au test if (A) { B } else { C }, soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
if ($F[0] ne $g->[0])) {
    $g = bless [@F]
} else {
    $g->[1] += $F[1]
}

ce qui est peut-être un peu plus facile à appréhender. Les formes $g->[0] et $g->[1] indiquent clairement que $g est une référence à un tableau de 2 entrées, et on voit bien le fonctionnement de l'algorithme : $g va représenter le groupe en cours de traitement, avec l'étiquette dans $g->[0] et la somme dans $g->[1]. Le test if ($F[0] ne $g->[0]) permet de détecter qu'on change de groupe. Si la condition est vraie (les étiquettes du groupe et de la ligne courante diffèrent), et donc qu'on doit créer un nouveau groupe, on exécute le corps du if, $g = bless [@F] qui initialise le nouveau groupe $g par une référence à un tableau contenant une copie des champs de la ligne courante. Si la condition est fausse, on incrémente la somme du groupe de la valeur trouvée dans la ligne courante.

Incidemment $g n'étant pas initialisée (sauf peut être dans Mystery.pm mais cela semble improbable), est indéfinie lors du traitement de la première ligne. Le déréférencement $g->[0] produit dans ce cas undef qui en contexte de comparaison textuelle se transforme en chaîne vide. La condition du if est alors vraie, et on crée un nouveau groupe dès la première ligne.

C'est limpide.

Mais mais mais... Au fait, qui imprime le résultat ? Le mystère reste entier !

[Lolo78]

J'ai répondu "hors sujet"

Moi aussi.

J'ai attendu lundi et, de toute façon je ne spoile pas puisque ma solution n'est pas jugée valable:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
$  perl -nlae '$F[0] ne $g->[0] and print "@$g" and $g = [@F] or $g->[1] += $F[1]; END{print "@$g"}' input.dat

ou, en un peu plus court:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
$ perl -nlae '$F[0] ne $g[0] and print "@g" and @g = @F or $g[1] += $F[1]; END{print "@g"}'  input.dat

Au total j'ai tout de même 25 caractères de moins que le défi original.





Bonne fin de soirée.

EDIT: commencé à poster avant de voir les explications de cmccmc. De toute façon, j'avais envoyé les solutions ci-dessus par MP dès vendredi dernier.

[Lolo78]

Bon, en premier lieu, il n'y a pas de piège. Les lignes d'entrées contiennent deux informations, une étiquette et une valeur. Le programme identifie les groupes de lignes consécutives ayant la même étiquette, et produit pour chaque groupe une ligne contenant cette étiquette commune d'une part, et la somme des valeurs des lignes constituant le groupe d'autre part.

Pour ceux qui s'interrogeraient sur l'absence de boucle dans le programme, c'est dû aux flags -n, -l et -a utilisés lors de l'invocation de perl en plus de -e (sous la forme compacte -nlae)

1. -ne '...' provoque l'insertion d'une boucle autour du code ... et est equivalent à -e 'LINE: while (<>) { ... }'
2. -l ajoute l'instruction chomp dans la boucle ce qui donne -e 'LINE: while (<>) { chomp; ... }'
3. -a ajoute l'instruction @F = split dans la boucle ce qui donne -e 'LINE: while (<>) { chomp; @F = split; ... }'

On comprend donc que le code $F[0] ne $g->[0] and $g = bless [@F] or $g->[1] += $F[1] sera exécuté pour chaque ligne du fichier d'entrée, $F[0] contenant l'étiquette et $F[1] la valeur lues pour cette ligne.

Ceci posé, le code est un peu bizarre... C'est une expression logique, de la forme A and B or C, dont on n'utilise pas le résultat... En fait, à cause des règles de précédence des opérateurs logiques, du fait que B est toujours vrai, et de l'évaluation minimale effectuée par Perl pour les expressions logiques, celle expression est ici équivalente au test if (A) { B } else { C }, soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
if ($F[0] ne $g->[0])) {
    $g = bless [@F]
} else {
    $g->[1] += $F[1]
}

ce qui est peut-être un peu plus facile à appréhender. Les formes $g->[0] et $g->[1] indiquent clairement que $g est une référence à un tableau de 2 entrées, et on voit bien le fonctionnement de l'algorithme : $g va représenter le groupe en cours de traitement, avec l'étiquette dans $g->[0] et la somme dans $g->[1]. Le test if ($F[0] ne $g->[0]) permet de détecter qu'on change de groupe. Si la condition est vraie (les étiquettes du groupe et de la ligne courante diffèrent), et donc qu'on doit créer un nouveau groupe, on exécute le corps du if, $g = bless [@F] qui initialise le nouveau groupe $g par une référence à un tableau contenant une copie des champs de la ligne courante. Si la condition est fausse, on incrémente la somme du groupe de la valeur trouvée dans la ligne courante.

Incidemment $g n'étant pas initialisée (sauf peut être dans Mytery.pm mais cela semble improbable), est indéfinie lors du traitement de la première ligne. Le déréférencement $g->[0] produit dans ce cas undef qui en contexte de comparaison textuelle se transforme en chaîne vide. La condition du if est alors vraie, et on crée un nouveau groupe dès la première ligne.

C'est limpide.

Tout cela j'avais compris, c'est effectivement clair, c'est bien pour cela que j'ai pu simplifier la mécanique en me passant d'un objet.

Mais mais mais... Au fait, qui imprime le résultat ? Le mystère reste entier !

Sans doute une méthode destroy de l'objet ou un truc de ce genre.
Mais je n'en ai pas besoin puisque ma solution se passe d'objet et est plus courte.

[cmcmc]

Moi aussi.
ou, en un peu plus court:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
$ perl -nlae '$F[0] ne $g[0] and print "@g" and @g = @F or $g[1] += $F[1]; END{print "@g"}'  input.dat

Au total j'ai tout de même 25 caractères de moins que le défi original.

Si l'important était d'avoir la plus courte tu pourrais éliminer quelques espaces :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Taisha:~/perl/forum $ perl -nlae '$F[0]ne$g[0]and print"@g"and@g=@F or$g[1]+=$F[1];END{print"@g"}' input.dat
 
a 9
b 7
c 9
a 7
x 7
b 4
Taisha:~/perl/forum $

mais tes codes sont en l'état non conformes car ils génèrent malheureusement une première ligne vide...

[disedorgue]

Bonjour,

Envoyé ma solution par MP.

Sinon, un correctif de la solution hors sujet de lolo78:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

perl -nlae '$F[0] ne $g[0] and {$.>1 and print "@g"} and @g=@F or $g[1]+=$F[1];END{print"@g"}' input.dat

[cmcmc]

Remerciements et félicitations à disedorgue qui a joué le jeu et m'a fait parvenir une réponse correcte par MP

Lors du décryptage (ici), on avait noté qu'un nouveau groupe est initialisé par copie des champs de la ligne courante via $g = bless [@F] . Cependant, pour effectuer cette copie, $g = [@F] aurait suffi... Quel est donc l'intérêt de l'appel à bless ?

Perl n'est pas particulièrement "orienté objet". Il supporte cependant certaines formes de programmation orientée objet et les concepts associés (attributs, méthodes, héritage, polymorphisme, traits, etc...). Mais les "objets" en Perl ne sont pas des constructions particulières : ce sont simplement des entités natives de perl (hashes, tableaux, scalaires, etc...) qui ont été explicitement associées avec une classe ; et une classe n'est rien de plus qu'un package, c'est à dire à minima un espace de nommage. Et l'association est justement effectuée par ce fameux bless.

Notre copie [@F] a donc été élevée au rang d'objet. Heuu, on est content pour elle mais bon ... Dans quelle classe au fait ? Eh bien le package courant, à savoir main (c'est le package par défaut en l'absence de déclaration explicite, et ici il n'y en a pas). La belle affaire me direz vous, il n'y a pas de méthode particulière définie dans main et d'ailleurs on ne voit pas la queue d'une quelconque invocation de méthode (de la forme $g->methode(...)) dans le code...

Ah mais c'est que cette promotion au rang d'objet a quand même changé quelque chose. A savoir qu'au moment de la disparition de l'objet, on va regarder si un destructeur a été défini dans la classe associée, et si c'est le cas on va l'invoquer sur l'objet mourant. C'est typiquement utilisé pour libérer des ressources associées à l'objet en question (par exemple fermer un fichier).

Mais au fait, quand est-ce qu'un objet meurt ? Eh bien tout simplement lorsque la dernière référence sur lui disparaît. Ici la seule référence qu'on ait sur un objet produit par bless [@F], c'est le $g auquel on l'a affecté.

Et que se passe-t-il lorsqu'on exécute $g = bless [@F] ? Initialement $g est indéfini, donc la première affectation ne va rien faire de spécial. Mais lorsqu'on va ensuite changer de groupe, l'affectation à $g va décrémenter le compte de références de l'entité que $g référençait juste avant l'affectation. Comme $g était la seule référence sur cette entité, ce compte passe à zéro, l'entité meurt et la mémoire qu'elle occupait est restituée à l'interpréteur. Si l'entité en question était un objet, on exécute son destructeur avant cette restitution.

Mais c'est pile poil ce qu'il nous faut, ça ! Au moment ou il meurt, par construction, notre objet groupe est complet. Et une fois qu'il est complet, sa seule raison d'être est d'imprimer son contenu dans un déchirant chant du cygne avant de disparaître... Le destructeur est du coup parfaitement approprié pour cela.

Ce qui nous donne la solution de l'énigme. Malgré son nom et contrairement aux conventions habituelles, Mystery.pm ne définit par un package Mystery mais contient simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
sub DESTROY { print "@{$_[0]}" }
1

Le destructeur est invoqué avec un seul paramètre, une référence à l'objet en cours de destruction, que l'on trouve donc dans $_[0]. Petite subtilité, on n'a pas besoin de passer explicitement à la ligne car le flag -l assure ici (en plus du chomp sur les lignes d'entrée) que "\n" est ajouté à chaque invocation de print.

Mais, me direz vous en observateur attentif, quid du dernier groupe ? Il n'y a pas d'affectation à $g pour le tuer ! D'où vient que ce dernier groupe chante son chant comme les autres ? En fait, ici il ne le chante pas dans les mêmes conditions. Dans le cas de ce programme, le dernier groupe sera détruit dans la phase de destruction globale qui intervient en fin d'exécution du programme, comme on peut s'en convaincre en remplaçant dans le destructeur ci-dessus le print par un warn :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Taisha:~/perl/forum $ perl -MMystery -nlae '$F[0]ne$g->[0]and$g=bless[@F]or$g->[1]+=$F[1]' input.dat
a 9 at Mystery.pm line 1, <> line 5.
b 7 at Mystery.pm line 1, <> line 7.
c 9 at Mystery.pm line 1, <> line 9.
a 7 at Mystery.pm line 1, <> line 11.
x 7 at Mystery.pm line 1, <> line 12.
b 4 at Mystery.pm line 1, <> line 13 during global destruction.
Taisha:~/perl/forum $

Ce comportement est suffisant dans le cadre de cet uniligne mais on n'est évidemment pas obligé d'attendre la phase de destruction globale. On pourrait par exemple forcer sa mort dans un bloc END :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Taisha:~/perl/forum $ perl -MMystery -nlae 'END { undef $g} $F[0] ne $g->[0] and $g = bless[@F] or $g->[1] += $F[1]' input.dat
a 9 at Mystery.pm line 1, <> line 5.
b 7 at Mystery.pm line 1, <> line 7.
c 9 at Mystery.pm line 1, <> line 9.
a 7 at Mystery.pm line 1, <> line 11.
x 7 at Mystery.pm line 1, <> line 12.
b 4 at Mystery.pm line 1, <> line 13.
Taisha:~/perl/forum $

Alternativement, si $g est une variable lexicale le dernier groupe (s'il y en a un) disparaît au moment où on quitte le bloc où il est déclaré :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Taisha:~/perl/forum $ perl -E '
sub DESTROY { warn "@{$_[0]}" }
warn "AVANT";
{
    my $g;
    while (<>) {
        chomp;
	@F = split;
	$F[0] ne $g->[0] and $g = bless[@F] or $g->[1] += $F[1]
    }
}
warn "APRES"
' input.dat
AVANT at -e line 3.
a 9 at -e line 2, <> line 5.
b 7 at -e line 2, <> line 7.
c 9 at -e line 2, <> line 9.
a 7 at -e line 2, <> line 11.
x 7 at -e line 2, <> line 12.
b 4 at -e line 2, <> line 13.
APRES at -e line 12, <> line 13.
Taisha:~/perl/forum $

Plutôt cool, non ?

[Lolo78]

Bah, j'avais bien dit dès le 16/11 que l'impression des résultats devait se faire dans un simple destructeur de l'objet.

Mais utiliser une syntaxe objet dans un uniligne, c'est pour moi un exemple pathologique d'overengineering. Ou d'une application du principe: "Pourquoi faire simple quand on peut faire compliqué?".

[cmcmc]

Cette énigme trouve son inspiration dans un autre fil (celui ci), pour un problème quasiment identique. Mais il est en fait assez classique d'avoir à regrouper des données en ne sachant qu'on a fini avec un groupe que lorsqu'on en attaque un nouveau. Par exemple, traiter différentes sections, chacune initialisée par une ligne commençant par #, d'un fichier de la forme

# ...
...
...
# ...
...
# ...
etc.

Conceptuellement, un algorithme possible est le suivant :

    while (on a des items à traiter) {
        if (l'item courant démarre un nouveau groupe) {
            émettre le groupe précédent s'il existe
            démarrer un nouveau groupe
        } else {
            combiner l'item courant avec le groupe en cours de construction
        }
    }
    émettre le groupe précédent s'il existe

C'est le modèle suivi par les solutions ci-dessus de Lolo78, à ceci près qu'il a omis le premier s'il existe (cela se traduit par l'émission d'une ligne vide excédentaire en tête du fichier de sortie) d'une part, et le second s'il existe d'autre part, tandis que le correctif proposé par disedorgue prend en compte le premier mais pas le second... Détails, détails, mais c'est là que le diable fait son nid ... Incidemment, le second est nécessaire pour avoir une sortie correcte -- a savoir vide -- si le fichier d'entrée est lui-même vide.

L'algorithme ci-dessus n'est pas mal, si ce n'est la répétition des émettre le groupe précédent et des tests s'il existe, sachant que le test d'existence apparait également (peut-être implicitement) dans l'item courant démarre un nouveau groupe. Par exemple, pour une version qui passe les strictures et les warnings, et intégrable dans un programme plus important :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
{
  my $g;
  while (my @F = ...) {
    if (!$g or $g->[0] ne $F[0]) {
      say "@$g" if $g;
      $g = [@F];
    } else {
      ...
    }
  }
  say "@$g" if $g;
}

On peut capturer les répétitions dans une fonction dédiée (ce qui facilite la maintenance -- un seul point d'intervention si on doit un jour modifier la manière dont le résultat est généré), ou dans une fermeture locale qui ne pollue par l'espace de nommage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
{
  my $g;
  my $emission = sub { my $g = shift; say "@$g" if $g };
  while (my @F = ...) {
    if (!$g or $g->[0] ne $F[0]) {
      $emission->($g);
      $g = [@F]
    } else {
      ...
    }
  }
  $emission->($g)
}

mais un destructeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
sub X::DESTROY { say "@{$_[0]}" }
{ 
  my $g;
  while (my @F = ...) {
    if (!$g or $g->[0] ne $F[0]) {
      $g = bless [@F], 'X'
    } else {
      ...
    }
  }
}

a ce côté délicieux d'être appelé implicitement lorsqu'il est nécessaire et de permettre de ne pas se préoccuper des tests d'existence (hormis pour décider si on démarre un nouveau groupe). Sous cette forme il pose par contre son propre problème de nommage (choix de 'X'...). Mais pour un projet plus compliqué on pourrait définir une classe Groupe et coder comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
package Groupe {
  sub new { ... }      # contruit un nouveau groupe à partir d'un item
  sub accepte { ... }  # teste si l'item passé en paramètre doit être intégré au groupe
  sub integre { ... }  # intègre l'item passé en paramètre au groupe en cours de construction
  sub DESTROY { ... }  # finalise et émet le resultat
};
 
{ 
  my $g;
  while (my $item = ...) {
    if ($g and $g->accepte($item)) {
      $g->integre($item)
    } else {
      $g = Groupe->new($item)
    }
  }
}

auquel cas ce problème de nommage dépend de la stratégie utilisée dans le projet.

Dans la vraie vie j'utiliserais sans doute soit cette dernière approche soit l'une des solutions présentées dans cet autre fil. Mais je trouvais intéressant de signaler la convergence entre les mécanismes sous-jacents aux destructeurs d'une part, et les opérations nécessaires à la résolution de cette classe de problèmes d'autre part.

[Philou67430]

Cette classe de problème trouve également souvent avantage à utiliser l'opérateur flip-flop (.. ou ...).

[disedorgue]

Voici une solution qui fonctionne aussi correctement avec le bon Mystery2.pm (bien moins compliqué ):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
perl -mMystery2 -nlae '$F[0] ne $D[$A] ? $A++ : $A;$C[$A]+=$F[1];$D[$A]=$F[0]' input.dat
a 9
b 7
c 9
a 7
x 7
b 4

Mais je reconnais que l'astuce avec bless peut être utile et permet de comprendre le destructeur du monde objet.

[cmcmc]

Voici une solution qui fonctionne aussi correctement avec le bon Mystery2.pm (bien moins compliqué ):

Mystery2.pm envoyé par MP.

On peut golfer cette forme un chouia :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Taisha:~/perl/forum $ #### -mMystery2 -nlae '$F[0] ne $D[$A] ? $A++ : $A;$C[$A]+=$F[1];$D[$A]=$F[0]' input.dat
Taisha:~/perl/forum $ perl -mMystery2 -nlae '$C[$A+=$F[0]ne$D[$A]]+=$F[1];$D[$A]=$F[0]'              input.dat
a 9
b 7
c 9
a 7
x 7
b 4
Taisha:~/perl/forum $

Mais je reconnais que l'astuce avec bless peut être utile et permet de comprendre le destructeur du monde objet.

Dans ce cas un petit serait bienvenu (j'en étais à me demander si la conclusion avait été lue par quelqu'un...)

Note également que l'autre algorithme fonctionne à la volée, contrairement à celui ci