Discussion :

[Lolo78]

Bonjour,

j'ai fait trois nouvelles versions successives du script, seule la dernière est réellement pertinente, mais je donne les deux autres parce qu'elles donnent des informations intéressantes.

La première est une modification assez faible de la dernière que j'avais postée, mais en corrigeant le problème de l'ordre des substitutions pour les séquences de plus de deux mots ainsi que l'autre bug signalé par Philou (la phrase "une+déclaration de+la+commission+sur ses+objectifs stratégiques" au lieu de " une+déclaration de+la+commission sur+ses objectifs+stratégiques"). Je conserve pour l'instant deux hashes: un pour les paires de mots et un pour les séquences plus longues. Je ne donne ici que les deux boucles principales de lecture du dictionnaire et du fichier:

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
# Itération sur les lignes du dictionnaire
while (my $line = <$DICO>) {
  chomp($line);
  $line =~ s/\s+/ /g;
  $line =~ s/^\s+//g;
  $line =~ s/\s+$//g;
  my @temp = split / /, $line, 4;
  if (@temp > 2) { 
	  my $end_sequence = "";
	  my $key = join " ",  @temp[0,1,2];
	  $end_sequence = $temp[3] if defined $temp[3];
	  # les trois premiers mots peuvent conduire à plusieurs séquences, il faut retenir chaque séquence avec son ordre
	  push @{$long_dico{$key}}, [$., $end_sequence]; 
	  next;
  }
  $dico{$line} = $.;
}
close $DICO;
 
open my $IN, "<", $in or die "Can't open $in for reading: $!\n";
my @word;
my $start = time; 
# Itération sur les lignes du fichier d'entrée
while (my $line = <$IN>) {
	$line =~ s/\s+/ /g; # remarque: chomp inutile car cette substitution élimine le retour à la ligne
	$line =~ s/\s$//g;
	my @words = split /\s/, $line;
	my $max = scalar @words - 3;
	my %substitutions_possibles;
	# itération pour des séquences de trois mots ou plus
	foreach my $i (0..$max) {
		my $key = "@words[$i,$i+1,$i+2]";
		next unless defined $long_dico{$key};
		foreach my $seq_list (@{$long_dico{$key}}) {
			my ($priority, $end_seq) = @$seq_list;
			my $pattern = "$key $end_seq";
			next unless ($line =~ /$pattern/);
			# Si on est arrivé ici, la substitution est possible, on stocke cette possibilité
			$substitutions_possibles{$priority} = $pattern;
		}
	}
	foreach my $key (sort { $a <=> $b } keys %substitutions_possibles) {
		my $pattern = $substitutions_possibles{$key};
		next unless $line =~ / $pattern / or $line =~ /^$pattern / or $line =~ / $pattern$/ or $line =~ /^$pattern$/;
		my $pattern_out = $pattern;
		$pattern_out =~ s/ /+/g;
		$line =~ s/$pattern/$pattern_out/g;
	}
 
	# Etablir la liste des substitutions de paires à envisager sur cette ligne
	my %substitutions;
	@words = split /\s/, $line;
	$max = scalar @words - 2;
	foreach my $i (0..$max) {
		my $key = "@words[$i,$i+1]";
		if (exists $dico{$key}) {
			my $remplacement = join "+", @words[$i,$i+1];
			push @{$substitutions{$dico{$key}}}, [$remplacement, $i, $i+1];
		}
	}
	my %sub_faite;
	foreach my $sub (sort {$a <=> $b} keys %substitutions) { # tri des remplacements par ordrede priorité
		foreach my $paire (@{$substitutions{$sub}}) { # plusieurs replacements possibles pour une même paire de mots
			my ($new, $rank1, $rank2) = @{$paire};
			next if defined $sub_faite{$rank1} or defined $sub_faite{$rank2}; # une substitution a déjà été faite sur l'un des mots
			$sub_faite{$rank1} = 1;
			$sub_faite{$rank2} = 1;
			$words [$rank1] = $new; # on remplace le premier mot par la paire de mots joints par un "+"
			$words [$rank2] = undef; # le second mot sera éliminé ultérieurement par le grep
		}
	}
	my $line_out = join " ", grep {defined } @words, "\n";
	print $OUT $line_out;
}

Dans les mêmes conditions que précédemment, j'obtiens une durée d'exécution de 301 secondes (donc un peu moins rapide que la dernière version, mais ça reste très raisonnable). Cependant, comme on le verra plus bas, la ligne 44 de ce programme est très mauvaise au niveau des performances (elle ne m'a pas gêné dans mon test parce que je n'avais que trois séquences longues de plus de deux mots, mais ce serait très mauvais qu'il y avait beaucoup de séquences longues).

Je pense qu'avoir deux hashes peut, dans certains cas (selon le dictionnaire utilisé), accélérer le travail, mais en l'absence de connaissances réelles sur le dictionnaire, il m'a paru plus intéressant de refaire l'algorithme avec un seul hash, ce qui rend le code nettement plus compact.

Voici donc cette deuxième version.

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
# Itération sur les lignes du dictionnaire
while (my $line = <$DICO>) {
  chomp($line);
  $line =~ s/\s+/ /g;
  $line =~ s/^\s+//g;
  $line =~ s/\s+$//g;
  my @temp = split / /, $line, 3;
  my $end_sequence = "";
  my $key = join " ",  @temp[0,1];
  $end_sequence = $temp[2] if defined $temp[2];
  push @{$dico{$key}}, [$., $end_sequence]; 
}
close $DICO;
 
open my $IN, "<", $in or die "Can't open $in for reading: $!\n";
my @word;
my $start = time; 
# Itération sur les lignes du fichier d'entrée
while (my $line = <$IN>) {
	$line =~ s/\s+/ /g; # remarque: chomp inutile car cette substitution élimine le retour à la ligne
	$line =~ s/\s$//g; # suppression d'espace à la fin de la ligne
	my @words = split /\s/, $line;
	my $max = scalar @words - 2;
	my %substitutions_possibles;
	# itération pour des séquences de deux mots ou plus
	foreach my $i (0..$max) {
		my $key = "@words[$i,$i+1]";
		next unless defined $dico{$key};
		foreach my $seq_list (@{$dico{$key}}) {
			my ($priority, $end_seq) = @$seq_list;
			my $pattern = "$key $end_seq";
			$pattern =~ s/\s+$//; # suppression d'espace à la fin le cas échéant
			next unless ($line =~ /$pattern/);
			# Si on est arrivé ici, la substitution est possible, on stocke cette possibilité
			$substitutions_possibles{$priority} = $pattern;
		}
	}
	foreach my $key (sort { $a <=> $b } keys %substitutions_possibles) {
		my $pattern = $substitutions_possibles{$key};
		next unless $line =~ /(?<!\+)$pattern(?!\+)/;
		my $pattern_out = $pattern;
		$pattern_out =~ s/ /+/g;
		$line =~ s/$pattern/$pattern_out/g;
	}
	print $OUT $line, "\n";
}

Cela marche, mais j'obtiens cette fois une durée d'exécution de 733 secondes.

En fait, une version initiale de ce programme avec quatre tests d'expressions régulières successifs (comme à la ligne 44 du programme 1) au lieu du "next unless $line =~ /(?<!\+)$pattern(?!\+)/;" de la ligne 40 me donnait même presque 1000 secondes.

Conclusion: l'utilisation des expressions régulières pour effectuer les substitutions est beaucoup plus lente que l'utilisation de tableaux de mots comme je l'avais fait dans mes versions antérieures. Philou, c'est peut-être la raison pour laquelle mon script donnait de meilleures perfs que les tiens (mais tu n'as pas montré les tiens, c'est juste une supposition).

Voici donc ma troisième version, revenant à technique précédente des tableaux de mots. Je donne cette fois le script entier pour faciliter d'éventuels tests:

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
76
77
use strict;
use warnings;
use utf8;
use feature qw(:5.10); 
my ($in, $dico_txt) = @ARGV;
die "Bad infile $in" if !-r $in;
die "Bad dicofile $dico_txt" if !-r $dico_txt;
 
# load dico
my %dico;
my $outfile = "outfile.txt";
open my $OUT, ">", $outfile or die "Can't open $outfile $!\n";
open my $DICO, "<", $dico_txt or die "Can't open $dico_txt for reading: $!\n";
# Itération sur les lignes du dictionnaire
while (my $line = <$DICO>) {
  chomp($line);
  $line =~ s/\s+/ /g;
  $line =~ s/^\s+//g;
  $line =~ s/\s+$//g;
  my @temp = split / /, $line, 3;
  my $end_sequence = "";
  my $key = join " ",  @temp[0,1];
  $end_sequence = $temp[2] if defined $temp[2];
  push @{$dico{$key}}, [$., $end_sequence]; 
}
close $DICO;
 
open my $IN, "<", $in or die "Can't open $in for reading: $!\n";
my @word;
my $start = time; 
# Itération sur les lignes du fichier d'entrée
while (my $line = <$IN>) {
	$line =~ s/\s+/ /g; # remarque: chomp inutile car cette substitution élimine le retour à la ligne
	$line =~ s/\s$//g; # suppression d'espace à la fin de la ligne
	my @words = split /\s/, $line;
	my $max = scalar @words - 2;
	my %substitutions_possibles;
	# itération pour des séquences de deux mots ou plus
	foreach my $i (0..$max) {
		my $key = "@words[$i,$i+1]";
		next unless defined $dico{$key};
		foreach my $seq_list (@{$dico{$key}}) {
			my ($priority, $end_seq) = @$seq_list;
			if ($end_seq eq "") {
				push @{$substitutions_possibles{$priority}}, [$key, $i, 2];
				next;
			}
			my @array_end_seq = split / /, $end_seq;
			my $length_seq = scalar @array_end_seq + 2;
			next if $length_seq + $i > $max + 2;
			my $pattern = "$key $end_seq";
			$pattern =~ s/\s+$//; # suppression d'espace à la fin le cas échéant
			next unless "@words[$i..$i+$length_seq-1]" eq $pattern;
			# Si on est arrivé ici, la substitution est possible, on stocke cette possibilité
			push @{$substitutions_possibles{$priority}}, [$pattern, $i, $length_seq];
		}
	}
	my %sub_faite;
	foreach my $key (sort { $a <=> $b } keys %substitutions_possibles) {
		foreach my $substitution (@{$substitutions_possibles{$key}}) {
			my ($pattern, $start_pos, $length) = @{$substitution};
			my $end_pos = $start_pos + $length - 1;
			next if grep {exists $sub_faite{$_}} $start_pos .. $end_pos; # élimination des mots déjà substitués
			$sub_faite{$_} = 1 foreach $start_pos .. $end_pos; # marquage des mots déjà substitués
			my $replacement = $pattern;
			$replacement =~ s/ /+/g;
			$words[$start_pos] = $replacement;
			$words[$_] = undef foreach $start_pos+1..$end_pos;
		}
	}
	my $line_out = join " ", grep {defined } @words, "\n";
	print $OUT $line_out;
}
 
close $OUT; close $IN;
my $duration = time - $start;
print "The programm lasted $duration seconds.\n";

Là, j'arrive à 360 secondes. Moins bon que la première version, mais certainement meilleur s'il y a nettement plus de séquences longues dans le dictionnaire.

[Philou67430]

Je vais intégrer ton nouvel algo (le dernier) avec les miens autres, afin de comparer toutes les versions. Il faudra cependant attendre un dico plus représentatif de la part d'Étoile.

[Philou67430]

Coucou étoile... tu as eu le temps de générer un dico plus représentatif ?

[étoile de mer]

Bonjour
Je reviens sur ce problème ( car je travaillais depuis un bon moment sur un autre)

JE fournis comme vous m'avez demandé deux fichier réels :
http://7iurjp.1fichier.com/
http://yh1kfq.1fichier.com/

Je dois dire que là je teste la 3eme verison sur Lolo a fournis, elle est lente :red: , elle tourne depuis la nuit...
Je ne sais pas si c'est normal ou non

Merci

[Philou67430]

Tu l'as faite tournée sur ces fichiers ?

[Philou67430]

Vue la taille du dictionnaire, et étant donné que les substitutions doivent être effectuées dans l'ordre du dictionnaire, il me semble qu'il est possible d'envisager un script qui traiter le dictionnaire plusieurs fois, par morceaux (par paquet d'un certains nombre de lignes). Le temps d'exécution sera allongé, mais la portion de dictionnaire traitée sera chargé entièrement en mémoire, ce qui n'est pas possible avec le dictionnaire entier (enfin, pas chez moi en tout cas).

[Philou67430]

Mes premiers essais de bench avec les deux scripts de lolo (post 103 et 121), ainsi que mes 7 ou 8 versions ne peuvent pas s'exécuter par manque de mémoire.
Sur des sous-ensembles du dictionnaire, mes premiers essais montrent de très fortes disparité entre les versions, notamment, les algo de lolo, qui étaient optimisés pour des entrées de dictionnaire à peu de mot sont largement dépassés par des algorithmes plus génériques. Hormis le script de lolo du post 103, ils donnent pour l'instant tous des résultats identiques.

Je travaille donc sur de nouvelles versions, notamment une version "par partie", et une version avec un dictionnaire minimaliste en mémoire, et le reste sur disque.

Je posterai des versions lorsqu'elles seront "utilisables".