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.


;; The American Soundex System
;;
;; The soundex code consist of the first letter of the name followed
;; by three digits. These three digits are determined by dropping the
;; letters a, e, i, o, u, h, w and y and adding three digits from the
;; remaining letters of the name according to the table below. There
;; are only two additional rules. (1) If two or more consecutive
;; letters have the same code, they are coded as one letter. (2) If
;; there are an insufficient numbers of letters to make the three
;; digits, the remaining digits are set to zero.
 
;; Soundex Table
 
;;  1 b,f,p,v
;;  2 c,g,j,k,q,s,x,z
;;  3 d, t
;;  4 l
;;  5 m, n
;;  6 r
 
;; Examples:
 
;;  Miller M460
;;  Peterson P362
;;  Peters P362
;;  Auerbach A612
;;  Uhrbach U612
;;  Moskowitz M232
;;  Moskovitz M213
 
(define (char->soundex c)
  (case (char-upcase c)
    ((#\B #\F #\P #\V) #\1)
    ((#\C #\G #\J #\K #\Q #\S #\X #\Z) #\2)
    ((#\D #\T) #\3)
    ((#\L) #\4)
    ((#\M #\N) #\5)
    ((#\R) #\6)
    (else #\nul)))
 
(define (collapse-dups lst)
  (if (= (length lst) 1) lst
      (if (equal? (car lst) (cadr lst))
	  (collapse-dups (cdr lst))
	  (cons (car lst) (collapse-dups (cdr lst))))))
 
(define (remove-nul lst)
  (filter (lambda (c)
	    (not (equal? c #\nul)))
	  lst))
 
(define (force-len n lst)
  (cond ((= n 0) '())
	((null? lst) (force-len n (list #\0)))
	(else (cons (car lst) (force-len (- n 1) (cdr lst))))))
 
(define (soundex s)
  (let ((slst (string->list s)))
    (force-len 4 (cons (char-upcase (car slst))
		       (remove-nul
			(collapse-dups
			 (map char->soundex (cdr slst))))))))
 
(soundex "miller")
(soundex "Peterson")
(soundex "PETERS")
(soundex "auerbach")
(soundex "Uhrbach")
(soundex "Moskowitz")
(soundex "Moskovitz")