[comp.ai.digest] Soundex algorithm

JZEM@MARIST.BITNET (William J. Joel) (07/18/88)

Date: Wed, 13 Jul 88 10:35 EDT
From: William J. Joel <JZEM%MARIST.BITNET@MITVMA.MIT.EDU>
Subject:      Re: Soundex algorithm
To: AILIST@AI.AI.MIT.EDU

/* The following is source code for a Soundex algorithm written in */
/* Waterloo Prolog. */
/* William J. Joel*/
/* Marist College */
/* Poughkeepsie, NY */
/* jzem@marist.bitnet */

key(a,-1).
key(b,1).
key(c,2).
key(d,3).
key(e,-1).
key(f,1).
key(g,2).
key(h,-2).
key(i,0).
key(j,2).
key(k,2).
key(l,4).
key(m,5).
key(n,5).
key(o,-1).
key(p,1).
key(q,2).
key(r,6).
key(s,2).
key(t,3).
key(u,-1).
key(v,1).
key(w,-3).
key(x,2).
key(y,-2).
key(z,2).

soundex(Name,Code)<-
   string(Name,Code1) & write(Code1) &
   soundex1(Code1,A.B.C.D.Rem) &
   string(Code,A.B.C.D.nil).

soundex1(Head.Code1,Head.Code)<-
   keycode(Head.Code1,Code2) & write(Code2) &
   reduce(Code2,T.Code3) & write(T.Code3) &
   eliminate(Code3,Code4) & write(Code4) &
   append(Code4,0.0.0.nil,Code).

reduce(X.(-2).X.Rem,List)<-
   reduce(X.Rem,List).
reduce(X.X.Rem,List)<-
   reduce(X.Rem,List).
reduce(X.Y.Z.Rem,X.List)<-
   ^X==Z &
   reduce(Y.Z.Rem,List).
reduce(X.Y.Rem,X.List)<-
   ^X==Y &
   reduce(Y.Rem,List).
reduce(X.nil,X.nil).
reduce(nil,nil).

eliminate(X.Rem,List)<-
   lt(X,0) &
   eliminate(Rem,List).
eliminate(X.Rem,X.List)<-
   gt(X,0) &
   eliminate(Rem,List).
eliminate(nil,nil).

keycode(H.T,N.CodeList)<-
   key(H,N) &
   keycode(T,CodeList).
keycode(nil,nil).


append(Head.Tail,List,Head.NewList)<-
   append(Tail,List,NewList).
append(nil,List,List).