Soundex is an algorithm for creating indices for words based on their pronunciation.



Task

The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling   (from the   soundex   Wikipedia article).

Caution

There is a major issue in many of the implementations concerning the separation of two consonants that have the same soundex code! According to the official Rules [[1]]. So check for instance if Ashcraft is coded to A-261.

 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.


 
 
// 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]
STRING PROC FNStringGetSoundexS( STRING inS )
 // Except the first character, you replace each character in the string with its corresponding mapping number
 // Idea is that you give characters with the same sound the same mapping number (e.g. 'c' is replaced by '2'. And 'k' which might sound the same as a 'c' is also replaced by the same '2'
 STRING map1S[255] = "AEHIOUWYBFPVCGJKQSXZDTLMNR"
 STRING map2S[255] = "00000000111122222222334556"
 STRING s[255] = Upper( inS )
 STRING soundexS[255] = ""
 STRING characterCurrentS[255] = ""
 STRING characterPreviousS[255] = "?"
 STRING characterMapS[255] = ""
 INTEGER mapPositionI = 0
 INTEGER minI = 1
 INTEGER I = minI
 INTEGER maxI = Length( s )
 I = minI
 characterCurrentS = SubStr( s, I, 1 )
 mapPositionI = Pos( characterCurrentS, map1S )
 WHILE ( ( I <= maxI ) AND ( Length( soundexS ) < 4 ) AND ( NOT ( mapPositionI == 0 ) ) )
  // Skip double letters, like CC, KK, PP, ...
  IF ( NOT ( mapPositionI == 0 ) ) AND ( NOT ( characterCurrentS == characterPreviousS ) )
   characterPreviousS = characterCurrentS
   // First character is extracted unchanged, for sorting purposes.
   IF ( I == minI )
    soundexS = Format( soundexS, characterCurrentS )
   ELSE
    mapPositionI = Pos( characterCurrentS, map1S )
    IF ( NOT ( mapPositionI == 0 ) )
     characterMapS = SubStr( map2S, mapPositionI, 1 )
     // skip vowels A, E, I, O, U, further also H, W and Y. In general all characters which have a mapping value of "0"
     IF ( NOT ( characterMapS == "0" ) )
      soundexS = Format( soundexS, characterMapS )
     ENDIF
    ENDIF
   ENDIF
  ENDIF
  I = I + 1
  characterCurrentS = SubStr( s, I, 1 )
 ENDWHILE
 IF ( NOT ( soundexS == "" ) )
  WHILE ( Length( soundexS ) < 4 )
   soundexS = Format( soundexS, "0" )
  ENDWHILE
 ENDIF
 RETURN( soundexS )
END
 
PROC Main()
 STRING s1[255] = "John Doe"
 // Warn( Format( FNStringGetSoundexS( "Ashcraft" ) ) ) // gives e.g. "A226" // using another rule the value might be "A261" (see Wikipedia, soundex)
 // Warn( Format( FNStringGetSoundexS( "Ashcroft" ) ) ) // gives e.g. "A226" // using another rule the value might be "A261" (see Wikipedia, soundex)
 // Warn( Format( FNStringGetSoundexS( "Davidson, Greg" ) ) ) // gives e.g. "D132"
 // Warn( Format( FNStringGetSoundexS( "Dracula" ) ) ) // gives e.g. "D624"
 // Warn( Format( FNStringGetSoundexS( "Drakula" ) ) ) // gives e.g. "D624"
 // Warn( Format( FNStringGetSoundexS( "Darwin" ) ) ) // gives e.g. "D650"
 // Warn( Format( FNStringGetSoundexS( "Darwin, Daemon" ) ) ) // gives e.g. "D650"
 // Warn( Format( FNStringGetSoundexS( "Darwin, Ian" ) ) ) // gives e.g. "D650"
 // Warn( Format( FNStringGetSoundexS( "Derwin" ) ) ) // gives e.g. "D650"
 // Warn( Format( FNStringGetSoundexS( "Darwent, William" ) ) ) // gives e.g. "D653"
 // Warn( Format( FNStringGetSoundexS( "Ellery" ) ) ) // gives e.g. "E460"
 // Warn( Format( FNStringGetSoundexS( "Euler" ) ) ) // gives e.g. "E460"
 // Warn( Format( FNStringGetSoundexS( "Ghosh" ) ) ) // gives e.g. "G200"
 // Warn( Format( FNStringGetSoundexS( "Gauss" ) ) ) // gives e.g. "G200"
 // Warn( Format( FNStringGetSoundexS( "Heilbronn" ) ) ) // gives e.g. "H416"
 // Warn( Format( FNStringGetSoundexS( "Hilbert" ) ) ) // gives e.g. "H416"
 // Warn( Format( FNStringGetSoundexS( "Johnny" ) ) ) // gives e.g. "J500"
 // Warn( Format( FNStringGetSoundexS( "Jonny" ) ) ) // gives e.g. "J500"
 // Warn( Format( FNStringGetSoundexS( "Kant" ) ) ) // gives e.g. "K530"
 // Warn( Format( FNStringGetSoundexS( "Knuth" ) ) ) // gives e.g. "K530"
 // Warn( Format( FNStringGetSoundexS( "Lissajous" ) ) ) // gives e.g. "L222"
 // Warn( Format( FNStringGetSoundexS( "Lukasiewicz" ) ) ) // gives e.g. "L222"
 // Warn( Format( FNStringGetSoundexS( "Ladd" ) ) ) // gives e.g. "L300"
 // Warn( Format( FNStringGetSoundexS( "Lloyd" ) ) ) // gives e.g. "L300"
 // Warn( Format( FNStringGetSoundexS( "Rubin" ) ) ) // gives e.g. "R150"
 // Warn( Format( FNStringGetSoundexS( "Robert" ) ) ) // gives e.g. "R163"
 // Warn( Format( FNStringGetSoundexS( "Rupert" ) ) ) // gives e.g. "R163"
 REPEAT
  IF ( NOT ( Ask( "string: get: soundex = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
  Warn( Format( FNStringGetSoundexS( s1 ) ) )
 UNTIL FALSE
END
 
 