Approche exploratoire de la relation de conséquence : description et implémentation

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 VER, ">$fic.ver";

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;
close LOG;

# 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;

}

#################
## Connecteurs ##
#################

# 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) ;

}

####################
## Autres indices ##
####################

# 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 " ",
@forme[pointG(pointG($i)-2)..pointD($i)]);

}

}

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);

}

##########################################
## Routines de recherche et d'affichage ##
##########################################

# 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() ;