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