Yalnızca AZ harflerini içeren bir soyadı için Amerikan Soundex kodunu üretmek için en kısa işlevi yazın . Ön ekler gerekmemesine ve kaldırılmamasına rağmen, işleviniz bağlantılı sayfanın tüm örnekleriyle (aşağıda verilen) tutarlı çıktı üretmelidir. Çıktıdaki kısa çizgiler isteğe bağlıdır. İyi eğlenceler!

Not: Sen olabilir değil kullanmak soundex()PHP veya diğer programlama dillerinde benzerlerine dahil fonksiyonu.

Örnekler:

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, 143150 karakter

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

Bu çözüm yalnızca birbiri ardına uygulanan düzenli ifadeler içerir. Ne yazık ki bir döngü ile daha kısa bir temsil bulamadım, bu yüzden komut dosyasına tüm çağrıları kodladım.

Aynı sürüm ama biraz daha okunabilir:

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
}

Edit 1: Şimdi çözüm bir fonksiyon şeklinde yazılmıştır. Bir öncekinden STDIN / STDOUT'a okuma / yazma vardı. Etrafımda çalışmak yedi karaktere mal oldu.

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

Farklı çalıştır etex filename.tex [Ashcraft].

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

- Son fıkra düzeltildi (ünsüz ayırıcılar olarak Y veya G). Ashcraft şimdi doğru sonucu verdi. - dict küçük Üretildi - Biçimlendirme (Python 2.6 gerektirmez) küçüktür - için basit dict arama k gelen Değiştirilen sesli harf değeri - '*'için ''ve .appendiçin +=[i] için Kaldırılan çağrısı - FTW Liste anlama - upper: D

Daha fazla golf yapamam. Aslında yaptım. Artık golf oynayamayacağımı düşünüyorum! Yine yaptı...

Çeviri tablosunu kullanma:

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]

Eski liste anlama kodu:

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]

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

Ölçek:

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

verir:

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

Beklenildiği gibi.

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}

Çeviri çözümümle Howard'ın çözümünü y/A-Z/table/skullanıyorum (her yerine s/[ABC]+/N/g)

J - 99

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

Test yapmak:

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

Bu uygulama, yazdırılamayan karakterler içeren sihirli bir dize kullanır. Gelen xxdçıkış formu öyle

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 bitlik sayılar listesini sıkıştırmak için temel değişiklikleri kullanmadan,

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

Çevrimiçi test

Temelde bir sürü sıkıcı döngü, ancak ilginç bir numara var:

.7=$2$=

Bu, amacı çift harfleri işlemek olan bir katın içinde. Aynı koda sahip bitişik harfler, Ha veya a ile ayrılmış olsa bile bir birime birleştirilir W. Ancak bu, tüm Hs ve sleri Wdizeden çıkararak önemsiz bir şekilde uygulanamaz , çünkü (gerçek hayatta kabul edilemez, ancak spesifikasyon tarafından reddedilmez) durumda, ilk harfin Hveya Wikinci harfin bir ünsüz olduğu , ilk harfi kaldırdığımızda ünsüz harfleri elemememiz gerekir. (Bunu kontrol etmek için WMvermesi gereken bir test durumu ekledim W500).

Bir kat yapmak ve her harfi silmek için yolu ben sap Yani ilk dışındaki ya olduğu (kat kullanmanın uygun bir yan etkiye) bir öncekine eşit veya eşit 7iç kodu Hve W.

Verilen ave byığın, naif bir yol olup olmadığını kontrol etmek a == b || b == 7olurdu

.2$=1$7=+

Ancak, hesaplanmış bir yığın kopyasını kullanarak 2 karakterlik bir tasarruf vardır:

.7=$

Eşitse b, 7kopyalar a; aksi takdirde kopyalar b. Öyleyse ile karşılaştırarak aeğer biz garantili truthy değeri elde boldu 7bakılmaksızın değerinin a. (Herhangi bir pedalı tartmadan önce, GolfScript'in NaN'si yoktur).

PowerShell, 150161

İlk deneyin ve orada biraz daha golf olabilir eminim.

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

Bağlantılı sayfadaki ve Wikipedia makalesindeki test senaryolarıyla doğru şekilde çalışır:

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

Ruby 140

Ruby 2.0 kullanıyorum, ancak önceki sürümlerle de çalışması gerektiğini düşünüyorum.

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

Misal:

puts f "PFISTER" => P236

APL (83)

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