大文字のA〜Zのみを含む姓のAmerican Soundexコードを生成する最短の関数を記述します。関数は、リンクされたページのすべての例（下記を参照）と一致する出力を生成する必要がありますが、プレフィックスを削除する必要はなく、削除するべきではありません。出力のハイフンはオプションです。楽しんで！

注： PHPに含まれている関数または他のプログラミング言語の同等の関数は使用できませんsoundex()。

例：

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からの読み取り/書き込みでした。それを回避するには、7文字が必要でした。

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]ます。

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

-最後の節を修正（子音区切りとしてHまたはW）。Ashcraftが正しい結果になりました。-整形は（のpython 2.6を必要としない）小さいです- -のためのよりシンプルな辞書検索辞書小さくk から変更母音値- '*'へ''と.appendへ+=[i] - -リストFTW理解するために除去呼び出しupperD：

これ以上ゴルフはできません。実際にやった。今、私はこれ以上ゴルフができないと思います！もう一度やった...

変換テーブルの使用：

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;

オンラインテスト

基本的には退屈なループの束ですが、興味深いトリックが1つあります。

.7=$2$=

これは、二重文字を処理することを目的とするフォールド内にあります。同じコードの隣接する文字は、Hまたはで区切られていても、1つのユニットにマージされWます。しかし、これはすべて取り除くことによって自明実装することができないHのとW（確かに現実の生活の中では低いが、仕様によって除外しない）場合は、最初の文字があることであるため、文字列からSをHかW2番目の文字が子音であります、最初の文字を削除するときに子音を削除しないようにする必要があります。（これを確認するWMためのテストケースを追加しましたW500）。

折り畳みを行うために、各文字を削除する方法のIハンドルに最初以外のいずれかである（倍使用の便利な副作用）は、前の1に等しい又は等しい7ための内部コード、HおよびW。

考えるaとb、スタック上で、ナイーブな方法は、かどうかを確認するa == b || b == 7だろう

.2$=1$7=+

ただし、計算されたcopy-from-stackを使用すると、2文字の節約になります。

.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'}⍞