Skip to content

Instantly share code, notes, and snippets.

@ericnormand ericnormand/00

Last active Aug 4, 2019
What would you like to do?


Soundex is an algorithm that attempts to encode two similar-sounding English words to the same value. It does this by dropping vowels and encoding consonants to numbers in a lossy way.

The algorithm is described on Wikipedia as "American Soundex". The challenge this week is to implement Soundex.

(ns soundex.main
(:require [clojure.string :as str]))
(def letters->code {#{\B \F \P \V} 1
#{\C \G \J \K \Q \S \X \Z} 2
#{\D \T} 3
#{\L} 4
#{\M \N} 5
#{\R} 6})
(def letter->code (reduce-kv (fn [m letters code]
(reduce #(assoc %1 %2 code) m letters))
(defn soundex-seq [letters]
(loop [letters letters
prev-code nil]
(if letters
(let [[letter & remaining] letters
code (letter->code letter)]
(if prev-code
(if (= prev-code code)
(recur remaining prev-code)
(if (#{\H \W} letter)
(recur remaining prev-code)
(lazy-seq (cons prev-code (soundex-seq letters)))))
(recur remaining code)))
(when prev-code
(defn soundex [s]
(let [[first-letter & _ :as letters] (str/upper-case s)
result (take 4 (soundex-seq letters))
result (cond-> result (letter->code first-letter) rest)]
(apply str first-letter (take 3 (concat result (repeat 0))))))
And then a simple test file (sadly, merely example-based; I told you I was interested in learning about PBT!):
(ns soundex.main-test
(:require [clojure.test :refer [deftest is]]
[soundex.main :refer [soundex]]))
(deftest soundex-test
(is (= "R163" (soundex "Robert")))
(is (= "R163" (soundex "Rupert")))
(is (= "R150" (soundex "Rubin")))
(is (= "A261" (soundex "Ashcraft")))
(is (= "A261" (soundex "Ashcroft")))
(is (= "T522" (soundex "Tymczak")))
(is (= "P236" (soundex "Pfister")))
(is (= "H555" (soundex "Honeyman"))))
Hello Eric,
Here is my submission for issue 337.
(ns scratchpad.pftv.337
(:require [clojure.test :refer [deftest is testing run-tests]]))
(defn consonant-mapping [ch]
(case (Character/toLowerCase ch)
(\h \w) -1
(\b \f \p \v) 1
(\c \g \j \k \q \s \x \z) 2
(\d \t) 3
(\l) 4
(\m \n) 5
(\r) 6
(defn consonant? [ch]
(let [c (consonant-mapping ch)]
(and c (> c 0))))
(defn calculate-digits [name]
(fn [[prev acc] digit]
(nil? digit) [nil acc] ;; skip vowels
(= digit -1) [prev acc] ;; skip h/w but remember previous prev
(= digit prev) [prev acc] ;; same consonant
:else [digit (conj acc digit)]))
[nil []]
(map consonant-mapping name))))
(defn soundex [name]
(let [first-letter (first name)
all-digits (calculate-digits name)
;; drop the first digit if first letter is a consonant
digits (if (consonant? first-letter)
(rest all-digits)
(apply str first-letter
;; right pad with zeroes
(take 3 (concat digits (repeat 0))))))
(deftest test-soundex
(testing "Examples from Wikipedia"
(is (= (soundex "Robert") (soundex "Rupert")))
(is (= "R150" (soundex "Rubin")))
(is (= (soundex "Ashcraft") (soundex "Ashcroft")))
(is (= "T522" (soundex "Tymczak" )))
(is (= "P236" (soundex "Pfister")))
(is (= "H555" (soundex "Honeyman")))))
(defn vc-code [c]
(case 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
(\A \E \I \O \U \Y \H \W) 0))
(defn drop-consec-dups [s]
(map first (partition-by identity s)))
(defn drop-first-dup [a s]
(if (= (vc-code a) (first s)) (rest s) s))
(defn soundex [s]
(let [[f & s] (clojure.string/upper-case s)]
(->> (map vc-code s)
(remove #(= 0 %))
(drop-first-dup f)
(cons f)
((fn [s] (concat s "000")))
(take 4)
(apply str))))
;; Tests
[(= "A226" (soundex "Ashcroft") (soundex "Ashcraft"))
(= "R150" (soundex "Rubin"))
(= "H555" (soundex "Honeyman"))
(= "J500" (soundex "Jackson"))
(= "T522" (soundex "Tymczak"))
(= "P236" (soundex "Pfister"))
(= "R163" (soundex "Robert") (soundex "Rupert"))
(= "G362" (soundex "Gutierrez"))
(= "L000" (soundex "Lee"))
(= "W252" (soundex "Washington"))]
(ns miner.soundex
(:require [clojure.string :as str]))
;; Clojure challenge: soundex
(defn encode [ch]
(case ch
(\b \B \f \F \p \P \v \V) 1
(\c \C \g \G \j \J \k \K \q \Q \s \S \x \X \z \Z) 2
(\d \D \t \T) 3
(\l \L) 4
(\m \M \n \N) 5
(\r \R) 6
(\h \H \w \W) -1
(defn soundex [word]
(when-let [cs (seq word)]
(let [c (first cs)
d (if (pos-int? (encode c)) 1 0)
sdx (into [(str/upper-case c)]
(comp (map encode) (remove neg?) (dedupe)
(remove zero?) (drop d) (take 3))
(apply str (into sdx (repeat (- 4 (count sdx)) 0))))))
(defn smoke-test-soundex []
(doseq [[word sdx] {"Soundex", "S532"
"Example", "E251"
"Sownteks", "S532"
"Ekzampul", "E251"
"Euler", "E460"
"Gauss", "G200"
"Hilbert", "H416"
"Knuth", "K530"
"Lloyd", "L300"
"Lukasiewicz", "L222"
"Ellery", "E460"
"Ghosh", "G200"
"Heilbronn", "H416"
"HONEYMAN", "H555"
"Rubin", "R150"
"robert", "R163"
"Rupert", "R163"
"Kant", "K530"
"Ladd", "L300"
"Lissajous", "L222"
"Wheaton", "W350"
"Burroughs", "B620"
"Burrows", "B620"
"O'Hara", "O600"
"Washington", "W252"
"Lee", "L000"
"Gutierrez", "G362"
"Pfister", "P236"
"Jackson", "J250"
"Tymczak", "T522"
"VanDeusen", "V532"
"Ashcroft", "A261"
"Ashcraft", "A261"}]
(assert (= (soundex word) sdx) word))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.