Scrivi la funzione più breve per generare il codice American Soundex per un cognome contenente solo le lettere maiuscole AZ. La funzione deve produrre un output coerente con tutti gli esempi della pagina collegata (forniti di seguito), sebbene non sia necessario e non debba rimuovere i prefissi. I trattini in uscita sono opzionali. Divertiti!

Nota: non è possibile utilizzaresoundex() funzione inclusa in PHP o equivalenti in altri linguaggi di programmazione.

Gli esempi:

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 caratteri

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

Questa soluzione contiene solo espressioni regolari che vengono applicate una dopo l'altra. Sfortunatamente non ho trovato una rappresentazione più breve con un loop, quindi ho codificato tutte le chiamate nello script.

La stessa versione ma un po 'più leggibile:

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
}

Modifica 1: ora la soluzione è scritta sotto forma di una funzione. Il precedente stava leggendo / scrivendo da / a STDIN / STDOUT. Mi è costato sette personaggi aggirarlo.

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

Esegui come etex filename.tex [Ashcraft].

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

- Corretta l'ultima clausola (H o W come separatori di consonanti). Ashcraft ora ha il risultato giusto. - Ridotto il dict - La formulazione è più piccola (non richiede python 2.6) - Ricerca del dict più semplice per k - Valore vocale vocale modificato da '*'a ''e .appenda +=[i] - Comprensione elenco FTW - Chiamata rimossa aupper : D

Non posso più giocare a golf. In realtà l'ho fatto. Ora penso di non poter più giocare a golf!Fatto di nuovo...

Utilizzando la tabella di traduzione:

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]

Codice di comprensione vecchio elenco:

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]

Vecchio codice:

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]

Test:

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

dà:

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

Come previsto.

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}

Sto usando la soluzione di Howard con la mia tabella di traduzione ( y/A-Z/table/sinvece di ogni s/[ABC]+/N/g)

J - 99

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

test:

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

Questa implementazione utilizza una stringa magica che ha caratteri non stampabili. Nella xxdforma di output è

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;

Senza usare le modifiche di base per comprimere un elenco di numeri a 3 bit, sarebbe

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

È fondamentalmente un mucchio di loop noiosi, ma c'è un trucco interessante:

.7=$2$=

Questo è all'interno di una piega il cui scopo è gestire le doppie lettere. Le lettere adiacenti con lo stesso codice vengono unite in un'unità, anche se separate da un Ho un W. Ma questo non può essere implementato banalmente rimuovendo tutti Hi se Wdalla stringa, perché nel caso (certamente improbabile nella vita reale, ma non escluso dalla specifica) che la prima lettera è Ho We la seconda lettera è una consonante , non dobbiamo eludere quella consonante quando rimuoviamo la prima lettera. (Ho aggiunto un caso di prova WMche dovrebbe dare W500per verificare questo).

Quindi il modo in cui lo gestisco è fare una piega ed eliminare ogni lettera diversa dalla prima (un comodo effetto collaterale dell'uso di piega) che è uguale a quello precedente o uguale a 7, il codice interno per HeW .

Dato ae bin pila, il modo ingenuo per verificare se a == b || b == 7sarebbe

.2$=1$7=+

Ma c'è un salvataggio di 2 caratteri usando una copia calcolata dallo stack:

.7=$

Se bè uguale a 7allora copia a; altrimenti copia b. Quindi confrontandoci con aotteniamo un valore di verità garantito se bera 7indipendentemente dal valore di a. (Prima che pesa qualsiasi pedante, GolfScript non ha NaN).

PowerShell, 150 161

Primo tentativo e sono sicuro che si può giocare a golf un po 'di più.

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

Funziona correttamente con i casi di test sia dalla pagina collegata sia dall'articolo di Wikipedia:

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

Ruby 140

Sto usando Ruby 2.0, ma penso che dovrebbe funzionare anche con le versioni precedenti.

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

Esempio:

puts f "PFISTER" => P236

APL (83)

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