Discussion :

[rvfranck]

Salut,
Cela fait des heures que je cherche une implémentation du phonex en perl. Sauriez vous où je pourrai la trouver?
Merci

[Jasmine80]

Si jamais tu n'en trouves pas, tu devrais facilement pouvoir l'écrire. Les expressions régulières sont très puissantes en Perl.
Quelque chose comme cela par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
#!/usr/local/bin/perl
 
use strict;
use warnings;
 
 
 
 
 
#----------- Soundex.pl    algorithme original de Russel & O’Dell datant de 1918
 
 
 
my $word = 'le petit chien est blanc-crème'; 
 
# Compte tenu que les tables de caractères modernes, permettent maintenant de saisir des lettres majuscules accentuées, il est nécessaire de transcrire ces lettres en lettres simples. 
# En particulier, dans la langue française, le c majuscule avec cédille (Ç ) sera transformé en S. De même que le caractère Œ (dans le mot cœur par exemple) sera transformé en E.
$word=~ s/é|è|ê|oe/E/g;
$word=~ s/ç/S/g;
 
#    *  On retranscrit le mot en majuscules
$word = uc($word);
 
#    * On conserve la première lettre du mot
my ($first_letter, $rest) = ($word =~ /^([A-Z])(.*)$/);  
 
#    * On élimine ensuite toutes les voyelles, le H et le W
$rest =~ s/H|W|A|E|I|O|E|U|Y//g;
 
#    * On transcode ensuite les lettres restantes à l’aide de la table suivante
=h
Lettre  			Type de consonnance  	code
B F P V 			Bilabiales 			1
C G J K Q S X Z 		Labiodentales 		2
D T 				Dentales 			3
L 				Alvéolaires 			4
M N 				Vélaires 			5
R 				Laryngales 			6
=cut
$rest =~ tr/BFPVCGJKQSXZDTLMNR/111122222222334556/;
 
# De plus il est nécessaire de supprimer les espaces morts avant et après le mot ainsi que les blancs et le tiret.
$rest =~ s/\s|-//g;   
 
#    *  On élimine ensuite toutes les paires consécutives de chiffres dupliquées 
# => restera 1 (série impaire) ou 0 (série paire) chiffre
# recherche et suppression des paires de chiffres
$rest =~ s/(\d)\1//g;   
 
#    * On ne conserve que 4 caractères du Soundex ainsi obtenu, et on le complète par des zéros le cas échéant
# les 4 premiers?
my $L = length($rest);  
if ($L>4){
	$rest = substr($rest, 0, 4); 
}
elsif($L<4){
	my $zero_num = 4 - $L;
	$rest .= '0' x $zero_num;
}
 
# on replace la première lettre du mot ??
$word = $first_letter . $rest;
print $word."\n";

[rvfranck]

Ok, mais je parle du phonex. J'ai déjà commençé à l'écrire. Je le mettrai peut être en ligne si j'y arrive

[Jasmine80]

Bien, bien, on n'est jamais si bien servi que par soi-même. Si tu as besoin d'aide, n'hésite pas.

[rvfranck]

Salut,
J'ai fini mon projet et je me demandais si je pouvais mettre mon code perl pour l'algorithme du phonex sur le site. Si vous pensez que c'est pas une mauvaise idée, comment procéder?

[thierry.chich]

J'aurais tendance à dire que LA bonne idée, c'est d'en faire un module CPAN, mais bon, c'est un peu de boulot aussi.
Par contre, ton code aura certainement une chance d'être utile, testé, repris,...