Discussion :

[cobaltsixty]

Bonjour à toutes et à tous,

Je me suis mis à Perl il y a maintenant deux mois et j'ai quelques difficultés pour résoudre le problème suivant.
Voici mes données de départ (stockées dans un tableau):

show_1_5min 0 164 show_1_5min-0.00-1.64-F0-M-S0
show_1_5min 692 945 show_1_5min-6.92-9.45-F0-M-S1
show_1_5min 945 1736 show_1_5min-9.45-17.36-F0-M-S1
show_1_5min 1736 2537 show_1_5min-17.36-25.37-F0-M-S1
show_1_5min 2537 4187 show_1_5min-25.37-41.87-F0-M-S1
show_1_5min 4187 4748 show_1_5min-41.87-47.48-F0-M-S1
show_1_5min 4748 6354 show_1_5min-47.48-63.54-F0-M-S1
show_1_5min 6491 8258 show_1_5min-64.91-82.58-F0-M-S1
show_1_5min 8258 9440 show_1_5min-82.58-94.40-F0-M-S1
show_1_5min 9440 11123 show_1_5min-94.40-111.23-F0-M-S1
show_1_5min 11123 11459 show_1_5min-111.23-114.59-F0-M-S16
show_1_5min 11671 13438 show_1_5min-116.71-134.38-F0-M-S16
show_1_5min 13440 13906 show_1_5min-134.40-139.06-F0-M-S16
show_1_5min 13913 14951 show_1_5min-139.13-149.51-F0-M-S16
show_1_5min 14965 16004 show_1_5min-149.65-160.04-F0-M-S16
show_1_5min 16004 17918 show_1_5min-160.04-179.18-F0-M-S1
show_1_5min 17918 18901 show_1_5min-179.18-189.01-F0-M-S1
show_1_5min 18901 20389 show_1_5min-189.01-203.89-F2-M-S27
show_1_5min 20389 21806 show_1_5min-203.89-218.06-F2-M-S27
show_1_5min 21806 22796 show_1_5min-218.06-227.96-F2-M-S27
show_1_5min 22796 24324 show_1_5min-227.96-243.24-F2-M-S27
show_1_5min 24324 24847 show_1_5min-243.24-248.47-F2-M-S27
show_1_5min 24847 26162 show_1_5min-248.47-261.62-F0-M-S1
show_1_5min 26162 27060 show_1_5min-261.62-270.60-F0-M-S1
show_1_5min 27060 28064 show_1_5min-270.60-280.64-F0-M-S1
show_1_5min 28064 29198 show_1_5min-280.64-291.98-F0-M-S1
show_1_5min 29209 29998 show_1_5min-292.09-299.98-F0-M-S46


Les éléments en couleur (uniquement sur la première ligne pour l'exmple) représentent respectivement le début et la fin d'un intervalle temporel, le dernier est un identifiant de locuteur. Je procède à l'extraction de ces éléments grâce à des regexp pour produire les scalaires correspondants: $debut, $fin, $locuteur.

Mon problème est le suivant. Les exemples en vert montrent qu'à $locuteur identique, il y a des intervales redondants (donc superflus) dans le sens où le début d'un segment correspond à la fin du précédent. Je souhaiterais fusionner ces segments en un seul, le plus large possible (toujours à locuteur constant, si ce dernier change, alors pas de fusion).

Comment faire ?
Je suis un peu perdu et j'ai monté une usine à gaz avec un fichier temporaire.
Il doit y avoir une solution plus simple.

Merci d'avance

[Philou67430]

Une idée d'algorithme :
- utiliser une table de hashage pour stocker des tableaux d'intervalles pour chaque locuteur
- ordonner chaque tableau de locuteur selon la valeur numérique du début
- réduire ensuite chaque tableau à l'aide de la fonction reduce du module List::Util

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#!/usr/bin/perl
 
use strict;
use warnings;
use 5.10.0;
 
use List::Util qw(reduce);
 
# Lire et ranger les données dans une table de hashage
my %locuteurs = ();
while (my $line = <DATA>) {
  if (my ($debut, $fin, $locuteur) = $line =~ /min-([\d\.]+)-([\d\.]+)-.*-([\w\d]+)$/) {
    push @{$locuteurs{$locuteur}}, [ $debut, $fin ];
  }
}
 
# Ordonner numériquement les intervalles pour chaque locuteur et les réduire
foreach my $interval (values %locuteurs) {
  if (@$interval > 1) {
    # Tri des intervalles
    @$interval = sort { $a->[0] <=> $b->[0] } @$interval;
 
    # Réduire les intervalles
    my $reduce = reduce {
      # First call
      if (ref($a) && !ref($a->[0])) {
        $a = [ $a ];
      }
 
      if ($a->[-1]->[1] == $b->[0]) {
        my $last = pop @$a;
        [ @$a, [ $last->[0], $b->[1] ] ];
      }
      else {
        [ @$a, $b ];
      }
    } @$interval;
    @$interval = @$reduce;
  }
}
 
# Affichage
foreach my $locuteur (sort keys %locuteurs) {
  say "$locuteur:";
  say "\t$_->[0] => $_->[1]" foreach @{$locuteurs{$locuteur}};
}
 
__DATA__
show_1_5min 0 164 show_1_5min-0.00-1.64-F0-M-S0
show_1_5min 692 945 show_1_5min-6.92-9.45-F0-M-S1
show_1_5min 945 1736 show_1_5min-9.45-17.36-F0-M-S1
show_1_5min 1736 2537 show_1_5min-17.36-25.37-F0-M-S1
show_1_5min 2537 4187 show_1_5min-25.37-41.87-F0-M-S1
show_1_5min 4187 4748 show_1_5min-41.87-47.48-F0-M-S1
show_1_5min 4748 6354 show_1_5min-47.48-63.54-F0-M-S1
show_1_5min 6491 8258 show_1_5min-64.91-82.58-F0-M-S1
show_1_5min 8258 9440 show_1_5min-82.58-94.40-F0-M-S1
show_1_5min 9440 11123 show_1_5min-94.40-111.23-F0-M-S1
show_1_5min 11123 11459 show_1_5min-111.23-114.59-F0-M-S16
show_1_5min 11671 13438 show_1_5min-116.71-134.38-F0-M-S16
show_1_5min 13440 13906 show_1_5min-134.40-139.06-F0-M-S16
show_1_5min 13913 14951 show_1_5min-139.13-149.51-F0-M-S16
show_1_5min 14965 16004 show_1_5min-149.65-160.04-F0-M-S16
show_1_5min 16004 17918 show_1_5min-160.04-179.18-F0-M-S1
show_1_5min 17918 18901 show_1_5min-179.18-189.01-F0-M-S1
show_1_5min 18901 20389 show_1_5min-189.01-203.89-F2-M-S27
show_1_5min 20389 21806 show_1_5min-203.89-218.06-F2-M-S27
show_1_5min 21806 22796 show_1_5min-218.06-227.96-F2-M-S27
show_1_5min 22796 24324 show_1_5min-227.96-243.24-F2-M-S27
show_1_5min 24324 24847 show_1_5min-243.24-248.47-F2-M-S27
show_1_5min 24847 26162 show_1_5min-248.47-261.62-F0-M-S1
show_1_5min 26162 27060 show_1_5min-261.62-270.60-F0-M-S1
show_1_5min 27060 28064 show_1_5min-270.60-280.64-F0-M-S1
show_1_5min 28064 29198 show_1_5min-280.64-291.98-F0-M-S1
show_1_5min 29209 29998 show_1_5min-292.09-299.98-F0-M-S46

La solution avec reduce peut être complexe à comprendre. En effet, reduce est sensée retourner à chaque traitement d'un nouvel élément d'une liste, un seul élément en sortie. Pour permettre de sortir une liste, j'utilise donc une tableau anonyme que je remplis au fur et à mesure que l'on traite les éléments de la liste d'intervalle. Ainsi, si la borne supérieure ($a->[-1]->[1]) du dernier élément ($a->[-1]) de la liste en cours (@$a) correspond à la borne inférieur ($b->[0]) de l'élément à traiter ($b), on merge. Sinon, on ajoute simplement l'élément en cours à la liste en cours.

Pour le premier appel à la code de reduce, il faut faire en sorte que $a devienne une liste d'intervalle (car lors du premier appel, $a est le premier élément de la liste à traiter, donc un intervalle, pas une liste d'intervalle). Pour cela on réaffecte $a à un tableau anonyme ne contenant que $a ($a = [ $a ]).

Si tu as d'autres questions, n'hésite pas, ce code n'est pas du code de débutant, et il peut rebuter, à cause de l'usage intensif des références anonymes.

[cobaltsixty]

Merci Philou
C'est très gentil d'avoir bien voulu conceptualiser le problème et d'avoir proposé une solution.
J'avoue qu'il me faut un peu de temps pour digérer la solution. Je reviens dès que c'est fait.

[cobaltsixty]

Une idée d'algorithme :
- utiliser une table de hashage pour stocker des tableaux d'intervalles pour chaque locuteur
- ordonner chaque tableau de locuteur selon la valeur numérique du début
- réduire ensuite chaque tableau à l'aide de la fonction reduce du module List::Util

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#!/usr/bin/perl
 
use strict;
use warnings;
use 5.10.0;
 
use List::Util qw(reduce);
 
# Lire et ranger les données dans une table de hashage
my %locuteurs = ();
while (my $line = <DATA>) {
  if (my ($debut, $fin, $locuteur) = $line =~ /min-([\d\.]+)-([\d\.]+)-.*-([\w\d]+)$/) {
    push @{$locuteurs{$locuteur}}, [ $debut, $fin ];
  }
}
 
# Ordonner numériquement les intervalles pour chaque locuteur et les réduire
foreach my $interval (values %locuteurs) {
  if (@$interval > 1) {
    # Tri des intervalles
    @$interval = sort { $a->[0] <=> $b->[0] } @$interval;
 
    # Réduire les intervalles
    my $reduce = reduce {
      # First call
      if (ref($a) && !ref($a->[0])) {
        $a = [ $a ];
      }
 
      if ($a->[-1]->[1] == $b->[0]) {
        my $last = pop @$a;
        [ @$a, [ $last->[0], $b->[1] ] ];
      }
      else {
        [ @$a, $b ];
      }
    } @$interval;
    @$interval = @$reduce;
  }
}
 
# Affichage
foreach my $locuteur (sort keys %locuteurs) {
  say "$locuteur:";
  say "\t$_->[0] => $_->[1]" foreach @{$locuteurs{$locuteur}};
}
 
__DATA__
show_1_5min 0 164 show_1_5min-0.00-1.64-F0-M-S0
show_1_5min 692 945 show_1_5min-6.92-9.45-F0-M-S1
show_1_5min 945 1736 show_1_5min-9.45-17.36-F0-M-S1
show_1_5min 1736 2537 show_1_5min-17.36-25.37-F0-M-S1
show_1_5min 2537 4187 show_1_5min-25.37-41.87-F0-M-S1
show_1_5min 4187 4748 show_1_5min-41.87-47.48-F0-M-S1
show_1_5min 4748 6354 show_1_5min-47.48-63.54-F0-M-S1
show_1_5min 6491 8258 show_1_5min-64.91-82.58-F0-M-S1
show_1_5min 8258 9440 show_1_5min-82.58-94.40-F0-M-S1
show_1_5min 9440 11123 show_1_5min-94.40-111.23-F0-M-S1
show_1_5min 11123 11459 show_1_5min-111.23-114.59-F0-M-S16
show_1_5min 11671 13438 show_1_5min-116.71-134.38-F0-M-S16
show_1_5min 13440 13906 show_1_5min-134.40-139.06-F0-M-S16
show_1_5min 13913 14951 show_1_5min-139.13-149.51-F0-M-S16
show_1_5min 14965 16004 show_1_5min-149.65-160.04-F0-M-S16
show_1_5min 16004 17918 show_1_5min-160.04-179.18-F0-M-S1
show_1_5min 17918 18901 show_1_5min-179.18-189.01-F0-M-S1
show_1_5min 18901 20389 show_1_5min-189.01-203.89-F2-M-S27
show_1_5min 20389 21806 show_1_5min-203.89-218.06-F2-M-S27
show_1_5min 21806 22796 show_1_5min-218.06-227.96-F2-M-S27
show_1_5min 22796 24324 show_1_5min-227.96-243.24-F2-M-S27
show_1_5min 24324 24847 show_1_5min-243.24-248.47-F2-M-S27
show_1_5min 24847 26162 show_1_5min-248.47-261.62-F0-M-S1
show_1_5min 26162 27060 show_1_5min-261.62-270.60-F0-M-S1
show_1_5min 27060 28064 show_1_5min-270.60-280.64-F0-M-S1
show_1_5min 28064 29198 show_1_5min-280.64-291.98-F0-M-S1
show_1_5min 29209 29998 show_1_5min-292.09-299.98-F0-M-S46

La solution avec reduce peut être complexe à comprendre. En effet, reduce est sensée retourner à chaque traitement d'un nouvel élément d'une liste, un seul élément en sortie. Pour permettre de sortir une liste, j'utilise donc une tableau anonyme que je remplis au fur et à mesure que l'on traite les éléments de la liste d'intervalle. Ainsi, si la borne supérieure ($a->[-1]->[1]) du dernier élément ($a->[-1]) de la liste en cours (@$a) correspond à la borne inférieur ($b->[0]) de l'élément à traiter ($b), on merge. Sinon, on ajoute simplement l'élément en cours à la liste en cours.

Pour le premier appel à la code de reduce, il faut faire en sorte que $a devienne une liste d'intervalle (car lors du premier appel, $a est le premier élément de la liste à traiter, donc un intervalle, pas une liste d'intervalle). Pour cela on réaffecte $a à un tableau anonyme ne contenant que $a ($a = [ $a ]).

Si tu as d'autres questions, n'hésite pas, ce code n'est pas du code de débutant, et il peut rebuter, à cause de l'usage intensif des références anonymes.

Merci encore pour ton aide Philou mais c'est un peu trop compliqué pour moi et je n'ai pas le temps d'envisager Perl autrement que comme un outil. Nul doute que je finirais pas intégrer ton développement.
J'ai résolu mon problème par moi-même, ce n'est peut-être pas le plus propre mais bon, voici mon code.
Commentaires bien venus

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
41
42
43
44
45
46
47
48
49
 
#!/usr/bin/perl
 
# -------------------- SUPRESSION DE LA SURSEGMENTATION ------------------------------
 
# Extraction des champs utiles et tri par chronologie croissante -> tableau
my @table = `awk --field-separator=- '{print \"\"\$2\";\"\$3\";\"\$6\"\"}' show_1_5min.seg | sort -nk 1`;
my $nseg = scalar(@table); 
my @table_out;
 
print "----- sortie brute ---- \n";
print @table;
 
$i = 0;
while ($i <= $nseg)
{
	($debutA,$finA,$locuteurA) = ($table[$i] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/); 
	($debutB,$finB,$locuteurB) = ($table[$i+1] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/);
 
	# pas de fusion
	if (($finA != $debutB)||($locuteurA ne $locuteurB)){
# 		print $debutA.";".$finA.";".$locuteurA."\n";
		push(@table_out, $debutA.";".$finA.";".$locuteurA."\n");
		$i = $i + 1;
	}
 
	# fusion
	else{
		$debut_temp = $debutA;
		$locuteur_temp = $locuteurA;
 
		while (($finA == $debutB) && ($locuteurA eq $locuteurB) && ($i <= $nseg)){
			($debutA,$finA,$locuteurA) = ($table[$i] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/); 
			($debutB,$finB,$locuteurB) = ($table[$i+1] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/);
			$i = $i + 1;
		}
 
		$i = $i - 1;
		($debutB,$finB,$locuteurB) = ($table[$i] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/);
# 		print $debut_temp.";".$finB.";".$locuteur_temp."\n";
		push(@table_out, $debut_temp.";".$finB.";".$locuteur_temp."\n");	
		$i = $i + 1;
	}
}
 
pop(@table_out);
 
print "----- traitement de la sursegmentation termine ----- \n";
print @table_out;

Voici la sortie:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
----- traitement de la sursegmentation termine -----
0.00;1.64;S0
6.92;63.54;S1
64.91;111.23;S1
111.23;114.59;S16
116.71;134.38;S16
134.40;139.06;S16
139.13;149.51;S16
149.65;160.04;S16
160.04;189.01;S1
189.01;248.47;S27
248.47;291.98;S1
292.09;299.98;S46

[Philou67430]

Si tu ajoutes

Code :

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

1
2
3
 
use strict;
use warnings;

outre le fait de devoir déclarer toutes les variables par my (comme par exemple $i), tu devrais voir au moins un bug dans ton programme :

Code :

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

while ($i <= $nseg)

$nseg étant égal à la taille de la table, l'index maximum est $nseg-1.
Qui plus est, tu ne peux boucler que jusqu'à l'avant dernier élément de la table, puisque c'est le dernier pour lequel tu pourras tester qu'il est "contiguë" au suivant (le dernier de la table).

Il faut donc écrire la boucle ainsi :

Code :

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

while ($i < $nseg-1)

Ensuite, je te conseille fortement (notamment pour la portabilité) de remplacer

Code :

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

my @table = `awk --field-separator=- '{print \"\"\$2\";\"\$3\";\"\$6\"\"}' show_1_5min.seg | sort -nk 1`

par son équivalent en perl.

Soit normalement :

Code :

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

1
2
3
my $show_file = "show_1_5min.seg";
open my $SHOW, "<", $show_file or die "Can't open $show_file for reading: $!\n";
my @table = map { join ";", @$_ } sort { $a->[0] <=> $b->[0] } map { chomp; [ (split /-/, $_)[1,2,5] ] } <$SHOW>;

Décomposons :
<$SHOW> appelé par map { ... } (le plus à droite) est évalué dans un contexte de liste et retourne donc la totalité du fichier.
Celui-ci est traité par le map le plus à droit pour en extraire les champs 2, 3 et 6 (indices 1, 2, et 5 du split). Ce map retourne alors une liste de références de tableau qui est traité par le sort (de manière numérique croissante sur le premier élément du tableau).
Enfin, le dernier map réassemble les 3 éléments avec des ; (cette étape peut devenir inutile si le reste du script est adapté à traiter une liste de tableau au lieu d'une liste de lignes de texte contenant des colonnes séparées par un ;.
En supprimant ce dernier map (celui de gauche), il faudrait simplifier les lignes suivantes :

Code :

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

1
2
($debutA,$finA,$locuteurA) = ($table[$i] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/); 
	($debutB,$finB,$locuteurB) = ($table[$i+1] =~ m/(\d+\.\d+);(\d+\.\d+);(\w+\d+)/);

par

Code :

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

1
2
($debutA,$finA,$locuteurA) = @$table[$i]; 
	($debutB,$finB,$locuteurB) = @$table[$i+1];

On peut tout aussi remplacer l'usage de $finA par $table[$i]->[1] et $debutB par $table[$i+1]->[0] (pour ne parler que d'eux).