Напишите самую короткую функцию для генерации американского кода Soundex для фамилии, содержащей только заглавные буквы AZ. Ваша функция должна выдавать выходные данные в соответствии со всеми примерами связанной страницы (приведенными ниже), хотя она не должна и не должна удалять префиксы. Дефисы в выходных данных являются необязательными. Веселиться!

Примечание. Вы не можете использовать soundex()функцию, включенную в PHP, или ее эквиваленты в других языках программирования.

Примеры:

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 символов

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

Это решение содержит только регулярные выражения, которые применяются один за другим. К сожалению, я не нашел более короткого представления с циклом, поэтому жестко запрограммировал все вызовы в сценарии.

Та же версия, но немного более читабельная:

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
}

Редактировать 1: Теперь решение записывается в виде функции. Предыдущий читал / писал из / в STDIN / STDOUT. Это обошлось мне в семь символов.

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

Запустить как etex filename.tex [Ashcraft].

Питон, 274 285 241 235 225 200 190 183 179 174 166 161

- Исправлено последнее предложение (H или W в качестве разделителей согласных). Ашкрафт теперь имеет правильный результат. - Сделал ДИКТ меньше - форматирование меньше (не требуется Python 2.6) - Simpler поиск ДИКТ для k - измененного значения гласного от '*'к ''и .appendк +=[i] - Список пониманию FTW - Удален вызоваupper : D

Я не могу дальше играть в гольф. На самом деле я сделал. Теперь я думаю, что больше не могу играть в гольф! Сделал это снова ...

Используя таблицу перевода:

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]

Старый код понимания списка:

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]

Старый код:

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]

Тестовое задание:

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

дает:

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

Как и ожидалось.

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}

Я использую решение Говарда с моей таблицей перевода ( y/A-Z/table/sвместо каждого s/[ABC]+/N/g)

J - 99

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

Тестирование:

  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 символа)

Эта реализация использует волшебную строку, которая имеет непечатаемые символы. В xxdформе вывода это

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;

Без использования базовых изменений для сжатия списка 3-битных чисел, было бы

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

Онлайн тест

Это в основном куча скучных петель, но есть один интересный трюк:

.7=$2$=

Это внутри сгиба, целью которого является обработка двойных букв. Смежные буквы с одинаковым кодом объединяются в одну единицу, даже если они разделены Hили W. Но это не может быть реализовано тривиально, удаляя все Hs и Ws из строки, потому что в (по общему признанию, маловероятно в реальной жизни, но не исключено спецификацией) случае, что первая буква является Hили, Wа вторая буква является согласной нам не нужно исключать эту согласную при удалении первой буквы. (Я добавил тестовый примерWM который должен дать, W500чтобы проверить это).

Таким образом, я справляюсь с тем, чтобы сделать сгиб и удалить каждую букву, отличную от первой (удобный побочный эффект использования сгиба), которая либо равна предыдущей, либо равна 7внутреннему коду дляH и W.

Учитывая aи bв стеке, наивный способ проверить, a == b || b == 7будет ли

.2$=1$7=+

Но есть двухсимвольное сохранение с использованием вычисленной копии из стека:

.7=$

Если bравно, 7то копирует a; в противном случае он копирует b. Таким образом, к тому времени, сравнивая с, aмы получаем гарантированное истинное значение, если оно bбыло 7независимо от значения a. (До того, как весят педанты, у GolfScript нет NaN).

PowerShell, 150 161

Сначала попробуйте, и я уверен, что в гольфе может быть немного больше.

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

Корректно работает с контрольными примерами из связанной страницы и статьи в Википедии:

Джексон, Пфистер, Тымчак, Гутьеррес, Ашкрафт, Эшкрофт, Ван Дейзен, Роберт, Руперт, Рубин, Вашингтон, Ли

Рубин 140

Я использую Ruby 2.0, но я думаю, что он должен работать и с более ранними версиями.

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

Пример:

puts f "PFISTER" => P236

APL (83)

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