Discussion :

[david0o]

Bonjour,

je n'utilise pas Perl régulièrement, et ça se sent quand j'en ai besoin.
Mon problème est simple, et la solution doit l'être tout autant. Mais...

Je dispose d'une liste de chaîne de caractères de la forme suivante : id;nombre , id;nombre ...
Le ; vient de la concaténation que j'ai fait des éléments avant de les mettre dans la liste, mais peu importe. Cela sera plus clair dans un tableau :

id1	3.2
id1	12.7
id1	2
id2	1.2
id2	6.5
id3	7.8
id3	0.5
id4	15.6
id1	1.5
id1	9.3

L'idée est la suivante, je voudrais, pour chaque groupe d'id identique, ne conserver que la plus haute valeur.
Sachant qu'il y a plusieurs groupe d'id au nom similaire (ici id1), je veux conserver la plus haute valeur de chacun de ces groupes de même nom.
Cela donnerai :

id1	12.7
id2	6.5
id3	7.8
id4	15.6
id1	9.3

Pour ce qui est de récupérer le maximum, la fonction max du package List::Util fait très bien l'affaire.
Ok, je viens de me rendre compte que sous la forme id;nombre la fonction max ne fait que me renvoyer le dernier élément de la liste, mais dans le sens nombre;id, il renvoie bien la plus haute valeur. Soit.

Le fait est que je ne vois pas bien comment isoler chaque groupe pour récupérer le maximum à chaque fois.

Je me prend la tête avec des boucles, mais comment conserver la valeur de l'itération précédente ?

En fait, cette liste est créée en extrayant deux éléments de chaque ligne d'un csv. Je suppose que le filtre pourrait se faire à ce niveau, mais ça ne change pas le problème de la valeur de l'itération précédente.

Bref, je patauge. Si vous avez une idée, ou un bout de piste, je suis preneur !
Merci !

[JeanMi3000]

Un bout de code à l'arrache (qui fonctionne chez moi )

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
23
24
#!/usr/bin/perl -W
use strict;
use warnings;
use Data::Dumper;
use List::Util qw(max);
 
my $filename = "data.csv";
 
my %hashIdVal = ();
open ( IN, "<$filename") || die ("Erreur d'ouverture");
 
foreach (<IN>){
	chomp;
	my ($id, $val) = split( /;/, $_ );
	push( @{$hashIdVal{$id}}, $val);
}
 
#print Dumper( \%hashIdVal )."\n";
foreach my $key (sort keys( %hashIdVal)){
 
	my $maximum = max(@{$hashIdVal{$key}});
	print "key :: $key\t Max :: $maximum\n";
}
close( IN );

je lis le fichier, je splitte chaque ligne sur le caractère ';', je pousse chaque valeur dans un hash qui contient pour chaque clé un array,
puis, pour chaque clé du hash trié par clé (le 'sort keys'), je cherche le maximum avec la fonction max et j'affiche le tout.

Autre solution possible : calculer le max à la lecture de chaque ligne, toujours en utilisant le hash.

[david0o]

Bonjour,

merci pour la réponse rapide !
Et effectivement, ça fonctionne (les tables de hash, je me disais bien qu'il faudrait en passer par là, mais j'ai toujours du mal à les utiliser...).

A un détail près, les deux groupes id1 sont confondus, puisque la clé est la même.
Hors je voudrais pouvoir récupérer le maximum du premier ET du deuxième groupe id1. Comme sur mes tableaux du premier post.
Comme un id1_1 et id1_2 en fait.

Avec cette solution, il faudrait que je renomme au préalable les nouveaux groupes avec un nom identique à ceux déjà parcouru. Mais on revient au même problème je pense.
Peut-être pourrais-je faire une liste de listes, et appliquer la fonction max sur chaque liste de cette liste. Le problème étant comment identifier chaque sous groupe, sans mélanger les groupes différents (de par leur positionnement dans le csv) mais de même id.

En tout cas, je verrais ça demain.
Merci encore !

[Philou67430]

Pour répondre à ton objection, il faudrait que tu spécifies comment on peut "objectivement" détecter le début d'un nouveau groupe... (ici, on pourrait supposer qu'un nouveau groupe démarre lorsque le numéro suivant le text "id" devient strictement inférieur au précédent, mais est-ce vraiment le cas ? et est-ce que tous les éléments de la colonne 1 seront toujours dans ce format ? Comment traiter id_9 et id_09 ? ...)

[Lolo78]

En supposant que les groupes sont ordonnés et que tout changement d'ID clôt l'affaire pour un groupe (et en supposant que les valeurs sont toujours positives), un bout de code vite fait sans tester:

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
23
 
#!/usr/bin/perl
use strict;
use warnings;
 
my $filename = "text.txt";
open my $IN, "<", $filename or die "Ouverture impossible de $filename : $!");
 
my $old_id = "";
my $first_line = <$IN>;
my ($maxid, $maxval) = split /;/, $first_line; # initialisation  des max avec première ligne
while (<$IN>) {
    my ($id, $val) = split /;/, $_;
    if ($id eq $old_id) {
        next unless $val > $maxval;
    } else {
        print "$maxid : $maxval \n";
    }
    $maxval = $val;
    $maxid = $id;
}
print "$maxid : $maxval \n"; # ne pas oublier le dernier max en fin de fichier
close $IN;

[cmcmc]

Code :

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

1
2
3
4
5
6
7
8
Taisha:~/perl/forum $ echo "id1;3.2 , id1;12.7 , id1;2 , id2;1.2 , id2;6.5 , id3;7.8 , id3;0.5 , id4;15.6 , id1;1.5 , id1;9.3" > datain
Taisha:~/perl/forum $ perl -E 'local $/ = q{,}; while (<>) { ($i,$n) = m/(\w+);([0-9.]+)/; if ($i ne $pi) { say "$pi:$m" if $pi; ($pi, $m) = ($i, $n) } else { $m = $n if $n > $m }} say "$pi:$m"' datain
id1:12.7
id2:6.5
id3:7.8
id4:15.6
id1:9.3
Taisha:~/perl/forum $

update: je viens de voir la version de Lolo78, c'est le même principe. Principale différence, ici on se fonde sur le fait que $pi est initialement undef (donc d'une part différent de tout id dans le test if ($i ne $pi), et d'autre part faux dans le test if $pi ), ce qui permet d'éviter de lire séparément la première ligne.

[cmcmc]

Il y a un truc qui me heurte dans ma solution ci-dessus (comme dans celle de Lolo78), c'est la nécessité de répéter le code d'émission du résultat (say "$pi:$m" chez moi, print "$maxid : $maxval \n" chez lui). Je ne trouve pas immédiatement de solution élégante à ce problème. Ce qui suit fonctionne mais n'est pas franchement limpide

Code :

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

1
2
3
4
5
6
7
Taisha:~/perl/forum $ perl -E 'local $/ = q{,}; {{ undef $i; ($i, $n) = m/(\w+);([0-9.]+)/ if defined ($_ = <>); if ($i ne $pi) { say "$pi:$m" if $pi; ($pi, $m) = ($i, $n) } else { $m = $n if $n > $m }; redo if defined $i}}' datain
id1:12.7
id2:6.5
id3:7.8
id4:15.6
id1:9.3
Taisha:~/perl/forum $

Alternatives bienvenues...

[cmcmc]

peut être quelque chose comme

Code :

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

1
2
3
4
5
6
7
Taisha:~/perl/forum $ perl -0054 -nE '($e, $i, $n) = (eof, m/(\w+);([0-9.]+)/); if ($i ne $pi or $e) { say "$pi:$m" if $pi; ($pi, $m) = ($i, $n) } else { $m = $n if $n > $m }' datain
id1:12.7
id2:6.5
id3:7.8
id4:15.6
id1:1.5
Taisha:~/perl/forum $

update : non, le code ci-dessus ne fonctionne pas (la dernière ligne de résultat est incorrecte...)

[david0o]

Bonjour !

Déjà, merci à tous pour le coup de main.

Philou67430 :
Effectivement, j'aurais pu (dû) préciser. En l’occurrence, les ids sont des identifiants d'accessions Uniprot : K2C1_HUMAN, TRY3_HUMAN, SHRM3_HUMAN... il n'y a donc pas de suite logique.

Lolo78 :
J'ai peut être loupé un truc, mais si $old_id n'est jamais redéfini, alors ce code se contera d'afficher toutes les valeurs. Mais je vois l'idée.

cmcmc :
J'ai utilisé ta première solution (et ne me suis pas penché sur les deux autres), qui fonctionne nickel. Un peu réadapté car le csv ne contient pas que ces deux données, et je veux récupérer une partie des autres. Le fait de rendre faux le if $pi, et donc de ne pas afficher les données à la première itération du while, provoque un décalage avec les lignes du csv.
Au final, c'est lourd/pas très propre (la façon dont je l'ai adapté), mais c'est fonctionnel :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
while (<@csv>) {
	@data = split(";", $_);
	($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi) = ($data[3], $data[2], $data[4], $data[22], $data[8], $data[11]);
	if ($id ne $pi) {
		push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n" if $pi;
		($prot_desc_prev, $pi, $prot_score_prev, $m, $prot_sequences_prev, $prot_pi_prev) = ($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi);
 
		}
	else {
		($prot_desc_prev, $prot_score_prev, $m, $prot_sequences_prev, $prot_pi_prev) = ($prot_desc, $prot_score, $ion, $prot_sequences, $prot_pi) if $ion > $m;
 
	}
}
push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n";

[cmcmc]

Bonjour !
cmcmc :
J'ai utilisé ta première solution (et ne me suis pas penché sur les deux autres), qui fonctionne nickel. Un peu réadapté car le csv ne contient pas que ces deux données, et je veux récupérer une partie des autres. Le fait de rendre faux le if $pi, et donc de ne pas afficher les données à la première itération du while, provoque un décalage avec les lignes du csv.
Au final, c'est lourd/pas très propre (la façon dont je l'ai adapté), mais c'est fonctionnel :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
while (<@csv>) {
	@data = split(";", $_);
	($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi) = ($data[3], $data[2], $data[4], $data[22], $data[8], $data[11]);
	if ($id ne $pi) {
		push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n" if $pi;
		($prot_desc_prev, $pi, $prot_score_prev, $m, $prot_sequences_prev, $prot_pi_prev) = ($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi);
 
		}
	else {
		($prot_desc_prev, $prot_score_prev, $m, $prot_sequences_prev, $prot_pi_prev) = ($prot_desc, $prot_score, $ion, $prot_sequences, $prot_pi) if $ion > $m;
 
	}
}
push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n";

Quelques remarques et questions :

Qu'est ce que c'est que ce @csv ?

Tu n'utilises @data que comme résultat du split; C'est inutile : tu peux remplacer

Code :

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

1
2
        @data = split(";", $_);
	($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi) = ($data[3], $data[2], $data[4], $data[22], $data[8], $data[11]);

par un tranchage (slice) direct du résultat du split, comme suit

Code :

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

        ($prot_desc, $id, $prot_score, $ion, $prot_sequences, $prot_pi) = (split ";" )[3,2,4,22,8,11];

Plus fondamentalement, l'algorithme opère réellement sur un concept de paire [id, valeur]. Le problème que je vois ici est que tu veux véhiculer d'autres informations. est-ce que $prot_desc, $prot_score, $prot_sequences et $prot_pi sont constants à l'intérieur d'un groupe de même $id ? Si non c'est embêtant car le résultat va dépendre de l'ordre des lignes à l'intérieur d'un groupe, ce qui paraît malsain... Si oui, alors tu peux simplifier ton else en

Code :

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

1
2
3
	else {
		$m = $ion if $ion > $m;
	}

ensuite, est-il vraiment important que $m apparaisse au milieu de la ligne produite ? S'il pouvait apparaître à la fin alors tu pourrais opérer directement sur un id composite construit comme suit : "$prot_desc;$id;$prot_score;$prot_sequences;$prot_pi" (en supposant toujours que $prot_desc, $prot_score, $prot_sequences et $prot_pi soient constants au sein d'un groupe).

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
my $pi = "";
my $m;
while (<@csv>) {
	my ($ion, @idc) = (split ";")[22,3,2,4,8,11];
	my $id = join ";", @idc;
	if ($id ne $pi) {
		push @csv_best, "$id;$m\n" if $pi;
		($pi, $m) = ($id, $ion);
		}
	else {
		$m = $ion if $ion > $m;
	}
}
push @csv_best, "$id;$m\n";

Incidemment, je ne vois pas l'intérêt de rajouter "\n" dans les lignes produites.

[Lolo78]

Lolo78 :
J'ai peut être loupé un truc, mais si $old_id n'est jamais redéfini, alors ce code se contera d'afficher toutes les valeurs. Mais je vois l'idée.

Effectivement, il devait y avoir une mise à jour de la variable $old_id, sans doute dans la branche else du if, pour détecter les changements de séquence, mais elle s'est perdue en route.

[cmcmc]

Une manière d'encapsuler l'algorithme est de créer une fonction bog ("best of group") 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
Taisha:~/perl/forum $ cat bog.pl
sub bog {
    my ($reader, $writer) = @_;
    my @group;
    while (my @item = $reader->()) {
        if (!@group or $item[0] ne $group[0]) {
            $writer->(@group) if @group;
            @group = @item;
        } else {
            $group[1] = $item[1] if $item[1] > $group[1];
        }
    }
    $writer->(@group) if @group;
}
Taisha:~/perl/forum $

(Normalement on ferait les choses bien, avec un beau module. Là j'ai la flemme et je l'isole juste dans un fichier pour pouvoir l'utiliser facilement via do "bog.pl" dans les unilignes ci-dessous.)

On reconnaît l'algorithme vu précédemment. La différence est qu'on opère directement sur le groupe en cours de construction via la liste @group, et sur l'élément courant via la liste @item. Ces listes ont (au minimum) deux éléments, l'id et la valeur.

Mais que sont $reader et $writer? D'après son utilisation dans la ligne 5 ci-dessus, $reader est une fonction sans arguments qui est censée fournir à chaque invocation l'item suivant, ou une liste vide lorsque les données sont épuisées. De même, d'après son utilisation dans les lignes 10 et 13 ci-dessus, $writer est une fonction qui fait quelque chose de non spécifié avec ses paramètres.

Avant de les voir en action préparons des données de test.

Code :

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

1
2
3
Taisha:~/perl/forum $ cat l.pl
@l = map { [split /;/] } qw(id1;3.2 id1;12.7 id1;2 id2;1.2 id2;6.5 id3;7.8 id3;0.5 id4;15.6 id1;1.5 id1;9.3);
Taisha:~/perl/forum $

là encore on isole cette préparation dans un fichier séparé pour pouvoir l'utiliser facilement via do "l.pl" dans les unilignes ci-dessous.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Taisha:~/perl/forum $ perl -MData::Dump -E 'do "l.pl"; dd @l'
(
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 1.2],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 1.5],
  ["id1", 9.3],
)
Taisha:~/perl/forum $

on voit que @l est une liste de paires [id, valeur].

Pour utiliser notre fonction bog sur cette liste, il suffit de choisir une fonction $reader adaptée :

Code :

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

1
2
3
4
5
6
7
Taisha:~/perl/forum $ perl -E 'do "bog.pl"; do "l.pl"; bog( sub { @{ shift @l } }, sub { say "@_" } )'
id1 12.7
id2 6.5
id3 7.8
id4 15.6
id1 9.3
Taisha:~/perl/forum $

que ce passe-t-il ? Ici on passe en paramètres à bog deux fonctions anonymes : un reader sub { @{ shift @l } } et un writer sub { say "@_" }. Le reader consomme à chaque invocation un élément de la liste @l par shift @l, transforme cet élément de référence-à-paire en une liste de deux éléments par @{ ... }, et retourne cette liste; lorsque @l est épuisée il retourne la liste vide. Le writer formate ses paramètres d'appel sur stdout.

Si on veut changer le formatage il suffit de modifier le writer :

Code :

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

1
2
3
4
5
6
7
Taisha:~/perl/forum $ perl -E 'do "bog.pl"; do "l.pl"; bog( sub { @{shift @l} }, sub { say join(";", @_) } )'
id1;12.7
id2;6.5
id3;7.8
id4;15.6
id1;9.3
Taisha:~/perl/forum $

Et si on veut collecter les résultats dans une liste au lieu de les formater sur stdout

Code :

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

1
2
3
4
5
6
7
8
9
Taisha:~/perl/forum $ perl -MData::Dump -E 'do "bog.pl"; do "l.pl"; my @best; bog( sub { @{shift @l} }, sub { push @best, [@_] } ); dd @best'
(
  ["id1", 12.7],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id4", 15.6],
  ["id1", 9.3],
)
Taisha:~/perl/forum $

Cela répond à mon inquiétude précédente, qui était liée au fait que l'algorithme impose en pratique deux points de production de résultats. En utilisant une fonction pour cela, on gagne énormément de flexibilité tout en évitant toute duplication de code.

De même, le fait d'utiliser une fonction pour lire les items ajoute beaucoup de flexibilité. Si au lieu de travailler à partir d'une liste d'items en mémoire on veut traiter un fichier d'entrée, à raison d'une ligne par item, tel que par exemple

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Taisha:~/perl/forum $ perl -E 'do "l.pl"; say "@$_" for @l' 
id1 3.2
id1 12.7
id1 2
id2 1.2
id2 6.5
id3 7.8
id3 0.5
id4 15.6
id1 1.5
id1 9.3
Taisha:~/perl/forum $

eh bien il suffit là aussi d'utiliser une fonction reader adaptée :

Code :

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

1
2
3
4
5
6
7
Taisha:~/perl/forum $ perl -E 'do "l.pl"; say "@$_" for @l' | perl -E 'do "bog.pl"; bog( sub { $_ = <>; chomp; split }, sub { say "@_" } )'
id1 12.7
id2 6.5
id3 7.8
id4 15.6
id1 9.3
Taisha:~/perl/forum $

En particulier, il est parfaitement possible de travailler à partir de données extraites d'un csv, même avec des données supplémentaires (moyennant les risques évoqués précédemment). Tout ce que l'algorithme impose, c'est que l'id et la valeur soient les premiers éléments de la liste produite par $reader, par exemple (non testé) :

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
open my $csv, ....; 
my @csv_best; 
 
sub csv_reader {
    $_ = <$csv>;
    s/[\r\n]*$//;
    # renvoie (id, ion, prot_desc, prot_score, prot_sequences, prot_pi)
    (split /;/)[2, 22, 3, 4, 8, 11]
}
 
sub csv_best_writer {
    # génère "prot_desc;id;prot_score;max;prot_sequences;prot_pi\n"
    push @csv_best, join(";", @_[2,0,3,1,4,5]) . "\n"
}
 
bog(csv_reader, csv_best_writer);

Magique, non ?

[Lolo78]

Magique, je ne sais pas, mais malin et adroit, sans aucun doute.

Ce n'est certainement pas moi qui vais critiquer l'utilisation de fonctions de rappel et de fonctions d'itération, mais je trouve en l'occurrence tout de même plus simple, surtout pour quelqu'un qui n'utilise pas trop Perl, de traiter directement les données:

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
23
24
25
26
27
28
use strict;
use warnings;
use List::Util qw(max);
 
my @l = (
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 1.2],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 1.5],
  ["id1", 9.3],
);
 
my @pair = my @max_pair = @{shift @l};
while (@pair) {
	if ($pair[0] eq $max_pair[0]) {
		@max_pair = @pair if $pair[1] > $max_pair[1];	
	} else {
		print "@max_pair \n";
		@max_pair = @pair;
	}
	@pair = @{shift @l} and next if @l;
	print "@max_pair \n"; last;
}

Sinon, on peut aussi créer un itérateur en bonne et due forme (ou, plus exactement, une fonction renvoyant un itérateur) afin de lire les données en entrée et de renvoyer pour chaque identifiant une liste de valeurs. Cet itérateur pourrait en principe servir à faire d'autres choses sur des données ayant ce type de format. Par exemple, pour le début des données:

Code :

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

1
2
3
4
 
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],

il renverrait la structure de données suivante:

Code :

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

1
2
 
("id1", [3.2, 12.7, 2])

à charge pour le programme appelant d'utiliser ces données restructurées.

Cet itérateur pourrait avoir la forme suivante:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
sub create_iter {
	my @a = @_;
	my @b = ($a[0][0], [ $a[0][1] ]);
	return sub {
		while (1) {
			do { my @ret_val = @b; @b = ();  return @ret_val;} unless @a;
			my @c = @{shift @a}; 
			do { my @ret_val = @b; @b = ($c[0], [$c[1]]); return @ret_val;} if $c[0] ne $b[0];
			push @{$b[1]}, $c[1] and next if $c[0] eq $b[0];			
		}
	}
}

ou encore, autre solution assez proche:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
sub create_iter2 {
	my @a = (@_, [-1, -1]);
	my @b = ("",[]);
	return sub {
		while (@a) {
			my @c = @{shift @a}; 
			do { my @ret_val = @b; @b = ($c[0], [$c[1]]); return @ret_val if $ret_val[0];} if $c[0] ne $b[0];
			push @{$b[1]}, $c[1] and next if $c[0] eq $b[0];			
		}
		return;
	}
}

Il doit sans doute y avoir moyen de faire plus simple, mais j'ai déjà passé une bonne heure là-dessus, je n'ai plus trop maintenant le temps d'essayer d'affiner ces solutions (qui ont été testées et qui marchent au moins avec ces données de test).

Pour utiliser l'un ou l'autre de ces itérateurs:

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
 
use strict;
use warnings;
use List::Util qw(max);
 
my @l = (
  # ...
);
 
my $get_ref = create_iter(@l); # ou : my $get_ref = create_iter2(@l);
 
while (my @d = $get_ref->()) {
	last unless @d;
	my $max = max (@{$d[1]});
	print "$d[0], $max \n";
}

(Note: je ne prétends aucunement que cette solution soit meilleure, je voulais juste illustrer une autre approche.)

[cmcmc]

Prenons un peu de champ. Par rapport à la solution initiale, on a bien progressé avec la fonction bog : on peut opérer sur une séquence arbitraire (et non pas uniquement un tableau, une liste ou un fichier), et on fait ce qu'on veut des résultats produits. Cependant on a câblé en dur le fonctionnement de l'algorithme : on calcule forcément un max... De plus la perspective de véhiculer des données additionnelles, et l'inconfort mentionné à ce sujet précédemment (que se passe-t-il si ces données ne sont pas constantes à l'intérieur d'un groupe ?) poussent à réfléchir plus avant.

En fait le problème sous-jacent est d'effectuer des réductions au sein de groupes d'items consécutifs dans une séquence : une combinaison de partition de la séquence d'entrée, et de réduction sur les parties ainsi isolées, le tout à la volée. Ne peut-on pas généraliser la réduction effectuée ? Par exemple, prendre le min, ou la moyenne ? Voire, calculer simultanément plusieurs réductions distinctes ?

On peut :

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
Taisha:~/perl/forum $ cat pr.pl
sub pr {
    my ($reader, $writer, $starter, $combiner, $cloner) = @_;
    my $group;
    while (my $item = $reader->()) {
        if (!defined($group) or $starter->($group, $item)) {
            $writer->($group) if defined($group);
            $group = $cloner ? $cloner->($item) : $item;
        } else {
            $combiner->($group, $item);
        }
    }
    $writer->($group) if defined($group);
}
Taisha:~/perl/forum $

$starter permet de décider quand démarrer un nouveau groupe, et $combiner permet de faire évoluer le représentant du groupe en fonction de l'item courant.

par exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Taisha:~/perl/forum $ perl -E 'do "pr.pl"; do "l.pl";
pr( sub { shift @l },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_; $group->[1] = $item->[1] if $item->[1] > $group->[1] }
    );'
id1 12.7
id2 6.5
id3 7.8
id4 15.6
id1 9.3
Taisha:~/perl/forum $

Ici on a reproduit exactement le fonctionnement précédent.

Dans bog, on travaillait sur un représentant du goupe et un item représentés tous les deux sous forme de listes. Pourquoi est-on passé à de simples références ? Parce que cela permet potentiellement de gérer plus efficacement des items volumineux (par exemple une liste de plusieurs centaines d'attributs), ou des items objet (au sens perl, c'est à dire des références blessed).

Cela pose cependant le problème de l'initialisation de $group lors de la création d'un nouveau groupe. L'affectation de références n'est pas une duplication de contenu. Si on initialise par $group = $item alors les modifications ultérieures de $group modifieront directement $item puisque puisque $group et $item référencent la même entité. Ce n'est pas un problème si les items produit par le reader sont effectivement consommables. Ci-dessus le reader est sub { shift @l }, qui consomme destructivement la liste @l. Pas de problème. Mais imaginons qu'on veuille réutiliser @l plus tard, et donc que le reader traverse la liste sans la modifier, renvoyant à chaque itération un alias sur un élément de la liste, comme par exemple

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Taisha:~/perl/forum $ perl -MData::Dump -E 'do "pr.pl";
do "l.pl";
my $lpos;
dd @l;
pr( sub { $lpos < @l ? $l[$lpos++] : undef },
    sub { say "@{$_[0]}" },
    sub { $_[0][0] ne $_[1][0] },
    sub { $_[0][1] = $_[1][1] if $_[1][1] > $_[0][1] }
    );
dd @l;'    
(
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 1.2],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 1.5],
  ["id1", 9.3],
)
id1 12.7
id2 6.5
id3 7.8
id4 15.6
id1 9.3
(
  ["id1", 12.7],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 6.5],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 9.3],
  ["id1", 9.3],
)
Taisha:~/perl/forum $ perl -E 'do "pr.pl";

On voit que les altérations apportées à $group ont modifié certains éléments de la liste d'origine, ce qui n'était probablement pas désiré. On peut s'en sortir de deux manières : soit faire en sorte que le reader produise systématiquement des clones des éléments de la liste d'origine, soit cloner explicitement l'item lors de l'initialisation de $group. Il n'y a pas de solution générale adaptée à tous les cas (par exemple, ce serait un gaspillage de cloner systématiquement à l'intérieur du reader, si la séquence traitée contenait très peu de groupes de grande taille).

C'est pour cela que $cloner existe, et est optionnel. Seul l'utilisateur peut décider s'il est nécessaire, et si c'est le cas le coder de manière appropriée (ici par exemple on pourrait utiliser sub { my $item = shift; [ @$item ] }).

Maintenant, on peut faire plein de choses marrantes en jouant avec $reader, $combiner et $writer. Par exemple, compter le nombre d’éléments de chaque groupe : pour cela il suffit d'ajouter dans le reader un champ initialisé à 1 pour chaque item, et faire la somme dans $combiner :

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { @l ? [@{shift @l}, 1] : undef },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += $item->[2] }
    );
'
id1 12.7 3
id2 6.5 2
id3 7.8 2
id4 15.6 1
id1 9.3 2
Taisha:~/perl/forum $

On peut aussi calculer la somme des éléments de chaque groupe, en dupliquant la valeur dans $reader, et en sommant dans $combiner

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { return unless @l; @x = @{shift @l}; [@x, 1, $x[-1]] },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += $item->[2];
	  $group->[3] += $item->[3];
	  }
    );
'
id1 12.7 3 17.9
id2 6.5 2 7.7
id3 7.8 2 8.3
id4 15.6 1 15.6
id1 9.3 2 10.8
Taisha:~/perl/forum $

et si on veut on peut maintenant calculer la moyenne pour chaque groupe, en adaptant cette fois $writer :

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { return unless @l; my @x = @{shift @l}; [@x, 1, $x[-1]] },
    sub { my $group = shift; push @$group, $group->[-1]/$group->[-2]; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += $item->[2];
	  $group->[3] += $item->[3];
	  }
    );
'
id1 12.7 3 17.9 5.96666666666667
id2 6.5 2 7.7 3.85
id3 7.8 2 8.3 4.15
id4 15.6 1 15.6 15.6
id1 9.3 2 10.8 5.4
Taisha:~/perl/forum $

pas mal pour des calculs à la volée qui ne gardent en mémoire qu'un item (enrichi) et le représentant du groupe courant...

On voit que dans le cas d'un csv avec plusieurs champs à conserver on n'aurait pas de difficultés à calculer en parallèle des réductions ou statistiques sur plusieurs de ces champs. The sky's the limit

Bon, j'espère que vous avez apprécié le voyage... A ce stade je ne vois plus trop quelles améliorations apporter. Vos idées, appréciations et commentaires sont les bienvenus

P.S.: j'essaie systématiquement de présenter du code opérationnel, et ce même code en action. Pour des raisons de place j'ai du coup tendance à coder de manière compacte, opérationnelle mais pas forcément facile à lire... Si certaines constructions ou fragments de codes ne sont pas clairs n'hésitez pas à poser des questions!

[cmcmc]

Sinon, on peut aussi créer un itérateur en bonne et due forme (ou, plus exactement, une fonction renvoyant un itérateur) afin de lire les données en entrée et de renvoyer pour chaque identifiant une liste de valeurs. Cet itérateur pourrait en principe servir à faire d'autres choses sur des données ayant ce type de format. Par exemple, pour le début des données:

Code :

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

1
2
3
4
 
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],

il renverrait la structure de données suivante:

Code :

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

1
2
 
("id1", [3.2, 12.7, 2])

à charge pour le programme appelant d'utiliser ces données restructurées.

Certes. Cependant cette approche (que l'on utilise un itérateur ou pas) revient à séparer les opérations de partitionnement (en groupes d'items consécutifs de même id) d'une part, et de réduction d'autre part. C'est conceptuellement équivalent à

Code :

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

@résultat = map { réduction } map { partitionnement} @données

Cette séparation a un coût en mémoire puisqu'on constitue chaque groupe avant de le réduire. Au mieux la consommation mémoire est proportionnelle à la taille du groupe le plus grand. Dans le cas extrême d'un jeu de données comportant un seul groupe, on est obligé de charger l'intégralité des données en mémoire.

C'est certainement envisageable dans certaines problématiques. Il est intéressant de noter que dans la solution pr (ou bog) la consommation mémoire est indépendante de la taille du jeu de données d'entrée pour des réductions simples (min, max, somme, ...) que l'on peut calculer à la volée.

Certaines statistiques exigent qu'on dispose de l'intégralité du jeu de données sur lesquelles on les calcule. Contrairement à ce qu'on pourrait croire, ce n'est pas le cas pour la moyenne, comme on l'a vu, pour laquelle on peut ruser en séparant le travail entre $reader, $combine et $writer. On peut utiliser une astuce comparable pour la variance (laissé à titre d'exercice). C'est bien le cas pour le calcul de la médiane par contre, pour lequel on est bien obligé de constituer l'ensemble de la série. On peut là encore le faire au sein des fonctions d'appel. Dans le cas d'items comportant plusieurs attributs, l'impact en mémoire est limité au(x) seul(s) attribut(s) pour lesquels on la calcule.

[cmcmc]

Maintenant, on peut faire plein de choses marrantes en jouant avec $reader, $combiner et $writer. Par exemple, compter le nombre d’éléments de chaque groupe : pour cela il suffit d'ajouter dans le reader un champ initialisé à 1 pour chaque item, et faire la somme dans $combiner :

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { @l ? [@{shift @l}, 1] : undef },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += $item->[2] }
    );
'
id1 12.7 3
id2 6.5 2
id3 7.8 2
id4 15.6 1
id1 9.3 2
Taisha:~/perl/forum $

On peut aussi calculer la somme des éléments de chaque groupe, en dupliquant la valeur dans $reader, et en sommant dans $combiner

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { return unless @l; @x = @{shift @l}; [@x, 1, $x[-1]] },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += $item->[2];
	  $group->[3] += $item->[3];
	  }
    );
'
id1 12.7 3 17.9
id2 6.5 2 7.7
id3 7.8 2 8.3
id4 15.6 1 15.6
id1 9.3 2 10.8
Taisha:~/perl/forum $

En fait, il est plus efficace (et peut être plus clair et plus robuste) d'utiliser $cloner que $reader pour enrichir les items.

Pour un comptage simple on peut incrémenter directement dans $combiner:

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { shift @l },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += 1;
	},
    sub { my $item = shift;
          [@$item, 1]
	}
    )
'
id1 12.7 3
id2 6.5 2
id3 7.8 2
id4 15.6 1
id1 9.3 2
Taisha:~/perl/forum $

Pour la somme :

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
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { shift @l },
    sub { my $group = shift; say "@$group" },
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += 1;
	  $group->[3] += $item->[1];
	},
    sub { my $item = shift;
          [@$item, 1, $item->[1]]
	}
    )
'
id1 12.7 3 17.9
id2 6.5 2 7.7
id3 7.8 2 8.3
id4 15.6 1 15.6
id1 9.3 2 10.8
Taisha:~/perl/forum $

Pour le calcul de la médiane on peut utiliser quelque chose du type

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
23
24
25
Taisha:~/perl/forum $ perl -E 'do "pr.pl";
do "l.pl";
pr( sub { shift @l },
    sub { my $group = shift;
	  my $med = (sort { $a <=> $b} @{$group->[4]})[$group->[2]/2];
	  say "id: $group->[0], max: $group->[1], cnt: $group->[2], sum: $group->[3], vals: [@{$group->[4]}], median: $med";
	},
    sub { my ($group, $item) = @_; $group->[0] ne $item->[0] },
    sub { my ($group, $item) = @_;
          $group->[1] = $item->[1] if $item->[1] > $group->[1];
	  $group->[2] += 1;
	  $group->[3] += $item->[1];
	  push @{$group->[4]}, $item->[1];
	},
    sub { my $item = shift;
          [@$item, 1, $item->[1], [$item->[1]]]
	}
    )
'
id: id1, max: 12.7, cnt: 3, sum: 17.9, vals: [3.2 12.7 2], median: 3.2
id: id2, max: 6.5, cnt: 2, sum: 7.7, vals: [1.2 6.5], median: 6.5
id: id3, max: 7.8, cnt: 2, sum: 8.3, vals: [7.8 0.5], median: 7.8
id: id4, max: 15.6, cnt: 1, sum: 15.6, vals: [15.6], median: 15.6
id: id1, max: 9.3, cnt: 2, sum: 10.8, vals: [1.5 9.3], median: 9.3
Taisha:~/perl/forum $

[Lolo78]

Certes. Cependant cette approche (que l'on utilise un itérateur ou pas) revient à séparer les opérations de partitionnement (en groupes d'items consécutifs de même id) d'une part, et de réduction d'autre part. C'est conceptuellement équivalent à

Code :

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

@résultat = map { réduction } map { partitionnement} @données

Cette séparation a un coût en mémoire puisqu'on constitue chaque groupe avant de le réduire. Au mieux la consommation mémoire est proportionnelle à la taille du groupe le plus grand. Dans le cas extrême d'un jeu de données comportant un seul groupe, on est obligé de charger l'intégralité des données en mémoire.

Le but était de simplifier les données (mettre ensemble toutes les valeurs pour un ID) et de gérer dans l'itérateur peut-être réutilisable pour d'autres choses les ruptures de séquences (assez casse-pieds à gérer). C'est un choix assumé.

Le coût mémoire est a priori faible car on ne traite qu'un ID à la fois. Bien sûr, les données peuvent théoriquement avoir une forme pathologique, mais même dans ce cas, le coût reste assez limité, car on a éliminé la redondance de données associée à la répétition des ID. Et le coût reste bien inférieur à un:

Code :

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

1
2
 
@résultat = map { réduction } map { partitionnement} @données

qui crée sous le capot trois tableaux de données, alors que l'itérateur ne traite dans un cas normal (non pathologique) qu'une petite partie des données à la fois.

Maintenant, on peut aussi faire un itérateur qui renvoie les éléments de données en entrée un par un, accompagnés le cas échéant d'une information indiquant que la donnée courante est la dernière d'une séquence (ou la dernière de toutes). Ici, un tableau à 2 éléments pour les cas à l'intérieur d'une séquence, et à trois éléments en cas de fin de séquence:

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
23
 
sub create_iter3 {
	my @a = @_;
	my @previous = @{shift @a};
	return sub {
		return (@previous, 2) unless @a;
		my @b = @{shift @a};
		my @ret_val = $previous[0] eq $b[0] ? @previous : (@previous, 1);
		@previous = @b;
		return @ret_val;
	}
}			
 
my $get_ref = create_iter3(@l);
my $max = -2**31;
while (my @d = $get_ref->()) {
	$max = $d[1] if $d[1] > $max;
	if (@d > 2) {
		print "$d[0] : $max \n";
		last if $d[2] == 2;
		$max = -2**31;
	}
}

NB: il y a dans ce code des valeurs numériques codées en dur que je mettrais normalement plutôt dans des constantes, mais c'est juste un exemple simple d'algo possible et fonctionnel, pas du code de production. Cela imprime:

Code :

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

1
2
3
4
5
6
 
id1 : 12.7
id2 : 6.5
id3 : 7.8
id4 : 15.6
id1 : 9.3

ce qui paraît correct.

Le calcul de la moyenne ne me paraît poser aucune difficulté:

Code :

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

1
2
3
4
5
6
7
8
9
while (my @d = $get_ref->()) {
	$cumul += $d[1];
	$nb_el++;
	if (@d > 2) {
		print "$d[0] : ", $cumul/$nb_el, "\n";
		last if $d[2] == 2;
		$cumul = $nb_el = 0;
	}
}

Ce qui affiche:

Code :

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

1
2
3
4
5
6
 
id1 : 5.96666666666667
id2 : 3.85
id3 : 4.15
id4 : 15.6
id1 : 5.4

ce qui paraît correct (un printf au lieu d'un print améliorerait l'affichage, mais bon, ce n'est pas vraiment le sujet.).

Aucune difficulté, donc, pour la moyenne. Calculer la variance (ou l'écart-type) à la volée est tout aussi possible, mais juste un peu chouïa plus pénible, puisqu'il faut a priori maintenir plusieurs cumuls au lieu d'un seul, et développer correctement la formule classique de la variance. Rien de rédhibitoire cependant. Mais la réorganisation des données par séquences que j'avais proposée antérieurement permettait de résoudre ces problèmes (et aussi celui de la médiane, etc.) plus simplement dans la mesure où elle mettait d'entrée de jeu les données sous la forme d'un tableau par séquence.

Tout cela étant dit, utiliser des fonctions de rappel, des générateurs de fonctions, des fermetures ou des itérateurs ou autres bestioles du même acabit, c'est super si l'on va créer un module ou une bibliothèque de fonctions, en sorte d'étendre en quelque sorte le langage, et ce n'est pas moi qui vais critiquer après avoir écrit un tuto en 150 pages sur le sujet (et si critique il y avait, elle serait adressée à moi autant qu'à toi), mais c'est peut-être un peu de l'"overkill" ou de l'"over-engineering" pour le cas simple de la question d'origine. Le cahier des charges demande une série de max, pas plus, doit-on vraiment chercher à calculer la moyenne, la variance, l'écart-type, le khi² et que sais-je encore, ou même seulement se préparer à le faire? Pas sûr.

En définitive, le choix de la meilleure façon de faire dépend surtout des autres opérations que l'on voudra éventuellement faire sur les données. Et le post d'origine n'en demandait finalement pas tant.

[cmcmc]

Le but était de simplifier les données (mettre ensemble toutes les valeurs pour un ID) et de gérer dans l'itérateur peut-être réutilisable pour d'autres choses les ruptures de séquences (assez casse-pieds à gérer). C'est un choix assumé.

Le coût mémoire est a priori faible car on ne traite qu'un ID à la fois. Bien sûr, les données peuvent théoriquement avoir une forme pathologique, mais même dans ce cas, le coût reste assez limité, car on a éliminé la redondance de données associée à la répétition des ID.

Le gain associé à la factorisation des ID est limité. Au mieux on gagne 50% sur la taille d'un item. La consommation mémoire est bien en O(taille_du_plus_grand_groupe), donc parler d'un coût mémoire a priori faible ne me semble pas avoir de sens.

Maintenant, on peut aussi faire un itérateur qui renvoie les éléments de données en entrée un par un, accompagnés le cas échéant d'une information indiquant que la donnée courante est la dernière d'une séquence (ou la dernière de toutes). Ici, un tableau à 2 éléments pour les cas à l'intérieur d'une séquence, et à trois éléments en cas de fin de séquence:

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
23
 
sub create_iter3 {
	my @a = @_;
	my @previous = @{shift @a};
	return sub {
		return (@previous, 2) unless @a;
		my @b = @{shift @a};
		my @ret_val = $previous[0] eq $b[0] ? @previous : (@previous, 1);
		@previous = @b;
		return @ret_val;
	}
}			
 
my $get_ref = create_iter3(@l);
my $max = -2**31;
while (my @d = $get_ref->()) {
	$max = $d[1] if $d[1] > $max;
	if (@d > 2) {
		print "$d[0] : $max \n";
		last if $d[2] == 2;
		$max = -2**31;
	}
}

NB: il y a dans ce code des valeurs numériques codées en dur que je mettrais normalement plutôt dans des constantes, mais c'est juste un exemple simple d'algo possible et fonctionnel, pas du code de production.

L'idée est intéressante. A priori il y a quelques petits trucs qui me gênent, comme la copie en ligne 3 ci-dessus, ou la nécessité d'initialiser $max (ce qui ne s'est jamais avéré necessaire dans les différentes incarnations de ma solution). Je serais curieux de voir son implémentation en "code de production".

Aucune difficulté, donc, pour la moyenne. Calculer la variance (ou l'écart-type) à la volée est tout aussi possible, mais juste un peu chouïa plus pénible, puisqu'il faut a priori maintenir plusieurs cumuls au lieu d'un seul, et développer correctement la formule classique de la variance. Rien de rédhibitoire cependant. Mais la réorganisation des données par séquences que j'avais proposée antérieurement permettait de résoudre ces problèmes (et aussi celui de la médiane, etc.) plus simplement dans la mesure où elle mettait d'entrée de jeu les données sous la forme d'un tableau par séquence.

La variante pr (que tu n'avais peut-être pas vue) permet la constitution si nécessaire de la liste des valeurs d'un ou plusieurs attributs, comme démontré pour le calcul de la médiane. Ce qui est intéressant, c'est que c'est une option. Si aucune réduction ou statistique calculée ne le demande, on peut atteindre une consommation mémoire minimale (constante : un item et le représentant du groupe, au lieu de O(taille_du_plus_grand_groupe)).

Tout cela étant dit, utiliser des fonctions de rappel, des générateurs de fonctions, des fermetures ou des itérateurs ou autres bestioles du même acabit, c'est super si l'on va créer un module ou une bibliothèque de fonctions ...

C'est exactement ce que je suis en train de faire. La technique do "pr.pl"; est réminiscente de la manière dont on gérait ce type de librairies dans les toutes premières versions de perl. Et il est très probable qu'une incarnation de pr intègre ma propre librairie d'algorithmes. Le codage ci-dessus de pr est dans mon esprit quasi définitif : je ne vois rien à ajouter ou enlever. Je vais probablement rebaptiser $cloner en $builder, et il me reste un petit doute sur le fait de maintenir son caractère optionnel. Je vais laisser décanter un peu.

... mais c'est peut-être un peu de l'"overkill" ou de l'"over-engineering" pour le cas simple de la question d'origine.

La (première) question d'origine, à savoir le calcul du max, est résolue depuis longtemps, au moins au point de vue strictement algorithmique, et le demandeur s'est approprié la solution.

Je rappelle cependant que j'avais immédiatement émis des réserves sur cette solution, à cause de la duplication du code d'émission du résultat :

...if ($i ne $pi) { say "$pi:$m" if $pi; ($pi, $m) = ($i, $n) } else { $m = $n if $n > $m }} say "$pi:$m"

car s'il y a quelque chose que j'ai retenu de mes décennies de codage c'est bien l'importance de l'exigence cardinale de ne pas dupliquer de code (DRY : don't repeat yourself) car toute duplication de code est potentiellement un cauchemar de maintenance.

Et franchement la manière dont le demandeur s'est initialement approprié la solution (en reconnaissant qu'il n'a pas codé de manière très propre ) me conforte dans cette position :

...
		push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n" if $pi;
	...
push @csv_best, "$prot_desc_prev;$pi;$prot_score_prev;$m;$prot_sequences_prev;$prot_pi_prev\n";

Si la duplication de mon malheureux say "$pi:$m" me causait de l'inconfort , on peut imaginer ce que ces deux lignes m'inspirent

Alors je suis peut-être obsédé par la qualité logicielle mais pour moi c'est un problème sérieux. Et qui à défaut de meilleure solution justifie amplement l'introduction d'un writer. Ce n'est pas de l'over-engineering, c'est une stratégie de survie.

Le cahier des charges demande une série de max, pas plus,

Pas tout à fait. Le demandeur a indiqué plus tard dans le fil qu'il voulait véhiculer d'autres attributs du groupe. J'ai montré qu'on pouvait le faire proprement avec bog et un reader et writer adaptés.

Le fait de devoir véhiculer d'autres attributs pose cependant des questions : que se passe-t-il si les attributs additionnels ne sont pas constants pour un même id ? A moins d'accepter un comportement potentiellement semi-aléatoire de l'opérateur, on doit considérer des réductions appropriées pour chaque attribut variable. C'est ce qui m'a amené à proposer la généralisation de bog en pr.

doit-on vraiment chercher à calculer la moyenne, la variance, l'écart-type, le khi² et que sais-je encore, ou même seulement se préparer à le faire? Pas sûr.

Se préparer, à mon avis oui, pour la raison que je viens d'évoquer. J'ai montré que pr permet un calcul à la volée de statistiques (moyenne, variance) pour un coût mémoire constant ce qui n'est pas forcément intuitif. J'ai montré également que pr se prétait également à la collecte sélective d'attributs pour lesquels on avait besoin de la série complète (cas de la médiane).

En définitive, le choix de la meilleure façon de faire dépend surtout des autres opérations que l'on voudra éventuellement faire sur les données. Et le post d'origine n'en demandait finalement pas tant.

C'est vrai et j'aurais pu me limiter à la solution initiale et laisser le demandeur s'en débrouiller. J'avoue qu'étant donné les efforts fournis pour expliciter la démarche, montrer les dangers, justifier en détails l'implémentation, fournir des exemples, analyser le comportement en termes d'occupation mémoire, etc... le fait que personne ne se soit donné la peine de qualifier ce fil d'intéressant, ou (à part peut-être le demandeur initial) de ces contributions, est assez décourageant .

[cmcmc]

Pendant que j'y pense:

...Mais imaginons qu'on veuille réutiliser @l plus tard, et donc que le reader traverse la liste sans la modifier, renvoyant à chaque itération un alias sur un élément de la liste, comme par exemple

Code :

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

1
2
3
4
5
6
Taisha:~/perl/forum $ perl -MData::Dump -E 'do "pr.pl";
do "l.pl";
my $lpos;
dd @l;
pr( sub { $lpos < @l ? $l[$lpos++] : undef },
    ...

la séparation de la déclaration my $lpos; de la définition du reader qui l'utilise sub { $lpos < @l ? $l[$lpos++] : undef } est à la fois inélégante et un peu dangereuse. Une meilleure manière de procéder est de rapprocher cette déclaration de son utilisation :

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Taisha:~/perl/forum $ perl -MData::Dump -E 'do "pr.pl";
do "l.pl";
dd @l;
pr( do { my $lpos; sub { $lpos < @l ? $l[$lpos++] : undef } },
    sub { say "@{$_[0]}" },
    sub { $_[0][0] ne $_[1][0] },
    sub { $_[0][1] = $_[1][1] if $_[1][1] > $_[0][1] }
    );
dd @l;'
(
  ["id1", 3.2],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 1.2],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 1.5],
  ["id1", 9.3],
)
id1 12.7
id2 6.5
id3 7.8
id4 15.6
id1 9.3
(
  ["id1", 12.7],
  ["id1", 12.7],
  ["id1", 2],
  ["id2", 6.5],
  ["id2", 6.5],
  ["id3", 7.8],
  ["id3", 0.5],
  ["id4", 15.6],
  ["id1", 9.3],
  ["id1", 9.3],
)
Taisha:~/perl/forum $

L'expression do { my $lpos; sub { $lpos < @l ? $l[$lpos++] : undef } } est une fermeture (closure). do { ... } est une expression, pouvant contenir plusieurs instructions et qui renvoie le résultat de l'évaluation de la dernière, ici notre reader anonyme. L'intérêt est que maintenant $lpos est "local" à la fonction anonyme retournée. On pourrait par exemple utiliser en parallèle plusieurs readers ainsi générés, sans risque d'interférence entre eux.

[david0o]

Vindiou !
Je pensais pas que ma petite question provoquerai autant de réflexion !
Désolé, j'ai pas le trop le temps de tout décortiquer tout de suite (je travail en alternance, et là faut que je passe à tout autre chose, mais j'y reviendrai). En tout cas je suis épaté !
J'ai bien l'impression que cela dépasse (largement) mon niveau, et comme le dit Lolo78, je n'en demandais pas tant. Ce que j'ai me suffit (pour l'instant...).
J'ose espérer trouver le temps de comprendre tout ça ceci dit.