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
| sub triage{
my ($mots,$termes,$valeursMots)=@_;#$mots est un arrayref, $termes est un href qui va contenir des arrays et valeursMots est un hashref
foreach my $mot(@$mots){#pour chaque mot du arrayref mots
my $present = -1;
my @k = (sort keys %$termes); #termes est un hashref qui contiendra des arrays, chaque key est le nom d'un tableau
if(@k>0){#si %$termes non vide
foreach my $terme(sort keys %$termes){#pour chaque mot on compare aux keys du hashref termes
if($mot eq $terme){ #si le mot = la clé
if(exists($valeursMots->{$mot})) {# si le hashref contient déjà une clé $mot
$valeursMots->{$mot}+=1;#on ajoute la paire ($mot=>1) au hashref valeursMots au hashref
}
else{
$valeursMots->{$mot}=1;#on ajoute la paire ($mot=>1) au hashref valeursMots au hashref
}
foreach my $mot2(@$mots){#on construit l'arbre du cluster présent
if($mot2 ne $mot){
push @{ $termes{$mot} }, $mot2;#$mot est un array contenu dans le hashref termes
}
}
$present = 1;
warn "present";
}
unless($present == 1){
foreach my $mot2(@$mots){#on construit l'arbre du cluster absent
my @tab;
if($mot2 ne $mot){
my $motPresent2 = -1;
foreach my $mot5 ($termes->{$mot}){# on parcourt le array $mot
if($mot2 eq $mot5){# si mot2 est présent dans le tableau
$motPresent2 = 1;#on met le marqueur à 1
}
}
if ($motPresent2 == -1){#si mot2 etait absent
push @{ $termes{$mot} }, $mot2;# on ajoute $mot2 au array mot contenu dans le hashref termes
}
}
push @{ $termes{$mot} }, $mot2;# on ajoute
}
warn "absent";
}
}
}
else{
%{$termes->{$mot}}= ();
foreach my $mot2(@$mots){#on construit l'arbre du cluster présent
if($mot2 ne $mot){
my $motPresent = -1;
foreach my $mot4(@%{$termes->{$mot}}){# on parcourt le array $mot
if($mot2 eq $mot4){
$motPresent = 1;
}
}
if ($motPresent == -1){
push @{ $termes{$mot} }, $mot2;# on ajoute $mot2 au array mot contenu dans le hashref termes
}
}
}
warn "premier déjà construit";
}
}
croak( Dumper(\@mots, \%termes, \%valeursMots));
} |
Partager