Définitions des fonctions

candidat2pajek

sub candidat2pajek{

my ($fCandidat,$fpajek)=@_;

my $temp="temp.xml";

candidat2GrafML($fCandidat,$temp);

grafML2pajek($temp,$fpajek);

unlink $temp;

}

# transforme un graphe xml en fichier pajek

grafML2pajek

sub grafML2pajek{

my($input,$output)=@_;

system("xsltproc -o $output GraphML2Pajek.xsl $input");

}

# transforme une liste de candidats en un graphe xml

candidat2GrafML

sub candidat2GrafML {

my ($input,$output)=@_;

chargeCandidats($input);

liste2xml($output);

}

# charge un fichier de liste de candidats en mémoire

chargeCandidats

sub chargeCandidats{

my $input=shift;

open(F,"<:utf8",$input) or erreur::affiche('ouvertureF',$input);

while (<F>) {#

my ($mot1,$mot2)= m/([$lettre]+)/g; # on prend les 2 mots de chaque candidat

next unless defined $mot1 && defined $mot2;

$nbCandidat{"$mot1|$mot2"}++; # ce candidat a donc un exemplaire en plus

# on ajoute le mot2 dans la liste des coocurrent du mot1 s'il n'y est pas déjà

if ( exists($listeMot{$mot1}) ) {

push @{$listeMot{$mot1}},$mot2 unless grep( /^$mot2$/, @{$listeMot{$mot1}} );

# si la liste des occurences du mot1 n'est pas encore initialisé

}else{

$listeMot{$mot1}=[$mot2];

}

}

close F;

}

# génére un un fichier graphe xml à partir d'une liste de candidats en mémoire

liste2xml

sub liste2xml{

my $output=shift;

open (OUT,">:utf8",$output) or erreur::affiche('ouvertureF',$output);

print OUT $headerXML;

# pour chaque mot

while (my($mot, $listeCooc) = each(%listeMot)) {

noeud2XML($mot);

# pour chacun de ses coocurrents à droite

foreach my $cooc (@$listeCooc) {

noeud2XML($cooc);

arrete2XML($mot,$cooc);

}

}

print OUT $footerXML;

close OUT;

}

# si le mot n'a pas encore d'ID, on lui en crée un et on fait le noeud

noeud2XML

sub noeud2XML{

my $mot=shift;

unless ( exists($ID{$mot}) ) {

$ID{$mot}=++$nbMot;

print OUT qq(\t\t<node id="$ID{$mot}"><data key="d0">$mot</data></node>\n);

}

}

# écrit l'arrête reliant 2 mots,le nombre de candidat pondère leur lien

arrete2XML

sub arrete2XML{

my($mot,$cooc)=@_;

print OUT qq(\t\t<edge source="$ID{$mot}" target="$ID{$cooc}"><data key="d1">$nbCandidat{"$mot|$cooc"}</data></edge>\n);

}

1;