; implement soundex from a purer rule based perspective ; three srages: marking :remove uninteresting, adjacent same letters or same codes ; encoding: change letters to codes, drop # ; report : show first four of the code numbers with three zeros suffixed (deffacts background (letters A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) (letters a b c d e f g h i j k l m n o p q r s t u v w x y z) (deletes A E I O U H W Y ) (soundex 1 B P F V ) (soundex 2 C S G J K Q X Z) (soundex 3 D T) (soundex 4 L) (soundex 5 M N) (soundex 6 R) (step 1) (marking) ) (defrule deleteUninteresting (marking) ?n<-(name ?init $?A ?ch&~# $?B) (not (soundex $? ?ch $?)) => (retract ?n) (assert (name ?init $?A # $?B))) (defrule deleteDoubled (marking) ?n<-(name $?A ?ch1&~# ?ch2&~# $?B) (soundex ?sc1 $? ?ch1 $?) (soundex ?sc2 $? ?ch2 $?) (test (or (eq ?ch1 ?ch2) (eq ?sc1 ?sc2))) => (retract ?n) (assert (name $?A ?ch1 # $?B))) (defrule toEncode (declare (salience -10)) ?s<-(marking) => (retract ?s) (assert (encode))) (defrule code (encode) ?n<-(name ?init $?A ?ch $?B) (soundex ?sc $? ?ch $?) => (retract ?n) (assert (name ?init $?A ?sc $?B))) (defrule drop# (encode) ?n<-(name ?init $?A # $?B) => (retract ?n) (assert (name ?init $?A $?B))) (defrule toReport (declare (salience -10)) ?s<-(encode) => (retract ?s) (assert (report))) (defrule chopNFill (report) ?f<-(name $?name) => (assert (soundex (subseq$ (create$ $?name 0 0 0) 1 4)))) ;------------------------------------------------ (defrule bust (declare (salience 500)) (person ?name) => (bind $?list (create$)) (loop-for-count (?i 1 (str-length ?name)) (bind ?ch (upcase (sub-string ?i ?i ?name))) (bind $?list (create$ $?list (sym-cat ?ch))) ) (assert (name $?list))) (deffacts KnuthTests (person Euler) ; -> E460 (person Ellery) ; -> E460 (person Gauss) ; -> G200 (person Ghosh) ; -> G200 (person Hilbert) ; -> H416 (person Heilbronn) ; -> H416 (person Knuth) ; -> K530 (person Kant) ; -> K530 (person Lloyd) ; -> L300 (person Ladd) ; -> L300 (person Lukasiewicz) ; -> L222 (person Lissajous) ; -> L222 ) |