|
Approche exploratoire de la relation de conséquence : description et implémentation( Télécharger le fichier original )par Sébastien Druon Université Toulouse 2 - DEA de Sciences du Langage 2001 |
Annexe A# !/usr/bin/perl -w ## ## # # # # ################################################################ # Extraction automatique de la relation de conséquence # # # # (c) 2001 Sébastien Duon # #
# # # # # ## ## # variables globales my (@forme, @type, @lemme, @v_etat, @v_changt_etat, %stats) ; my $nbInd = 0; # fonction principale : préparation des fichiers et
appel des fonctions de recherche sub main() { my $total=0;
die "Utilisation :\nperl csq.pl nom _de _fichier _lemmatise.lem [>relations_de_conséquence.txt]\n" if ($#ARGV<0) ; $ARGV[0]=~ /^(.*)\.(.*?)$/; $fic = $1 ; open SRC, "./lib/verbes-etat.lst" or die "Pas de fichier de verbes d'état\n"; @v_etat=<SRC>; chop @v_etat; close SRC; open SRC, "./lib/verbes-changt-etat.lst" or
die "Pas de fichier de verbes de changement d'état\n"; @v_changt_etat=<SRC>; chop @v_changt_etat; close SRC; open LOG, ">$fic.log";
open SRC, $ARGV[0] or die "Il faut spécifier un nom de fichier valide...\n"; print STDERR "Traitement du fichier $ARGV[0]\n"; print STDERR "Préparation du document.. .\n"; my $i=0 ; while (<SRC>) { ($forme[$i], $type[$i], $lemme[$i]) = split '\t' ; $i++; } splice @tmp; close SRC; print STDERR "Recherche des indices... " ; # Connecteurs donc() ; ainsi() ; aussi() ; alors() ; parcons() ; decefait() ; cefaisant() ; ceqfq() ; danscecas() ; pourcr() ; cestpq() ; cestlrpl() ; # Autres indices ppres() ; cequi() ; cecicela() ; syllo() ; close VER; # affichage des statistiques stats() ; } sub stats() { my $total=0; my $totalA=0; my $totalC=0; my $lenmax=0; # calcul du nombre total de marques et de l'étiquette la plus longue foreach $key (sort(keys %statsC)) { $totalC+=$statsC{$key}; $lenmax=($lenmax>length($key)) ?$lenmax length($key); } foreach $key (sort(keys %statsA)) { $totalA+=$statsA{$key}; $lenmax=($lenmax>length($key)) ?$lenmax length($key);
$total = $totalA + $totalC; die "Aucune statistique possible\n" if ($total==0) ; # définition du format du tableau $format = "@".'<' x ($lenmax+1) . "@>>>@>>>>>>%"; eval "format STDERR =\n$format\n".'$nom, $nb, $prc'."\n.\n"; # impression du tableau print STDERR "\n\nStatistiques :\n"; print STDERR "\nConnecteurs\n"; print STDERR "-" x length($format),"\n"; foreach $key (sort(keys %statsC)) { $nom=$key; $nb=$statsC{$key} ; $prc=sprintf("%.2f", $statsC{$key}/$total*100); write STDERR; } print STDERR "-" x length($format),"\n"; ($nom, $nb, $prc) = ("TOTAL", $totalC, sprintf("%.2f", $totalC/$total*100)); write STDERR; print STDERR "\nAutres\n"; print STDERR "-" x length($format),"\n"; foreach $key (sort(keys %statsA)) { $nom=$key; $nb=$statsA{$key} ; $prc=sprintf("%.2f", $statsA{$key}/$total*100); write STDERR; } print STDERR "-" x length($format),"\n"; ($nom, $nb, $prc) = ("TOTAL", $totalA, sprintf("%.2f", $totalA/$total*100)); write STDERR; print STDERR "\n", "=" x length($format),"\n"; ($nom, $nb, $prc) = ("TOTAL GENERAL", $total, "100.00"); write STDERR; } ################# # Donc sub donc() { my $place; my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /^donc$/i) { if ($ttt=trouvedir("(PON |CONc)", $i, -1)) { if (($forme[$ttt] eq ".") && trouve("NOM",trouve ("VER", $ttt, $i),$i)) { push @out, csq(pointG($ttt), $ttt, $i, $i, pointD($i)) ;
else { push @out, csq(pointG($ttt-2), $ttt, $i, $i, pointD($i)) ; } } } } titre("Donc", \@out) ; } # Ainsi sub ainsi() { my $place; my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /ainsi/i) { if ($type[$i] !~/CON sub/) { if ($forme[$i] eq "Ainsi") { if ($type[$i+1] = ~ /VER\(pper\)/) { print LOG "! ! ! [ainsi +ppassé] ", join " ", @forme[&pointG($i)..&pointD($i)], "\n--\n"; } else { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } } else { if (propG($i)) { push @out, csq(pointG(pointG($i-2)-2), pointG($i-1)-1, $i, $i, pointD($i)) ; } else { push @out, csq(pointG(pointG($i-2)-2), pointG($i-1)-1, $i, $i, pointD($i)) ; } } } else { print LOG "! ! ! [ainsi que] ", join " ", @forme[&pointG($i)..&pointD($i)], "\n--\n"; } } } titre("Ainsi", \@out) ; } # Alors sub alors() { my $place; my @out;
for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /alors/i) { if ($type[$i] !~/CON sub/) { $place=$i; while ($forme[$place--] ne "."){} while ($place++<$i && !( ($forme[$place] = ~ /^(si|quand)$/i) || ($forme[$place] = ~ /[Ss]\'/ && $forme[$place+1] eq "il") ) ){} if ($place==$i+1) { if ($ttt=trouvedir("(PON |CONc)", $i, -1)) { if (($forme[$ttt] eq ".") && trouve("NOM",trouve ("VER", $ttt, $i),$i)) { push @out, csq(pointG($ttt), $ttt, $i, $i, pointD($i)) ; } else { push @out, csq(pointG($ttt-2), $ttt, $i, $i, pointD($i)) ; } } } else { print LOG "! ! ! [".lc($forme[$place])."... alors] ", join " ",
@forme[$place. .&pointD($i)], "\n--\n"; } } else { print LOG "! ! ! [alors que] ", join " ", @forme[&pointG($i)..&pointD($i)], "\n--\n"; } } } titre("Alors", \@out) ; } # Aussi sub aussi(){ my $place; my @out; for ($i=0; $i<=$#forme; $i++) { if (($forme[$i] = ~ /[Aa]ussi/ && $type[$i+1] = ~ /VER/ && $forme[$i+2] =~ /-/) || ($forme[$i] = ~ /[Aa]ussi/ && $forme[$i-1] =~ /\./ && $forme[$i+1] = ~ /,/)) { if ($type[$i-1] = ~ /PONsep/) { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } else { push @out, csq(pointG($i), $i-1, $i, $i, pointD($i)) ;
titre("Aussi", \@out) ; } # Par conséquent sub parcons() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /par/i && $forme[$i+1] eq "conséquent") { if ($ttt=trouvedir("(PON |CONc)", $i, -1)) { if (($forme[$ttt] eq ".") && trouve("NOM",trouve ("VER", $ttt, $i),$i)) { push @out, csq(pointG($ttt), $ttt, $i, $i+1, pointD($i)) ; } else { push @out, csq(pointG($ttt-2), $ttt, $i, $i+1, pointD($i)) ; } } } } titre("Par conséquent", \@out) ; } # De ce fait sub decefait() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /de/i && $forme[$i+1] eq "ce" && $forme[$i+2] eq "fait") {
if ($ttt=trouvedir("(PON |CONc)", $i, -1)) { if (($forme[$ttt] eq ".") && trouve("NOM",trouve ("VER", $ttt, $i),$i)) { push @out, csq(pointG($ttt), $ttt, $i, $i+2, pointD($i)) ; } else { push @out, csq(pointG($ttt-2), $ttt, $i, $i+2, pointD($i)) ; } } } } titre("De ce fait", \@out) ; } # Ce faisant sub cefaisant() { my @out; for ($i=0; $i<=$#forme; $i++) {
if ($forme[$i] = ~ /ce/i && $forme[$i+1] eq "faisant") { if ($ttt=trouvedir("(PON |CONc)", $i, -1)) { if (($forme[$ttt] eq ".") && trouve("NOM",trouve ("VER", $ttt, $i),$i)) { push @out, csq(pointG($ttt-1), $ttt, $i, $i+1, pointD($i)) ; } else { push @out, csq(pointG($ttt-2), $ttt, $i, $i+1, pointD($i)) ; } } } } titre("Ce faisant", \@out) ; } # Ce qui fait que sub ceqfq() { my @out; for ($i=0; $i<=$#forme; $i++) {
if ($forme[$i] = ~ /ce/i && $forme[$i+1] eq "qui" && $forme[$i+2] eq "fait" && $forme[$i+3] = ~ /^qu./) { if ($type[$i-1] =~/PON comma/) { push @out, csq(pointG($i), $i-1, $i, $i+3, pointD($i)) ; } elsif ($type[$i-1] !~/PON/) { push @out, csq(pointG(pointG($i-2)-1), $i-1, $i, $i+3, pointD($i)) ; } } } titre("Ce qui fait que", \@out) ; } # Dans ce cas sub danscecas() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /dans/i && $forme[$i+1] eq "ce" && $forme[$i+2] eq "cas") { if ($type[$i-1] =~/PONsep/) { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } } } titre("Dans ce cas", \@out) ; } # Pour cette raison sub pourcr() {
my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /pour/i && $forme[$i+1] eq "cette" &&
$forme[$i+2] eq "raison") { if ($type[$i-1] =~/PONsep/) { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } } } titre("Pour cette raison", \@out) ; } # C'est pourquoi sub cestpq() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /c'/i && $forme[$i+1] eq "est" && $forme[$i+2] eq "pourquoi") { if ($type[$i-1] =~/PONsep/) { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } } } titre("C'est pourquoi", \@out) ; } # C'est la raison pour laquelle sub cestlrpl() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /c'/i && $forme[$i+1] eq "est" && $forme[$i+2] eq "la" && $forme[$i+3] eq "raison" && $forme[$i+4] eq "pour" &&
$forme[$i+5] eq "laquelle") { if ($type[$i-1] =~/PONsep/) { push @out, csq(pointG($i-2), $i-1, $i, $i, pointD($i)) ; } } } titre("C'est la raison pour laquelle", \@out) ; } #################### # Ceci et cela sub cecicela() { my @out; for ($i=0; $i<=$#forme; $i++)
if ($type[$i-1] = ~ /PONsep/ && $forme[$i] = ~ /^(ceci|cela)$/i) { if (propD($i)) { if (vcsq($tmp=trouvedir ("VER", $i, 1, \@type))) { push @out, csq(pointG(pointG($i)-2), $i-1, $i, $i, pointD($i)) ; } else {
print LOG sprintf ("[cecicela -ce]%s\n--\n", join " ", @forme[pointG(pointG($i)-2)..pointD($i)]); } } else { print LOG sprintf (" ! ! ! [cecicela pnc] %s\n--\n",
(join " ", @forme[pointG($i)..pointD($i)])); } } } titre("Ceci / cela", \@out, 1); } # Ce qui sub cequi() { my @out; for ($i=0; $i<=$#forme; $i++) { if ($type[$i-1] = ~ /PONco/ && $forme[$i] = ~ /^ce$/i &&
$forme[$i+1] = ~ /^qui$/) { if (propG($i)) { if (vcsq(trouvedir ("VER", $i, 1, \@type))) { push @out, csq(pointG($i), $i-1, $i, $i+1, pointD($i)) ; } else {
print LOG sprintf ("[ce qui -ce]%s\n--\n", join "
", } } else { print LOG sprintf (" ! ! ! [ce qui pnc] %s\n--\n",
} (join " ", @forme[pointG($i)..pointD($i)])); } } titre("Ce qui", \@out, 1); } # Syllogisme sub syllo() { my $place; my @out;
for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] = ~ /^or$/i) { print STDERR ("\x8" x length $nbInd) .++$nbInd; push @out, sprintf ("%s\n", bcse(). join ("",@forme[&pointG(&pointG($i)-2)..$i-1]). marque ($forme[$i]). join ("", @forme[$i+1..($tmp=&pointD($i))]). ecse()." ".bcsq(). join ("", @forme[$tmp+1..&pointD($tmp+1)]). ecsq()) ; } } titre("Syllogisme", \@out, 1); } # Participe présent sub ppres() { my $place; my @out; my $ok; for ($i=0; $i<=$#forme; $i++) { if ($forme[$i] eq "," && $type[$i+1] =~ /VER\(ppre\)/) { if ($forme[$i+2] eq "ainsi" || $forme[$i+4] eq "fait" || $forme[$i+3] eq "faisant") { push @out, csq(propG($i), $i, $i+1, $i+1, pointD($i)) ; } else { $ok=0; foreach $j (@v_etat) { if ($lemme[$i+1] = ~ $j) { $ok=1; } } if ($ok==0) { if ($pcmp=propG($i)) { if (vcsq($i+1)) { push @out, csq($pcmp, $i, $i+1, $i+1, pointD($i)) ; } else {
} print LOG sprintf (" ! ! ! [ppres -ce] %s\n--\n", (join " ", @forme[pointG($i)..pointD($i)]));
print LOG sprintf (" ! ! ! [ppres pnc] %s\n--\n",
(join " ", @forme[pointG($i)..pointD($i)])); } } else { print LOG sprintf(" ! ! ! [ppres etat] %s\n--\n",
} } (join " ", @forme[pointG($i)..pointD($i)])) } } titre("Part. Prés.", \@out, 1); } ########################################## # recherche d'un type d'élément lexical entre deux bornes sub trouve($$$) { # trouve ($chaine, $debut, $fin) for ($bcl=$ _[1] ;$bcl <=$_[2] ;$bcl++) { if ($type[$bcl]=~/$_[0]/) { return $bcl; } } return 0; } # recherche d'un type d'élément lexical dans un direction sub trouvedir($$$) { my $place=$_[1] ; while ($type[$place+=$ _[2]] !~ /$_[0]/) {} return $place; } # recherche d'une proposition complète à droite sub propD($) { my $place=$_[0] ; while ($type[$place++] !~ /PON sep/){} if(trouve("VER\\(", $_[0], $place)){return $_[0]} else {return 0} } # recherche d'une proposition complète à gauche sub propG($) { my $place=$ _[0] ; while ($type[$place--] !~ /PON sep/ && $forme[$place] ne "("){} if(trouve("VER\\(", $place+2, $ _[0])){return $place+2} else {return 0} } # recherche d'un point à droite sub pointD($)
my $place=$_[0] ; while ($type[$place++] !~ /PON sep/){} return $place-1; } # recherche d'un point à gauche sub pointG($) { my $place=$_[0] ; while ($type[$place--] !~ /PON sep/){} return $place+2; } # définition des balises de la relation de conséquence sub bcse() { return "[cse " ; } sub ecse() { return " cse]"; } sub bcsq() { return "[csq " ; } sub ecsq() { return " csq]"; } sub marque($) { return " { $_[0] } " ; } # fonctuion d'affichage de la relation extraite sub csq($$$$) { print STDERR ("\x8" x length $nbInd) .++$nbInd; return sprintf ("%s\n", bcse(). join ("",@forme[$_[0]..$_[1]]). ecse()." ".bcsq(). join ("",@forme[$_[1]+1..$_[2]-1]). marque (join ("", @forme[$_[2]..$_[3]])). join ("", @forme[$_[3]+1..$_[4]]). ecsq()) ; } # affichage du nom de la relation et mise à jour des statistiques sub titre($$) { my $marq="$_[0] (".($#{$_[1]}+1).")"; print "\n"; print "-" x length $marq; print "\n$marq\n"; print "-" x length $marq;
print "\n\n@{$ _[1] }" ; if (defined($_[2])) { $statsA{$_[0] }=$#{$_[1] }+1; } else { $statsC{$_[0] }=$#{$_[1] }+1; } } # recherche d'un verbe efficient sub vcsq($) { print VER "$lemme[$_[0]]"; foreach $j (@v_changt_etat) { return 1 if ($lemme[$_[0]] = ~ /^$j/) } } # execution du programme main() ; |
|
