Utilisateur:Romainbehar/Programmation : anagrammes
Liste des anagrammes en français modifier
Résultat (décembre 2016) :
- 503 000 groupes de lettres donnent plusieurs anagrammes sur les mots de 4 lettres ou plus ;
- 2 groupes de lettres donnent 34 anagrammes (reste à éliminer ceux qui ne varient que d’un accent ou d’un digramme) :
- aeeinrst : aérisent, arénites, arétines, arsénite, artésien, astérien, enstérai, enterais, entiéras, éraniste, érastien, éreintas, éternisa, étraines, étrainés, rainètes, rainetés, ratinées, réentais, reniâtes, resatine, resatiné, résinate, retanise, retanisé, retenais, sènerait, seraient, sereinât, stéarine, stéariné, tanières, trainées, traînées
- aeinrst : arétins, arisent, artiens, astiner, entrais, inertas, insérât, ranites, ratiens, ratines, ratinés, rentais, résinat, résinât, retsina, riantes, sartine, satiner, sentira, sériant, serinât, sirénât, taniser, tarines, tarsien, tisaner, traines, traînes, trainés, traînés, transie, trianes, tsarien, tsarine
Le programme peut facilement être modifié pour analyser une autre langue.
Programme modifier
#!/usr/bin/perl -w
# trouver les anagrammes des mots français
use strict;
use utf8;
binmode STDOUT, ":utf8";
use MediaWiki::DumpFile::FastPages;
use Text::Unidecode;
my %anagrammes = ();
my $pages = MediaWiki::DumpFile::FastPages->new('frwiktionary-latest-pages-articles.xml');
my $titre;
my $texte;
while (($titre, $texte) = $pages->next) {
# uniquement les pages qui ont une section {{langue|fr}}
if ($texte =~ /\{\{langue\|fr\}\}/m) {
# lettres sans accents (transforme aussi par exemple 'œ' en 'oe')
my $sansaccents = unidecode($titre);
# suppression de tout ce qui n'est pas des lettres
$sansaccents =~ s/\W//g;
# si moins de 3 lettres, on passe
if (length($sansaccents) < 4) {
next;
}
# tri des lettres (ordre alphabétique, conserve les doublons)
my $tri = (join '', sort { $a cmp $b } split(//, $sansaccents));
# stockage dans un tableau pour regouper les titres qui ont les mêmes lettres
if (!exists $anagrammes{$tri}) {
$anagrammes{$tri} = [];
}
push $anagrammes{$tri}, $titre;
}
}
# affichage des groupes qui ont au moins deux mots
for my $a (keys %anagrammes) {
my $total = scalar @{ $anagrammes{$a} };
if($total < 2) {
# si pour cette liste de lettres il n’y a qu’un seul mot, on passe
next;
}
print "$total anagrammes avec les lettres $a :\n ";
for my $m (@{ $anagrammes{$a} }) {
print $m, ",";
}
print "\n";
}