Partiel du 14/12/2004 - Correction
Exercice 1 (6 points) : 
Soit la fonction transDate( ) déclarée de la manière suivante :
1	sub transDate( ) {
2		$filename=shift;
3		open(IN,$filename);
4		while ($ligne=<IN>) {
5			$ligne=s/([0-9][0-9])-([0-9][0-9])-([0-9][0-9][0-9][0-9])/$3-$2-$1/g;
6			print STDOUT "$ligne\n";
7		}
8		close(IN);
9	}
a- Que fait cette fonction ?
b- Proposez une modification de la ligne 5 pour que la fonction puisse traiter tous les formats de date (p.ex. 4/2/99).
c- Proposez une modification du programme pour que la fonction puisse transformer les dates en français abrégé et normalisé (année à 4 chiffres, pas de 0 en début de nombre - les années ultérieures à 30 seront interprétées comme étant du XXe siècle). P. ex. "04/2/99" deviendra "4 fév. 1999".
Exercice 2 (10 points)
Pour la résolution de chacune des questions ci-dessous, on pourra réutiliser les fonctions écrites dans les questions précédentes. Avant de donner le code, vous décrirez brièvement, en français, l'algorithme et (si nécessaire) les structures de données utilisées.
a- Ecrire une fonction pos_car($str,$pos) qui prend comme argument une chaîne $str et un entier $pos, et renvoie le caractère situé à la position $pos, ou chaîne vide si la position est non définie. On pourra utiliser la fonction length( ) qui renvoie la longueur de la chaîne passée en argument.
b- Ecrire une fonction supprCar($str,$car) qui prend comme argument une chaîne $str et un caractère $car et renvoie la chaîne $str privée de la première occurrence de $car. Si le caractère $car n'apparaît pas dans $str, alors le résultat sera $str.
c- Ecrire une fonction Perl qui prend comme argument deux chaînes et renvoie 1 si tous les caractères de la première chaîne appartiennent à la deuxième chaîne. On proposera deux versions de la fonction : 
- dans la première version incluse($str1,$str2) on ne tiendra pas compte du nombre d'occurrences des caractères : incluse("cassation","actions") renverra 1.
- dans la seconde version incluseStrict($str1,$str2) on tiendra compte du nombre d'occurrences. 	incluseStrict("actions","cassation") renverra 1, et incluseStrict("cassation","actions") renverra 0.
d- On suppose que le fichier formes.txt contient une liste des formes fléchies du français.
Ecrire une fonction logogriphes($str) qui renvoie la liste des formes incluses dans $str.
e- Proposer une modification pour obtenir la liste des anagrammes de $str.
Exercice 3 (4 points + 2 points bonus)
Avant de donner le code, vous décrirez brièvement, en français, l'algorithme et les structures de données utilisées.
Pour construire un programme d'identification de la langue, on a besoin d'établir des statistiques sur les caractères (unigrammes, bigrammes et trigrammes) d'un texte. 
a- Ecrire un programme qui dénombre les occurrences des caractères pour le texte lu dans le fichier input.txt. La sortie de ce programme sera un fichier rapport.txt, avec les statistiques d'occurrences pour tous les caractères observés, triés alphabétiquement. Une tabulation permettra de présenter les résultats sur deux colonnes : 
ex. :
...
a	→	34	b	→	12	c	→	14
...
On pourra utiliser la fonction split( ) pour transformer une chaîne en liste de caractères.
b- Ecrire un programme qui dénombre, suivant le même principe, les occurrences des bigrammes et des trigrammes. Par exemple pour la chaîne : "tentantes" on aura les statistiques suivantes
te	→	2	en	→	1	nt	→	2	ta	→	1
an	→	1	es	→	1	ten	→	1	ent	→	1
nta	→	1	tan	→	1	ant	→	1	nte	→	1
tes	→	1

Solutions
1.a Elle lit le fichier dont le nom est passé en argument, et imprime à l'écran toutes les lignes du fichier en transformant les dates de la forme JJ-MM-AAAA en dates inversées : AAAA-MM-JJ (utile pour un tri chronologique).
1.b Formats que l'on veut prendre en compte : 4/2/99, 04/02/99, 4/2/1999, 04/02/1999 avec les formes les plus répandues de séparateurs : slash / tiret -, point .
Le motif suivant permet de reconnaître toutes ces variantes :
/([0-9][0-9]?)[\-\.\/]([0-9][0-9]?)[\-\.\/]([0-9][0-9][0-9]?[0-9]?)/
Ce motif reconnaît également des dates invalides (surgénération, p.ex. 00-0/000), mais peu importe car on veut reconnaître toutes les dates valides pour les transformer, et non détecter d'éventuelles erreurs. Le motif de remplacement reste identique : /$3-$2-$1/g
On a donc
$ligne=~s/([0-9][0-9]?)[\-\.\/]([0-9][0-9]?)[\-\.\/]([0-9][0-9][0-9]?[0-9]?)/$3-$2-$1/g;
1.c On recherche le motif ci-dessus, en stockant ce qui précède et ce qui suit. La transformation est appliquée tant qu'il reste une date non transformée dans la chaîne $ligne
@moisFr=("jan.","fév.","mar.","avr.","mai","juin","jui.","aoû.","sep.","oct.","nov.","déc.");
while ($ligne=~s/^(.*)([0-9][0-9]?)[\-\.\/]([0-9][0-9]?)[\-\.\/]([0-9][0-9][0-9]?[0-9]?)(.*)$/) {
	$prec=$1; $jour=$2; $mois=$3; $annee=$4; $suite=$5;
	$j=~s/0([1-9])/$1; 	# on supprime un éventuel 0 au début.
	$m=$moisFr{$mois};	# on convertit le mois en français.
	if ($annee=~/[0-9][0-9]/) { # on convertit l'année sur 4 chiffres
		if ($annee>30) { $a="19$annee"; } else { $a="20$annee"; }
	}
		$ligne=$prec.$j." ".$m." ".$a.suite";
}
print STDOUT "$ligne\n";
2.a On considère que le premier car. est à la position 1 (et non 0).
Version 1 : on utilise la fonction split() pour transformer la string en tableau.
sub pos_car(
	my $s=shift;
	my $p=shift;
	my @l=split(//,$s);
	if ($p>0 && $p<=$#l+1) { return $l[$p-1]; } else { return ""; }
}
Version 2 : on utilise la fonction substr()
sub pos_car(
	my $s=shift;
	my $p=shift;
	if ($p>0 && $p<=length($s) { 	return substr($s,$p,1) } else { return ""; }
}
2.b On considère que le premier car. est à la position 1 (et non 0).
Version 1 : on utilise la fonction pos_car()
sub supprCar(
	my $str=shift;
	my $car=shift;
	my ($res,$i);
	for ($i=1;$i<=length($str);$i++;
		if (pos_car($str,$i) ne $car) {
			$res=$res.pos_car($i); 	# on construit $res en concaténant chaque car. de $s
		} else {
			$car=""; 		# le car. a été trouvé. On l'ignore, et on efface $car, pour ne pas supprimer les autres occurrences.
		}
	}
	return $res;
}

Version 2 : on utilise les fonctions split() splice() et join()
sub supprCar(
	my $str=shift;
	my $car=shift;
	my $i;
	my @l=split(//,$str);			# convertit la chaîne en liste
	for ($i=0;$i<=$#l;$i++) {
		if ($l[$i] eq $car) {		# si le ième car correspond à $car
			splice(@l,$i,1); 	# supprime l'élément en position $i
			last; 			# sort de la boucle
		}
	}
	return (join("",@l)); 			# convertit la liste en chaîne
}

Version 3 : on utilise la puissance de Perl
sub supprCar(
	my ($str,$car)=@_;
	$str =~ s/$car//;
	return $str;
}
2.c Version 1 : inclusion non stricte

sub incluse {
	my $str1=shift;
	my $str2=shift;
	my ($i,$car);
	for ($i=1;$i<=length($str1);$i++) {
		$car=pos_car($str1,$i); # $car est le ième caractère de $str1
		if ($str2!~/$car/) { return 0; } # si $car n'appartient pas à $str2 on renvoie 0
	}
	# si on parvient à ce point c'est que tous les $car ont été trouvés dans $str2
	return 1;
}
Version 2 : inclusion stricte.
sub incluseStrict {
	my $str1=shift;
	my $str2=shift;
	my ($i,$car);
	for ($i=1;$i<=length($str1);$i++) {
		$car=pos_car($str1,$i);	# $car est le ième caractère de $str1
		if ($str2!~/$car/) { 
			return 0; 		# si $car n'appartient pas à $str2 on renvoie 0
		} else {
			$str2=supprCar($str2,$car); # $car a été trouvé dans $str2. On supprime sa 1ere occurrence de $str2 pour ne pas le reprendre en compte dans un prochain passage.
		}
	}
	# si on parvient à ce point c'est que tous les $car, avec leurs répétitions, ont été trouvés dans $str2
	return 1;
}
2.d Un simple while permet de parcourir toutes les formes du fichier, et de les ajouter à la liste si elles satisfont l'inclusion stricte.
sub logogriphe {
	my $str=shift;
	my @logo;
	open(IN,"formes.txt");
	while ($ligne=IN) {
		chomp $ligne;
		if (incluseStrict($ligne,$str)) { push(@logo,$ligne); }
	}
	return @logo;
	close(IN);
}
2.e Une anagramme est un logogriphe comportant le même nombre de caractères. Il suffit donc de rajouter une condition sur la longueur.
sub anagramme {
	my $str=shift;
	my @ana;
	my $long=length($str);
	open(IN,"formes.txt");
	while ($ligne=IN) {
		chomp $ligne;
		if (length($ligne)==$long && incluseStrict($ligne,$str)) { push(@ana,$ligne); }
	}
	return @ana;
	close (IN);
}
3.a Les décomptes, pour chaque caractère, seront stockés dans un hash %nbOcc, avec le caractère pour clé et le nombre d'occurrences pour valeur.

my %nbOcc;
my @l;
my ($ligne,$car);

open (IN,"input.txt");
open (OUT,">rapport.txt")
# Lecture du fichier input.txt
while ($ligne=IN) {
	chomp $ligne;
	@l=split(//,$ligne);
	foreach $car (@l) {
		if (exists($nbOcc{$car})) {
			$nbOcc{$car}++;
		} else {
			$nbOcc{$car}=1; # initialisation pour la clé $car 
		}
	}
}
# Ecriture du rapport : on trie les clés puis on les passe en revue dans une boucle foreach
foreach $car (sort(keys(%nbOcc))) {
	print OUT $car."\t".$nbOcc{$car};
}
3.b Les décomptes, pour chaque bigramme et trigramme, seront stockés dans deux hashes %nbOccBi et %nbOccTri, avec le bi/trigramme pour clé, et le nombre d'occurrences pour valeur. Dans une boucle foreach, on passe en revue la ligne lue car. par car. Les bigrammes et trigrammes sont construits à partir des caractères lus précédemment. Pour ce faire on utilise $carPrec pour enregistrer le caractère qui précède $car, et $carPrecPrec pour enregistrer le caractère qui précède $carPrec.

my %nbOccBi;
my %nbOccTri;
my @l;
my ($ligne,$car,$carPrec,$carPrecPrec,$bigramme,$trigramme);
open (IN,"input.txt");
open (OUT,">rapport.txt")
# Lecture du fichier input.txt
while ($ligne=IN) {
	chomp $ligne;
	@l=split(//,$ligne);
	$carPrec="";
	$carPrecPrec="";
	foreach $car (@l) {
		$bigramme=$carPrec.$car;
		$trigramme=$carPrecPrec.$carPrec.$car;
		if (exists($nbOccBi{$bigramme})) {
			$nbOccBi{$bigramme}++;
		} else {
			$nbOccBi{$bigramme}=1; # initialisation pour le bigramme
		}
		if (exists($nbOccTri{$trigramme})) {
			$nbOccTri{$trigramme}++;
		} else {
			$nbOccTri{$trigramme}=1; # initialisation pour le trigramme
		}
		$carPrecPrec=$carPrec;
		$carPrec=$car;
	}
}