#!/usr/bin/perl
<<DOC;
FEVRIER 2006
usage : perl patron2graphml.pl liste-de-token.txt
Le programme prend en entrée le nom du fichier contenant les patrons
à traiter (des blancs entre les termes du patron)
Le programme construit en sortie un fichier au format graphml
DOC
#-------------------------
# definitions de variables
#-------------------------
my $file="$ARGV[0]";
my %listeMot={};
my %listePatron={};
my
$cs="ÆÁÂÀÅÃÄÇÇÇÐÉÊÈËÍÎÌÌÏÑÓÔÒØÕÖÞÚÛÙÜÝáâæàåãäçéêèðëíîìïñóôòøõößþúûùüýÿ";
#-------------------------
# Partie 1
# A. ouverture du fichier des patrons : ce fichier contient sur chaque ligne une sequence : mot1 mot2
# B. dans la boucle while qui suit on va reperer pour chaque mot (a gauche du patron)
# l'ensemble des mots associés (a droite du precedent)
# on cree ensuite un tableau indexe qui associe au mot de gauche la liste des mots associes
# motgauche -> (motdroite-1,motdroite-2,...)
# on n'ajoute qu'une seule occurrence des mots presents a droite mais on compte
# la frequence d'un patron donne dans un tableau de patron
#-------------------------
open(F,$file);
while (my $ligne=<F>) {
$ligne=~/([\w$cs]+)[^\w$cs]+([\w$cs]+)/;
my $mot1=$1;
my $mot2=$2;
print "M1 : $mot1\n";
print "M2 : $mot2\n";
my $patron="$mot1\t$mot2";
if (!(exists($listeMot{$mot1}))) {
my @tmp=();
push(@tmp,$mot2);
$listeMot{$mot1}=\@tmp;
print "FM : @{$listeMot->{$mot1}}\n";
$listePatron{$patron}++;
}
else {
my $tmp=$listeMot{$mot1};
my @tmp2=@$tmp;
if (!(grep(/$mot2/, @tmp2))) {
push(@tmp2,$mot2);
}
$listeMot{$mot1}=\@tmp2;
print "NM : $listeMot{$mot1}\n";
$listePatron{$patron}++;
}
}
close(F);
#-------------------------
# Partie 2
# A. Creation du fichier de sortie et squelette minimal
# B. parcours du tableau des associations motgauche -> (motdroite-1,motdroite-2,...)
# pour chaque motgauche on cree un noeud du graphe idem pour chaque mot de la liste associee
# afin de ne pas creer de doublon on utilise un tableau contenant pour chaque mot son indice
# on verifie dans ce tableau la presence ou non du mot a associer a un noeud
#-------------------------
open (F,">patron-graphml.xml");
print F "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n";
print F "<graphml>\n";
print F " <key id=\"d0\" for=\"node\" attr.name=\"forme\" attr.type=\"string\"/>\n";
print F " <key id=\"d1\" for=\"edge\" attr.name=\"frequence\" attr.type=\"double\"/>\n";
print F " <graph edgedefault=\"undirected\">\n";
my $id=1;
my $listeId={};
while (($mot, $liste) = each(%listeMot)) {
my @tmp=@$liste;
print "$mot\t@tmp\n";
if ($mot !~/HASH/) {
my $tmpID;
if (!(exists($listeId{$mot}))) {
print F " <node
id=\"$id\"><data key=\"d0\">$mot</data></node>\n";
$listeId{$mot}=$id;
$tmpID=$id;
$id++;
}
else {
$tmpID=$listeId{$mot};
}
foreach my $cible (@tmp) {
my $nbpatron=0;
$patron="$mot\t$cible";
$nbpatron=$listePatron{$patron};
if (!(exists($listeId{$cible}))) {
print F " <node
id=\"$id\"><data
key=\"d0\">$cible</data></node>\n";
$listeId{$cible}=$id;
print F " <edge
source=\"$tmpID\" target=\"$id\"><data
key=\"d1\">$nbpatron</data></edge>\n";
$id++;
}
else {
print F " <edge
source=\"$tmpID\" target=\"$listeId{$cible}\"><data
key=\"d1\">$nbpatron</data></edge>\n";
}
}
}
}
print F " </graph>\n";
print F "</graphml>\n";
close(F);