Напишіть найкоротшу функцію для створення американського кодексу 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']

Як і очікувалося.

Перл, 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$=

Це всередині складки, мета якої - обробка подвійних літер. Суміжні літери з одним і тим же кодом об'єднуються в одну одиницю, навіть якщо вони розділені символом a Hабо a W. Але це не може бути реалізовано тривіально, видаляючи всі рядки Hі 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'}⍞