Écrivez la fonction la plus courte pour générer le code Soundex américain pour un nom de famille contenant uniquement les lettres majuscules AZ. Votre fonction doit produire une sortie cohérente avec tous les exemples de la page liée (donnée ci-dessous), bien qu'elle n'ait pas besoin et ne doive pas supprimer les préfixes. Les tirets dans la sortie sont facultatifs. S'amuser!

Remarque: Vous ne pouvez pas utiliser la soundex()fonction incluse dans PHP ou des équivalents dans d'autres langages de programmation.

Les exemples:

WASHINGTON W-252
LEE L-000
GUTIERREZ G-362
PFISTER P-236 
JACKSON J-250 
TYMCZAK T-522
VANDEUSEN V-532
ASHCRAFT A-261

Perl, 143 150 caractères

sub f{$_="$_[0]000";/./;$t=$&;s/(?<=.)[HW]//g;s/[BFPV]+/1/g;s/[CGJKQSXZ]+/2/g;s/[DT]+/3/g;s/L+/4/g;s/[MN]+/5/g;s/R+/6/g;s/(?<=.)\D//g;/.(...)/;"$t$1"}

Cette solution ne contient que des expressions régulières qui sont appliquées l'une après l'autre. Malheureusement, je n'ai pas trouvé de représentation plus courte avec une boucle, j'ai donc codé en dur tous les appels dans le script.

La même version mais un peu plus lisible:

sub f{
  $_="$_[0]000";        # take first argument and append "000"
  /./;$t=$&;            # save first char to variable $t
  s/(?<=.)[HW]//g;      # remove and H or W but not the first one
  s/[BFPV]+/1/g;        # replace one or more BFPV by 1
  s/[CGJKQSXZ]+/2/g;    # replace one or more CGJKQSXZ by 2
  s/[DT]+/3/g;          # replace one or more DT by 3
  s/L+/4/g;             # replace one or more L by 4
  s/[MN]+/5/g;          # replace one or more MN by 5
  s/R+/6/g;             # replace one or more R by 6
  s/(?<=.)\D//g;        # remove and non-digit from the result but not the first char
  /.(...)/;"$t$1"       # take $t plus the characters 2 to 4 from result
}

Edit 1: Maintenant, la solution est écrite sous forme de fonction. Le précédent lisait / écrivait de / vers STDIN / STDOUT. Cela m'a coûté sept personnages pour contourner cela.

eTeX, 377.

\let\E\expandafter
\def\x#1;#2#3{\def\s##1#2{##1\s#3}\edef\t{\s#1\iffalse#2\fi}\E\x\t;}
\def\a[#1#2]{\if{{\fi\uppercase{\x#1,#2};B1F1P1V1C2G2J2K2Q2S2X2Z2D3T3L4M5N5R6A7E7I7O7U7
    H{}W{}Y{}{11}1{22}2{33}3{44}4{55}5{66}6{{}\toks0\bgroup}!}\E\$\t0000!#1}}
\def\$#1,#2{\if#1#2\relax\E\%\else\E\%\E#2\fi}
\def\%{\catcode`79 \scantokens\bgroup\^}
\def\^#1#2#3#4!#5{\message{#5#1#2#3}\end}
\E\a

Exécuter en tant que etex filename.tex [Ashcraft].

Python, 274 285 241 235 225 200 190 183 179 174 166 161

- Dernière clause fixe (H ou W comme séparateurs de consonnes). Ashcraft a maintenant le bon résultat. - Rendu le dict plus petit - Le formatage est plus petit (ne nécessite pas python 2.6) - Recherche de dict plus simple k - Valeur de voyelle modifiée de '*'vers ''et .appendvers +=[i] - Compréhension de la liste FTW - Suppression de l'appel à upper: D

Je ne peux plus jouer au golf. En fait, je l'ai fait. Maintenant je pense que je ne peux plus jouer au golf! Fait à nouveau...

Utilisation de la table de traduction:

def f(n):z=n.translate(65*'_'+'#123#12_#22455#12623#1_2#2'+165*'_').replace('_','');return n[0]+(''.join(('',j)[j>'#']for i,j in zip(z[0]+z,z)if i!=j)+'000')[:3]

Ancien code de compréhension de liste:

x=dict(zip('CGJKQSXZDTLMNRBFPV','2'*8+'3345561111'))
def f(n):z=[x.get(i,'')for i in n if i not in'HW'];return n[0]+(''.join(j for i,j in zip([x.get(n[0])]+z,z)if i!=j)+'000')[:3]

Ancien code:

x=dict(zip('CGJKQSXZDTLMNRBFPV','2'*8+'3345561111'))
def f(n):
 e=a=[];k=n[0]in x
 for i in[x.get(i,'')for i in n.upper()if i not in'HW']:
  if i!=a:e+=[i]
  a=i
 return n[0]+(''.join(e)+'000')[k:3+k]

Tester:

[f(i) for i in ['WASHINGTON', 'LEE', 'GUTIERREZ', 'PFSTER', 'JACKSON',
                'TYMCZAK', 'VANDEUSEN', 'ASHCRAFT']]

Donne:

['W252', 'L000', 'G362', 'P236', 'J250', 'T522', 'V532', 'A261']

Comme prévu.

Perl, 110

sub f{$_="$_[0]000";/./;$t=$&;s/(?<=.)[HW]//g;y/A-Z/:123:12_:22455:12623:1_2:2/s;s/(?<=.)\D//g;/.(...)/;$t.$1}

J'utilise la solution d'Howard avec ma table de traduction ( y/A-Z/table/sau lieu de toutes s/[ABC]+/N/g)

J - 99

{.,([:-.&' '@":3{.!.0[:(#~1,}.~:}:)^:#,@(;:@]>:@I.@:(e.&>"0 _~)[#~e.))&'BFPV CGJKQSXZ DT L MN R'@}.

Essai:

  sndx=: {.,([:-.&' '@":3{.!.0[:(#~1,}.~:}:)^:#,@(;:@]>:@I.@:(e.&>"0 _~)[#~e.))&'BFPV CGJKQSXZ DT L MN R'@}.
  test=: ;: 'JACKSON PFISTER TYMCZAK GUTIERREZ ASHCRAFT ASHCROFT VANDEUSEN ROBERT RUPERT RUBIN WASHINGTON LEE'
  (,. sndx&.>) test


+-------+-------+-------+---------+--------+--------+---------+------+------+-----+----------+----+
|JACKSON|PFISTER|TYMCZAK|GUTIERREZ|ASHCRAFT|ASHCROFT|VANDEUSEN|ROBERT|RUPERT|RUBIN|WASHINGTON|LEE |
+-------+-------+-------+---------+--------+--------+---------+------+------+-----+----------+----+
|J250   |P123   |T520   |G362     |A261    |A261    |V532     |R163  |R163  |R150 |W252      |L000|
+-------+-------+-------+---------+--------+--------+---------+------+------+-----+----------+----+

GolfScript (74 caractères)

Cette implémentation utilise une chaîne magique qui a des caractères non imprimables. Sous xxdforme de sortie, c'est

0000000: 7b2e 313c 5c5b 7b36 3326 2741 4c15 c252  {.1<\[{63&'AL..R
0000010: d056 4c1e 8227 3235 3662 6173 6520 3862  .VL..'256base 8b
0000020: 6173 653d 7d25 7b2e 373d 2432 243d 7b3b  ase=}%{.7=$2$={;
0000030: 7d2a 7d2a 5d31 3e31 2c2d 5b30 2e2e 5d2b  }*}*]1>1,-[0..]+
0000040: 333c 7b2b 7d2f 7d3a 533b                 3<{+}/}:S;

Sans utiliser les modifications de base pour compresser une liste de nombres à 3 bits, il serait

{.1<\[{63&[1 0 1 2 3 0 1 2 7 0 2 2 4 5 5 0 1 2 6 2 3 0 1 7 2 0 2]=}%{.7=$2$={;}*}*]1>1,-[0..]+3<{+}/}:S;

Test en ligne

C'est essentiellement un tas de boucles ennuyeuses, mais il y a une astuce intéressante:

.7=$2$=

C'est à l'intérieur d'un pli dont le but est de gérer les doubles lettres. Les lettres adjacentes avec le même code sont fusionnées en une seule unité, même si elles sont séparées par un Hou un W. Mais cela ne peut pas être implémenté de manière triviale en supprimant tous les Hs et Ws de la chaîne, car dans le cas (certes peu probable dans la vie réelle, mais non exclu par la spécification) que la première lettre est Hou Wet la deuxième lettre est une consonne , nous ne devons pas éluder cette consonne lorsque nous supprimons la première lettre. (J'ai ajouté un cas de test WMqui devrait donner W500pour vérifier cela).

Donc, la façon dont je gère cela est de faire un pli et de supprimer chaque lettre autre que la première (un effet secondaire pratique de l'utilisation du pli) qui est soit égale à la précédente soit égale au 7code interne de Het W.

Étant donné aet bsur la pile, la façon naïve de vérifier si a == b || b == 7serait

.2$=1$7=+

Mais il y a une économie de 2 caractères en utilisant une copie calculée à partir de la pile:

.7=$

Si best égal à 7alors il copie a; sinon, il copie b. Donc, en comparant avec anous, nous obtenons une valeur véridique garantie si bc'était 7indépendamment de la valeur de a. (Avant que les pédants ne pèsent, GolfScript n'a pas de NaN).

PowerShell, 150161

Essayez d'abord et je suis sûr qu'il peut y avoir beaucoup plus de golf.

filter s{$s=-join$_[1..9]
1..6+'$1','',$_[0]|%{$s=$s-replace('2[bfpv]2[cgjkqsxz]2[dt]2l2[mn]2r2(.)\1+2\D|^.2^'-split2)[++$a],$_}
-join"${s}000"[0..3]}

Fonctionne correctement avec les cas de test de la page liée et de l'article Wikipedia:

Jackson, Pfister, Tymczak, Gutierrez, Ashcraft, Ashcroft, VanDeusen, Robert, Rupert, Rubin, Washington, Lee

Rubis 140

J'utilise Ruby 2.0, mais je pense que cela devrait également fonctionner avec les versions antérieures.

def f s
a=s[i=0]
%w(HW BFPV CGJKQSXZ DT L MN R).each{|x|s.gsub!(/[#{x}]+/){i>0&&$`[0]?i: ''};i+=1}
a+(s[1..-1].gsub(/\D/,'')+'000')[0,3]
end

Exemple:

puts f "PFISTER" => P236

APL (83)

{(⊃⍵),,/⍕¨3↑0~⍨1↓K/⍨~K=1⌽K←0,⍨{7|+/' '=S↑⍨⍵⍳⍨S←' BFPV CGJKQSXZ DT L MN R'}¨⍵~'HW'}⍞