Napisz najkrótszą funkcję, aby wygenerować amerykański kod Soundex dla nazwiska zawierającego tylko wielkie litery AZ. Twoja funkcja musi generować dane wyjściowe zgodne ze wszystkimi przykładami połączonych stron (podanymi poniżej), chociaż nie musi i nie powinna usuwać prefiksów. Łączniki w danych wyjściowych są opcjonalne. Baw się dobrze!

Uwaga: Być może nie korzystać z soundex()funkcji zawartych w PHP lub odpowiedników w innych językach programowania.

Przykłady:

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 znaków

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

To rozwiązanie zawiera tylko wyrażenia regularne, które są stosowane jeden po drugim. Niestety nie znalazłem krótszej reprezentacji z pętlą, więc na stałe zapisałem wszystkie wywołania w skrypcie.

Ta sama wersja, ale nieco bardziej czytelna:

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
}

Edycja 1: Teraz rozwiązanie jest napisane w postaci funkcji. Poprzednim było czytanie / pisanie z / do STDIN / STDOUT. Obejście tego kosztowało mnie siedem postaci.

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

Uruchom jako etex filename.tex [Ashcraft].

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

- Naprawiono ostatnią klauzulę (H lub W jako separatory spółgłosek). Ashcraft ma teraz właściwy wynik. - Zmniejszono dykt - Formatowanie jest mniejsze (nie wymaga Pythona 2.6) - Prostsze wyszukiwanie dykta k - Zmieniono wartość samogłoski z '*'na ''i .appendna +=[i] - Zrozumienie listy FTW - Usunięto wywołanie do upper: D

Nie mogę już grać w golfa. Właściwie to zrobiłem. Teraz myślę, że nie mogę już grać w golfa! Zrobiłem to jeszcze raz ...

Za pomocą tabeli translacji:

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]

Stary kod zrozumienia listy:

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]

Stary kod:

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

Daje:

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

Zgodnie z oczekiwaniami.

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}

Korzystam z rozwiązania Howarda z tabelą tłumaczeń ( y/A-Z/table/szamiast wszystkich s/[ABC]+/N/g)

J - 99

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

Testowanie:

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

Ta implementacja korzysta z magicznego ciągu znaków, który ma znaki niedrukowalne. W xxdpostaci wyjściowej jest

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;

Byłoby to bez użycia podstawowych zmian do skompresowania listy liczb 3-bitowych

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

To w zasadzie kilka nudnych pętli, ale jest jedna interesująca sztuczka:

.7=$2$=

To jest wewnątrz zakładki, której celem jest obsługa podwójnych liter. Sąsiadujące litery o tym samym kodzie są scalane w jedną jednostkę, nawet jeśli są oddzielone przez a Hlub a W. Ale to nie może być realizowane trywialnie przez wyprowadzenie wszystkich Hs i Ws od napisu, ponieważ w (wprawdzie mało prawdopodobne, w prawdziwym życiu, ale nie wykluczone przez spec) tak, że pierwsza litera jest Halbo Wa druga litera jest spółgłoską , nie musimy unikać tej spółgłoski, gdy usuwamy pierwszą literę. (Dodałem przypadek testowy, WMktóry powinien dać W500to sprawdzić).

Tak więc radzę sobie z tym, aby zrobić fałd i usunąć każdą literę inną niż pierwsza (wygodny efekt uboczny użycia fold), który jest albo równy poprzedniej, albo jest równy 7wewnętrznemu kodowi dla Hi W.

Biorąc pod uwagę ai bna stosie, naiwny sposób sprawdzenia, czy a == b || b == 7będzie

.2$=1$7=+

Ale można zaoszczędzić 2 znaki, używając obliczonej kopii ze stosu:

.7=$

Jeśli bjest równe, 7to kopiuje a; w przeciwnym razie kopiuje b. Porównując z tym a, otrzymujemy gwarantowaną prawdziwą wartość, jeśli bbyła ona 7niezależna od wartości a. (Przed ważeniem jakichkolwiek pedantów, GolfScript nie ma NaN).

PowerShell, 150 161

Pierwsza próba i jestem pewien, że można grać w golfa o wiele więcej.

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

Działa poprawnie z przypadkami testowymi zarówno z połączonej strony, jak i artykułu z Wikipedii:

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

Ruby 140

Używam Ruby 2.0, ale myślę, że powinien on również działać z wcześniejszymi wersjami.

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

Przykład:

puts f "PFISTER" => P236

APL (83)

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