Soundex: Difference between revisions

 

;Task:

 

;Caution:

* If a vowel (A, E, I, O, U) separates two consonants that have the same soundex code, the consonant to the right of the vowel is coded. Tymczak is coded as T-522 (T, 5 for the M, 2 for the C, Z ignored (see "Side-by-Side" rule above), 2 for the K). Since the vowel "A" separates the Z and K, the K is coded.

* If "H" or "W" separate two consonants that have the same soundex code, the consonant to the right of the vowel is not coded. Example: Ashcraft is coded A-261 (A, 2 for the S, C ignored, 6 for the R, 1 for the F). It is not coded A-226.

 

=={{header|360 Assembly}}==

{{trans|VBScript}}

An example of the use of the TR opcode (translate) and the uppercase trick by 'or' with space (X'40').

SOUNDEX CSECT

USING SOUNDEX,R13 base register

ORG

YREGS

{{out}}

<pre>

16 EXAMPLE E251

</pre>

 

=={{header|Ada}}==

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with Ada.Characters.Handling; use Ada.Characters.Handling;

Put_Line(To_String(cases(i))&" = "&toSoundex(To_String(cases(i))));

end loop;

{{out}}

<pre>Soundex = S532

Note: The only non-standard prelude functions used are to lower, is alpha, and is digit.

These are easy enough to write, vide [[String case#ALGOL 68|String case]]

BEGIN

PROC encode = (CHAR c) CHAR:

printf(($g, 1x, g, 1x$, expected output OF soundex test[i], output));

printf(($b("ok", "not ok"), 1l$, output = expected output OF soundex test[i]))

 

 

 

=={{header|AutoHotkey}}==

{{trans|VBScript}}

If c in B,F,P,V

return 1

}

 

 

=={{header|AWK}}==

The soundex function is embedded in a program to build a table of soundex "homonyms".

 

BEGIN {

subsep = ", "

}

}

 

 

</pre>

 

DATA Moses, Pfister, Robert, Rupert, Rubin, Tymczak, Soundex, Example

FOR i% = 1 TO 16

IF C% >= 97 IF C% <= 122 MID$(A$,A%,1) = CHR$(C%-32)

NEXT

{{out}}

<pre>

The word to translate is read from stdin, and its corresponding soundex encoding is written to stdout.

 

^$$_v#!*`*8 8\`\"["::-**84<

>$1^>:88*>v>$$1->vp7+2\"0"<

v$$:$$_^#\<1!-"0"<^1,<g7:<<

v??????????????????????????

 

{{out}} (multiple runs)

Ashcraft

A226</pre>

 

=={{header|C}}==

Some string examples and rules from [[http://www.archives.gov/research/census/soundex.html]].

#include <stdlib.h>

#include <string.h>

 

return 0;

 

=={{header|C sharp}}==

 

using System.Collections.Generic;

using System.Linq;

}

}

 

{{out}}

VanDeusen -> V532 (True)

Ashcraft -> A261 (True)

</pre>

 

=={{header|Caché ObjectScript}}==

 

Class Utils.Phonetic [ Abstract ]

{

 

}

{{out|Examples}}

<pre>

=={{header|Clipper/XBase++}}==

 

 

/*

RETURN(nMatch)

 

--[[User:Clippersolutions|Clippersolutions]] 23:14, 4 November 2010 (UTC)--[[User:Clippersolutions|Clippersolutions]] 23:14, 4 November 2010 (UTC)

 

=={{header|Clojure}}==

(case c

(\B \F \P \V) 1

(remove nil? ,)

(take 4 ,)

 

Bug here? The distinct function eliminates duplicates. What is needed in Soundex is to eliminate consecutive duplicates.

 

;;; With proper consecutive duplicates elimination

 

(recur (apply str first-char (rest the-rest)))

(let [soundex-nums (reduce reduce-fn [] the-rest)]

 

=={{header|COBOL}}==

{{works with|IBM Enterprise COBOL for z/OS}}

 

* Demonstrate the soundex encoding functions.

***************************************************************

else move 0 to char-sdx-code

end-if.

 

{{out}}

 

=={{header|Common Lisp}}==

(case c

((#\B #\F #\P #\V) #\1)

(push cg o)

finally

 

=={{header|Crystal}}==

{{trans|VBScript}}

 

def get_code(c : Char)

pairs.each { |pair|

puts "#{pair[0].ljust(9)} -> #{pair[1]} -> #{soundex(pair[0]) == pair[1]}"

 

{{out}}

===Standard Version===

The D standard library (Phobos) contains a soundex function:

import std.string: soundex;

 

assert(soundex("Ashcroft") == "A261");

assert(soundex("Tymczak") == "T522");

It works according to this document:

http://www.archives.gov/publications/general-info-leaflets/55.html

This version uses dynamic heap allocations in some places (replace, toupper, several string join) to allow a higher level style of coding, but this function may also be written to perform zero heap allocations. It may even return a char[4] by value, or use a given buffer like the C version.

 

 

/**

}

 

 

=={{header|Delphi}}==

 

{$APPTYPE CONSOLE}

 

uses

 

begin

{{out}}

<pre>

</pre>

 

=={{header|Elixir}}==

{{trans|Erlang}}

def soundex([]), do: []

def soundex(str) do

IO.puts Soundex.soundex("Example")

IO.puts Soundex.soundex("Sownteks")

 

{{out}}

=={{header|Erlang}}==

This implements the US Census rules, where W and H are ignored but, unlike vowels, are not separators.

-export([soundex/1]).

 

$0

end.

 

=={{header|F_Sharp|F#}}==

 

let soundex (s : string) =

 

0

{{out}}

<pre>

Wheaton W350 W350

</pre>

 

=={{header|Forth}}==

This implements the US Census rules, where W and H are ignored but, unlike vowels, aren't separators. Further corner cases welcome...

 

 

alpha-table soundex-code

s" Burroughs" soundex cr type \ B620

s" Burrows" soundex cr type \ B620 (W test) (any Welsh names?)

 

 

 

 

 

 

=={{header|FutureBasic}}==

 

 

end fn = outputStr

 

 

 

next

 

 

 

 

Output:

Steward = S363

Seward = S630

</pre>

 

=={{header|Groovy}}==

def soundex(s) {

def code = ""

println(soundex("Example"))

println(soundex("Ekzampul"))

 

=={{header|Haskell}}==

{{libheader|Text.PhoneticCode.Soundex}}

 

main :: IO ()

main =

mapM_ print $

{{Out}}

<pre>("Soundex","S532")

 

=={{header|Icon}} and {{header|Unicon}}==

every write(x := !arglist, " => ",soundex(x))

end

while name[upto('.',name)] := "" # kill .

return left(name,4,"0")

{{libheader|Icon Programming Library}} implements [http://www.cs.arizona.edu/icon/library/procs/soundex.htm soundex]. The above version is an adaptation of that procedure

 

=={{header|J}}==

'''Solution'''

codes =: ;: 'BFPV CGJKQSXZ DT L MN R HW'

if. 0=# k=.toupper y do. '0' return. end.

({.k), ,": ,. 3 {. 0-.~ }. removeDups 7 0:`(I.@:=)`]} , k >:@I.@:(e. &>)"0 _ codes

'''Usage'''

soundexNames=: 'L300 W422 D540 B625 W452 A226 E460 E460 G200 G200 H416 H416 K530 K530 L300 L222 L222'

 

B625

W452

'''Test'''

 

=={{header|Java}}==

{{trans|VBScript}}

System.out.println(soundex("Soundex"));

System.out.println(soundex("Example"));

soundex = (code + "0000").substring(0, 4);

return soundex;

{{out}}

<pre>S532

===ES5===

==== Version w/o RegExp ====

var a = s.toLowerCase().split('')

f = a.shift(),

// Burroughs B622 B622 true

// Burrows B620 B620 true

 

 

Note: This version differs from the one above in the following way. According to U.S. National Archives Website, consecutive consonants which map to the same code are not condensed to a single occurrence of the code if they are separated by vowels, but separating W and H do not thus intervene. Therefore Ashcraft is coded A261 and Burroughs is coded B620 rather than A226 and B622

 

function soundex(t) {

t = t.toUpperCase().replace(/[^A-Z]/g, '');

console.log('soundex("' + a + '") was ' + d + ' should be ' + t);

}

 

===ES6===

(Reusing set of tests from second contribution)

 

'use strict';

 

) : a;

}, '');

 

{{Out}}

=={{header|Julia}}==

There is a Soundex package for Julia. If that is used:

using Soundex

@assert soundex("Ashcroft") == "A261" # true

 

# Too trivial? OK. Here is an example not using a package:

function soundex(s)

char2num = Dict('B'=>1,'F'=>1,'P'=>1,'V'=>1,'C'=>2,'G'=>2,'J'=>2,'K'=>2,

hadvowel = false

end

hadvowel = true

end

end

ret *= "0"

end

end

@assert soundex("Ascroft") == "A261"

@assert soundex("Euler") == "E460"

@assert soundex("Burrows") == "B620"

@assert soundex("O'Hara") == "O600"

 

=={{header|Kotlin}}==

{{trans|VBScript}}

 

fun getCode(c: Char) = when (c) {

println("${pair.first.padEnd(9)} -> ${pair.second} -> ${soundex(pair.first) == pair.second}")

}

 

{{out}}

Example -> E251 -> true

</pre>

 

=={{header|Lua}}==

Adapt from D Alternative

d:gsub(".",function(c)

digits[string.char(alpha)] = c

assert( soundex(itm[1])==itm[2] )

end

{{out}}

<pre>all tests ok</pre>

 

{head, body} = {First@#, Rest@#}&@ToLowerCase@Characters@x;

body = (Select[body, FreeQ[Characters["aeiouyhw"],#]&] /. {("b"|"f"|"p"|"v")->1,

body = DeleteDuplicates[body]

];

Example usage:

<pre>Map[Soundex,{"Soundex", "Sownteks", "Example", "Ekzampul"}]

 

=={{header|MUMPS}}==

;Converts a string to its Soundex value.

;Empty strings return "0000". Non-alphabetic ASCII characters are ignored.

KILL UP,LO,PREFIX,X1,X2,Y2,C,DX,XD

QUIT Y

<p>Examples:<pre>

USER>W $$SOUNDEX^SOUNDEX("")

USER>W $$SOUNDEX^SOUNDEX("ghoti")

G300</pre></p>

 

=={{header|OCaml}}==

Here is an implementation:

 

| 'B' | 'F' | 'P' | 'V' -> "1"

| 'C' | 'G' | 'J' | 'K' | 'Q' | 'S' | 'X' | 'Z' -> "2"

match dbl [] (List.rev !cl) with

| c::rem -> (String.make 1 c) ^ (soundex_aux rem)

 

Test our implementation:

 

"Soundex", "S532";

"Example", "E251";

let status = if code1 = code2 then "OK " else "Arg" in

Printf.printf " \"%s\" \t %s %s %s\n" word code1 code2 status

 

{{out}}

{{works with|Free Pascal|2.6.2}}

 

 

{$mode objfpc}{$H+}

end;

ReadLn;

 

{{out}}

=={{header|Perl}}==

The <tt>Text::Soundex</tt> core module supports various soundex algorithms.

print soundex("Soundex"), "\n"; # S532

print soundex("Example"), "\n"; # E251

print soundex("Sownteks"), "\n"; # S532

 

{{out}}

 

=={{header|PHP}}==

PHP already has a built-in <tt>soundex()</tt> function:

echo soundex("Soundex"), "\n"; // S532

echo soundex("Example"), "\n"; // E251

echo soundex("Sownteks"), "\n"; // S532

echo soundex("Ekzampul"), "\n"; // E251

 

=={{header|PicoLisp}}==

Simple:

(pack

(pad -4

(<> Last C)

(setq Last C) ) )

NARA:

(let (Str (chop Str) Last)

(pack

(<> Last C)

(setq Last C) ) )

 

=={{header|PL/I}}==

declare pword character (*) varying, value character (length(pword)) varying;

declare word character (length(pword));

return ( left(value, 4, '0') ); /* Pad, if necessary. */

 

=={{header|PowerShell}}==

{{works with|PowerShell 3.0}}

function Get-Soundex

{

}

}

"Ashcraft", "Ashcroft", "Gauss", "Ghosh", "Hilbert", "Heilbronn", "Lee", "Lloyd",

"Moses", "Pfister", "Robert", "Rupert", "Rubin", "Tymczak", "Soundex", "Example" | Get-Soundex

{{Out}}

<pre>

Soundex S532

Example E251

</pre>

 

=={{header|Prolog}}==

Note: Rather than produce a terse and incomprehensible example, this demonstrates how simply a set of logical rules can be translated into Prolog.

% Implements the American soundex algorithm

% as described at https://en.wikipedia.org/wiki/Soundex

test :- test('Tymczak', 't522'), !, fail.

test :- test('Pfister', 'p236'), !, fail.

 

=={{header|PureBasic}}==

Protected getCode.s = ""

word = UCase(word)

code = Mid(word,1,1)

For i = 2 To (Len(word) + 1)

current = getCode(Mid(word, i, 1))

 

PrintN (soundex("Lukasiewicz"))

 

=={{header|Python}}==

 

def soundex(word):

sdx3 = sdx2[0:4].ljust(4,'0')

return sdx3

{{out}}

S532

>>>print soundex("example")

C532

>>>print soundex("ekzampul")

 

=={{header|Racket}}==

The [http://rosettacode.org/wiki/Soundex#Scheme Scheme solution] runs as is in Racket.

 

=={{header|REXX}}==

:* &nbsp; letters of the ASCII-extended character set are ignored.

:* &nbsp; ASCII-extended characters (ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜíóúñÑ) could be added to the program easily.

_=; @.= /*set a couple of vars to "null".*/

parse arg @.0 . /*allow input from command line. */

end /*j*/

 

'''output''' &nbsp; when using the default (internal) inputs:

<pre style="height:33ex">

[ok] W452 is the Soundex for Williams

[ok] W422 is the Soundex for Woolcock

</pre>

 

=={{header|Ruby}}==

Courtesy http://snippets.dzone.com/posts/show/4530

 

SoundexChars = 'BFPVCGJKQSXZDTLMNR'

print word1.sounds_like(word2) ? "sounds" : "does not sound"

print " like '#{word2}'\n"

 

<pre>Soundex -> S532

=={{header|Run BASIC}}==

Courtesy http://dkokenge.com/rbp

val$(1) = "BPFV"

val$(2) = "CSGJKQXZ"

next i

soundex$ = left$(a$,1) + left$(sdx$;"000",3)

 

<pre>Robert soundex:R163

O'Mally soundex:O054

d jay soundex:D200</pre>

 

=={{header|Scala}}==

var code=s.head.toUpper.toString

var previous=getCode(code.head)

case _ => ""

}

 

val tests=Map(

"Soundex" -> "S532",

printf("Name: %-20s Code: %s Found: %s - %s\n", v._1, v._2, code, status)

}

 

=={{header|Scheme}}==

{{works with|any R6RS Scheme}}

 

;;

;; The soundex code consist of the first letter of the name followed

(soundex "Uhrbach")

(soundex "Moskowitz")

 

{{out}}

> "M232"

> "M213"

</pre>

 

=={{header|Sidef}}==

 

# Uppercase the argument passed in to normalize it

 

# Discard the first letter

 

# Remove A, E, H, I, O, U, W, and Y

}

 

 

=={{header|SNOBOL4}}==

US National Archives (NARA) Soundex. Includes the "HW" rule omitted by Knuth and many other implementations.

 

* # ABCDEFGHIJKLMNOPQRSTUVWXYZ

* # 01230127022455012623017202

loop test span(' ') break(' ') . name = :f(end)

output = soundex(name) ' ' name :(loop)

 

{{out}}

S460 Swhgler

O256 O'Connor</pre>

 

=={{header|Standard ML}}==

This implementation uses datatypes to encode the different rules for handling duplicate digits

when different characters appear in the input:

* h and w are ignored completely (letters separated by h or w are considered

* adjacent, or merged together)

val () = test "Rubin" "R150"

val () = test "Tymczak" "T522"

 

=={{header|Stata}}==

The soundex function is built-in. See [http://www.stata.com/help.cgi?soundex Stata help].

A261

 

. display soundex_nara("Tymczak")

=={{header|Tcl}}==

{{tcllib|soundex}} contains an implementation of Knuth's soundex algorithm.

 

foreach string {"Soundex" "Example" "Sownteks" "Ekzampul"} {

set soundexCode [soundex::knuth $string]

puts "\"$string\" has code $soundexCode"

{{out}}

<pre>"Soundex" has code S532

"Sownteks" has code S532

"Ekzampul" has code E251</pre>

 

=={{header|TSE SAL}}==

 

// library: string: get: soundex <description></description> <version>1.0.0.0.35</version> <version control></version control> (filenamemacro=getstgso.s) [kn, ri, sa, 15-10-2011 18:23:04]

END

 

 

=={{header|TUSCRIPT}}==

$$ MODE DATA

 

PRINT first,soundex,"=",n

ENDLOOP

{{out}}

<pre style='height:30ex;overflow:scroll'>

This implements the full Soundex described in [[http://www.archives.gov/research/census/soundex.html U.S. National Archives Website]]. Doubled letters are condensed before separating the first letter, so that for instance "Lloyd" is not treated as L followed by the coding of LOYD but as L followed by the coding of OYD. Consecutive consonants which map to the same code are not condensed to a single occurrence of the code if they are separated by vowels, but separating W and H do not thus intervene. Names with common prefixes are encoded in two ways.

 

@###

@# soundex-related filters

"@first_arg" and "@second_arg" match under soundex

@ (end)

 

Run:

This solution is similar to some of the solutions in other languages. Its treatment of the algorithm is not as complete as the above solution.

 

(caseq c

((#\B #\F #\P #\V) #\1)

@arg -> @(soundex arg)

@ (end)

 

Run:

The following functions require this associative array to be declared:

 

[B]=1 [F]=1 [P]=1 [V]=1

[C]=2 [G]=2 [J]=2 [K]=2 [Q]=2 [S]=2 [X]=2 [Z]=2

[M]=5 [N]=5

[R]=6

 

The first algorithm described at https://en.wikipedia.org/wiki/Soundex#American_Soundex can be implemented like this:

 

local -u word=${1//[^[:alpha:]]/.}

local letter=${word:0:1}

soundex+="000"

echo "${soundex:0:4}"

 

The "simplified" algorithm can be implemented like this:

 

local -u word=${1//[^[:alpha:]]/}

 

word+="000"

echo "${word:0:4}"

 

If we cheat a bit and allow calling out to `tr`, we can do:

 

local -u word=${1//[^[:alpha:]]/}

 

word+="000"

echo "${word:0:4}"

 

And some testing code:

 

[Soundex]=S532 [Example]=E251 [Sownteks]=S532 [Ekzampul]=E251

[Euler]=E460 [Gauss]=G200 [Hilbert]=H416 [Knuth]=K530

run_tests soundex

run_tests soundex2

 

{{out}}

 

=={{header|VBScript}}==

tt=array( _

"Ashcraft","Ashcroft","Gauss","Ghosh","Hilbert","Heilbronn","Lee","Lloyd", _

soundex = Mid(code & "000", 1, 4)

End Function 'soundex

{{out}}

<pre>

14 Soundex S532

15 Example E251

</pre>

 

=={{header|XPL0}}==

string 0; \use zero-terminated strings

 

Text(0, Name(I)); CrLf(0);

];

 

{{out}}