Escreva a função mais curta para gerar o código American Soundex para um sobrenome contendo apenas as letras maiúsculas AZ. Sua função deve produzir uma saída consistente com todos os exemplos da página vinculada (fornecidos abaixo), embora não precise e não remova prefixos. Os hífens na saída são opcionais. Diverta-se!

Nota: Você não pode usar a soundex()função incluída no PHP ou equivalente em outras linguagens de programação.

Os exemplos:

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 caracteres

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"}

Esta solução contém apenas expressões regulares que são aplicadas uma após a outra. Infelizmente, não encontrei uma representação mais curta com um loop, então codifiquei todas as chamadas no script.

A mesma versão, mas um pouco mais legível:

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: Agora a solução está escrita na forma de uma função. O anterior foi leitura / gravação de / para STDIN / STDOUT. Custou-me sete caracteres para contornar isso.

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

Executar como etex filename.tex [Ashcraft].

Pitão, 274 285 241 235 225 200 190 183 179 174 166 161

- Última cláusula fixa (H ou W como separadores consoantes). Ashcraft agora tem o resultado certo. - Fez o dict menor - Formatação é menor (não requer Python 2.6) - Pesquisa dict Simplificação k - valor vogal alterado de '*'para ''e .appendpara +=[i] - Lista compreensão FTW - chamada removido para upper: D

Não posso mais jogar golfe. Na verdade eu fiz. Agora acho que não posso mais jogar golfe! Fiz isso de novo ...

Usando a tabela de conversão:

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]

Código de compreensão da lista antiga:

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]

Código antigo:

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]

Teste:

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

Dá:

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

Como esperado.

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}

Estou usando a solução de Howard com minha tabela de conversão (em y/A-Z/table/svez de todas s/[ABC]+/N/g)

J - 99

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

Teste:

  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 caracteres)

Esta implementação usa uma string mágica que possui caracteres não imprimíveis. Na xxdforma de saída é

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;

Sem usar as alterações básicas para compactar uma lista de números de 3 bits, seria

{.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;

Teste online

É basicamente um monte de loops chatos, mas há um truque interessante:

.7=$2$=

Isso está dentro de uma dobra cujo objetivo é lidar com letras duplas. Letras adjacentes com o mesmo código são mescladas em uma unidade, mesmo se separadas por um Hou a W. Mas isso não pode ser implementado trivialmente, removendo todos os Hes Wda string, porque no caso (reconhecidamente improvável na vida real, mas não descartado pela especificação), o fato de a primeira letra ser Hou We a segunda letra ser uma consoante , não precisamos exaltar essa consoante quando removemos a primeira letra. (Eu adicionei um caso de teste WMque deve dar W500para verificar isso).

Portanto, a maneira como lida com isso é fazer uma dobra e excluir cada letra que não seja a primeira (um efeito colateral conveniente do uso da dobra) que é igual à anterior ou igual ao 7código interno de He W.

Dada ae bna pilha, a maneira ingênua de verificar se a == b || b == 7seria

.2$=1$7=+

Mas há uma economia de dois caracteres usando uma cópia da pilha computada:

.7=$

Se bfor igual a 7, copia a; caso contrário, ele copia b. Então, comparando com a, obtemos um valor de verdade garantido, se bfoi 7independentemente do valor de a. (Antes de qualquer pedante pesar, o GolfScript não possui NaNs).

PowerShell, 150 161

Primeira tentativa e tenho certeza de que pode haver um pouco mais de golfe.

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]}

Funciona corretamente com os casos de teste da página vinculada e do artigo da Wikipedia:

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

Ruby 140

Estou usando o Ruby 2.0, mas acho que também deve funcionar com versões anteriores.

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

Exemplo:

puts f "PFISTER" => P236

APL (83)

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