Soundex: Difference between revisions

{{trans|Java}}

 

‘1’ = [‘B’, ‘F’, ‘P’, ‘V’],

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

print(soundex(‘Example’))

print(soundex(‘Sownteks’))

 

{{out}}

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

 

=={{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|Arturo}}==

 

"aeiouy": `W`

"bfpv": `1`

loop ["Robert", "Rupert", "Rubin", "Ashcraft", "Ashcroft", "Tymczak",

"Pfister", "Honeyman", "Moses", "O'Mally", "O'Hara", "D day"] 'name ->

 

{{out}}

=={{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}}

 

=={{header|C++}}==

#include <iostream> // required for debug code in main() only

#include <iomanip> // required for debug code in main() only

}

 

{{out|Example output}}

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

 

=={{header|Factor}}==

"soundex" soundex ! S532

"example" soundex ! E251

"ciondecks" soundex ! C532

 

=={{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|FreeBASIC}}==

{{trans|PureBasic}}

Function getCode(c As String) As String

If Instr("BFPV", c) Then Return "1"

Data "Moses", "Pfister", "Robert", "Rupert", "Rubin", "Tymczak", "VanDeusen", "Wheaton", "Soundex", "Example"

Sleep

 

 

=={{header|FutureBasic}}==

 

 

end fn = outputStr

 

 

 

next

 

 

 

 

Output:

=={{header|Go}}==

WP article rules, plus my interpretation for input validation.

 

import (

}

}

{{out}}

<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|IS-BASIC}}==

110 FOR I=1 TO 20

120 READ NAME$

270 END DEF

280 DATA Aschraft,Ashcroft,Euler,Gauss,Ghosh,Hilbert,Heilbronn,Lee,Lissajous,Lloyd

 

=={{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

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

=={{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>

 

=={{header|Mathematica}}/{{header|Wolfram Language}}==

{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("")

=={{header|NetRexx}}==

{{trans|Rexx}}

class Soundex

 

say test[i].left(10) get_soundex(test[i]) '=' result_[i]

end

{{out}}

<pre>

 

=={{header|Nim}}==

 

const

for name in ["Robert", "Rupert", "Rubin", "Ashcraft", "Ashcroft", "Tymczak",

"Pfister", "Honeyman", "Moses", "O'Mally", "O'Hara", "D day"]:

 

{{out}}

{{trans|Java}}

 

function : Main(args : String[]) ~ Nil {

SoundEx("Soundex")->PrintLine();

}

}

 

{{out}}

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

 

=={{header|Phix}}==

{{out}}

<pre>

=={{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>

===Alternative Version===

Here we're using as much PowerShell native functionaity as possible, without reaching deep into .NET libraries. The goal here is to have script that can be called from the prompt to be easily used in other scripts.

# script Soundex.ps1

Param([string]$Phrase)

$src[0] + ((-join $($coded2 | Where { $_ -ne 'v'})) + "000").Substring(0,3)

}

 

Function t([string]$value, [string]$expect) {

$result = .\Soundex.ps1 -Phrase $value

(t "Wheaton" "W350");

) | Format-Table -Property Value,Expect,Result,Pass

{{Out}}

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

 

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

US census algorithm, so "Ashcraft" and "Burroughs" adjusted to match.

We fake up a first consonant in some cases to make up for the fact that we always trim the first numeric code (so that the 'l' of 'Lloyd' is properly deleted).

my $first = substr($name,0,1).uc;

gather {

my $s2 = soundex($n);

say $n.fmt("%16s "), $s, $s eq $s2 ?? " OK" !! " NOT OK $s2";

{{out}}

<pre> Soundex S532 OK

:* &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">

 

=={{header|Ring}}==

# Project: Soundex

 

next

return left(s + "000", 4)

Output:

<pre>

"Soundex" S532

"Example" E251

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

 

=={{header|SenseTalk}}==

"Heilbronn","Hilbert","Honeyman","Jackson","Lee","LeGrand","Lissajous","Lloyd",

"Moses","Pfister","Robert","Rupert","Rubin","Tymczak","VanDeusen","Van de Graaff","Wheaton"]

return soundex

end soundex

{{out}}

<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|Smalltalk}}==

{{works with|Smalltalk/X}}

using a builtin utility:

 

=={{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}}

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

 

There is also a variant:

 

 

=={{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

=={{header|TMG}}==

Unix TMG:

let: peek/done

[ch = ch>140 ? ch-40 : ch ]

ch: 0;

l1: 0;

 

=={{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>

{{libheader|Wren-str}}

{{libheader|Wren-fmt}}

 

var getCode = Fn.new { |c|

for (pair in pairs) {

Fmt.print("$-9s -> $s -> $s", pair[0], pair[1], soundex.call(pair[0]) == pair[1])

 

{{out}}

 

=={{header|XPL0}}==

string 0; \use zero-terminated strings

 

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

];

 

{{out}}