Discussion :

[sequoia]

Bonjour,

je voudrais comparer 2 chaines de caracteres et en extraire les similitudes et les différences.

par exemple :

Code :

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

1
2
$chaine1 = "ma toute premiere chaine ";
$chaine2 = "ma deuxieme chaine ";

me renverrait idéalement :

Code :

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

1
2
3
@similitudes = (ma,chaine)                     # commun entre chaine 1 et chaine2
@difference_chaine1 = (toute,premiere)   #ce qui est ajouté à la chaine 1
@difference_chaine2 = (deuxième)          #ce qui est ajouté à la chaine 2

Connaissez-vous une méthode pour faire ça ?

Merci d'avance !

[Lolo78]

Bonjour,

tu veux faire l'analyse par mots entiers, ou aussi par morceaux de mots?

Et l'ordre des mots est-il important?

[sequoia]

Bonjour,

Effectivement, mieux vaut préciser : l'ordre n'est pas important.

1) Je pensais à l'origine travailler sur les mots entiers (plus simple !) . En fait, l'idée c'est que si je compare des chaines telles que :

chaine 1 = "ou globules blancs"
chaine 2 = "globules blancs"
chaine 3 = "globules"

correspondant à la définition de "leucocytes",

je vois que "globules " et "blancs" apparaissent 2 fois ensemble, donc je supprime la troisième chaine car je la considère incomplète.

Après, en comparant les chaines 1 et 2, sachant que le mot "ou" n'est pas porteur d'information ça me donnera "leucocytes = globules blancs".

2) Si je pouvais découper les mots en préfixes/suffixes ce serait encore mieux, mais la mise en oeuvre me semble bien plus complexe.

Dans ce cas, pour la définition "arthrite =

chaine 1 = inflammation des articulations
chaine 2 = = inflammation articulatoire
chaine 3 = inflammation"

Ici je pourrais considérer que chaine 1 = chaine 2 (de simples variantes puisque les 2 sont correctes, rien n'est manquant ni superflu) en partant du principe que je peux substituer un déterminant + nom (articul-ation) par un adjectif (articul-atoire) formé sur le même préfixe que le nom.

J'espère que c'est assez clair

[BufferBob]

salut,

je me lance, c'est sans doute pas optimum mais ça fonctionne comme décrit plus haut (c'est surtout histoire de manip un peu perl le vendredi matin ) :

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
use Data::Dumper;
 
my $chaine1 = "ma toute premiere chaine";
my $chaine2 = "ma deuxieme chaine";
 
my @tab1 = split / /, $chaine1;
my @tab2 = split / /, $chaine2;
my ($s1, $s2, $diff1, $diff2);
my (@similitudes, @differences_chaine1, @differences_chaine2);
 
if (@tab1 < @tab2) { # on se base sur la chaine la plus courte
        ($s1, $s2, $diff1, $diff2) = (\@tab1, \@tab2, \@differences_chaine1, \@differences_chaine2);
} else {
        ($s1, $s2, $diff1, $diff2) = (\@tab2, \@tab1, \@differences_chaine2, \@differences_chaine1);
}
 
foreach my $i (@{$s1}) {       # pour chaque mot de la chaine la plus courte
   if (grep /^$i$/, @{$s2}) {  # si il existe dans l'autre chaine
      push @similitudes, $i;   # on l'ajoute aux similitudes
   } else {
      push @{$diff1}, $i;      # sinon aux differences de la chaine la plus courte
   }
}
 
foreach my $j (@{$s2}) {              # pour chaque mot de la chaine la plus longue
   if (! grep /^$j$/, @similitudes) { # si il n'est pas dans les similitudes
      push @{$diff2}, $j;             # c'est qu'il est dans les differences de la chaine la plus longue
   }
}
 
print "=== similitudes : ===\n" . Dumper \@similitudes;
print "=== differences chaine1 : ===\n" . Dumper \@differences_chaine1;
print "=== differences chaine2 : ===\n" . Dumper \@differences_chaine2;

et l'exécution :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
=== similitudes : ===
$VAR1 = [
          'ma',
          'chaine'
        ];
=== differences chaine1 : ===
$VAR1 = [
          'toute',
          'premiere'
        ];
=== differences chaine2 : ===
$VAR1 = [
          'deuxieme'
        ];

[sequoia]

Super,

Merci BufferBob ça va me permettre d'avancer.

Juste une dernière question : s'il y a plus de 2 chaines à comparer, plutôt que comparer chaque tableau par 2 par 2, est-ce qu'on peut faire un truc du genre :

Code :

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

@pluspetitechaine = ????? (@tab1,@tab2,@tab3,...)

Bonne journée

[disedorgue]

Bonjour,
Une solution similaire avec des hash:

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
use Data::Dumper;
 
my $chaine1 = "ma toute premiere chaine";
my $chaine2 = "ma deuxieme chaine";
my %similitudes;
my %hash1,%hash2;
my $var1,$var2;
$hash1{$_}=1 foreach (split / /, $chaine1);
$hash2{$_}=1 foreach (split / /, $chaine2);
($var1,$var2) = keys (%hash1) > keys %hash2 ? (\%hash1,\%hash2) : (\%hash2,\%hash1);
 
foreach (keys %$var1){
        if($$var2{$_} == 1){
                $similitudes{$_}=1;
                delete $hash1{$_};
                delete $hash2{$_};
        }
}
 
print "=== similitudes : ===\n" . Dumper \%similitudes;
print "=== differences chaine1 : ===\n" . Dumper \%hash1;
print "=== differences chaine2 : ===\n" . Dumper \%hash2;

Ce qui donne à l'execution:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
=== similitudes : ===
$VAR1 = {
          'chaine' => 1,
          'ma' => 1
        };
=== differences chaine1 : ===
$VAR1 = {
          'premiere' => 1,
          'toute' => 1
        };
=== differences chaine2 : ===
$VAR1 = {
          'deuxieme' => 1
        };

[Lolo78]

Nonjour,

j'utiliserais aussi des hachages, mais un peu différemment:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
use strict; use warnings;
 
my $chaine1 = "ma toute premiere chaine";
my $chaine2 = "ma deuxieme chaine";
my %words1 = map { $_ => 1 } split / /, $chaine1;
my %words2 = map { $_ => 1 } split / /, $chaine2;
 
my @similitudes = grep { exists $words1{$_} } keys %words2;
my @diff1 = grep { not exists $words1{$_} } keys %words2;
my @diff2 = grep { not exists $words2{$_} } keys %words1;
 
print "Similitudes: @similitudes \n";
print "Diff 1: @diff1 \n"; 
print "Diff 2: @diff2 \n";

Ce qui imprime:

Code :

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

1
2
3
4
 
Similitudes: chaine ma
Diff 1: deuxieme
Diff 2: premiere toute

[disedorgue]

Eh ben, j'ai encore des progrès à faire...

Voici tout de même ma version corrigée qui devrait en principe être plus rapide par rapport à ma première 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
use strict;
use warnings;
use utf8;
 
use Data::Dumper;
 
my $chaine1 = "ma toute premiere chaine";
my $chaine2 = "ma deuxieme chaine";
my (%similitudes,%diff1,%diff2);
%diff1= map { $_ => 1 } (split / /, $chaine1);
foreach (split / /,$chaine2){
   if(not exists $similitudes{$_}){
       if(exists $diff1{$_}){
           $similitudes{$_}=1;
           delete $diff1{$_};
       }
       else{
           $diff2{$_}=1;
       }
   }
}
 
print "=== similitudes : ===\n" . Dumper \%similitudes;
print "=== differences chaine1 : ===\n" . Dumper \%diff1;
print "=== differences chaine2 : ===\n" . Dumper \%diff2;

[Philou67430]

La question initiale semble faire appel à des notions de linguistique. Peut-être que les propositions faites gagnerons à utiliser un module CPAN linguistique (avec la locale positionnée à FR), comme par exemple Lingua::Stem.

Une autre approche, en utilisant le module WordNet::Similarity (mais j'ai peur que même s'il existe une base de donnée pour le français, le Wolf, elle ne soit pas accessible depuis ce module).

On pourrait aussi s'inspirer de la distance de Levenshtein : Levenshtein::Distance