Peter Siebel - Practical Common Lisp

(defun clear-database ()

(setf *feature-database* (make-hash-table :test #'equal)))

To find the features present in a given message, the code will need to extract the individual words and then look up the corresponding word-featureobject in *feature-database*. If *feature-database*contains no such feature, it'll need to create a new word-featureto represent the word. You can encapsulate that bit of logic in a function, intern-feature, that takes a word and returns the appropriate feature, creating it if necessary.

(defun intern-feature (word)

(or (gethash word *feature-database*)

(setf (gethash word *feature-database*)

(make-instance 'word-feature :word word))))

You can extract the individual words from the message text using a regular expression. For example, using the Common Lisp Portable Perl-Compatible Regular Expression (CL-PPCRE) library written by Edi Weitz, you can write extract-wordslike this: [249] A version of CL-PPCRE is included with the book's source code available from the book's Web site. Or you can download it from Weitz's site at http://www.weitz.de/cl-ppcre/ .

(defun extract-words (text)

(delete-duplicates

(cl-ppcre:all-matches-as-strings "[a-zA-Z]{3,}" text)

:test #'string=))

Now all that remains to implement extract-featuresis to put extract-featuresand intern-featuretogether. Since extract-wordsreturns a list of strings and you want a list with each string translated to the corresponding word-feature, this is a perfect time to use MAPCAR .

(defun extract-features (text)

(mapcar #'intern-feature (extract-words text)))

You can test these functions at the REPL like this:

SPAM> (extract-words "foo bar baz")

("foo" "bar" "baz")

And you can make sure the DELETE-DUPLICATES is working like this:

SPAM> (extract-words "foo bar baz foo bar")

("baz" "foo" "bar")

You can also test extract-features.

SPAM> (extract-features "foo bar baz foo bar")

(# #

#)

However, as you can see, the default method for printing arbitrary objects isn't very informative. As you work on this program, it'll be useful to be able to print word-featureobjects in a less opaque way. Luckily, as I mentioned in Chapter 17, the printing of all objects is implemented in terms of a generic function PRINT-OBJECT , so to change the way word-featureobjects are printed, you just need to define a method on PRINT-OBJECT that specializes on word-feature. To make implementing such methods easier, Common Lisp provides the macro PRINT-UNREADABLE-OBJECT . [250] The main reason to use PRINT-UNREADABLE-OBJECT is that it takes care of signaling the appropriate error if someone tries to print your object readably, such as with the ~S FORMAT directive.

The basic form of PRINT-UNREADABLE-OBJECT is as follows:

(print-unreadable-object ( object stream-variable &key type identity )

body-form *)

The object argument is an expression that evaluates to the object to be printed. Within the body of PRINT-UNREADABLE-OBJECT , stream-variable is bound to a stream to which you can print anything you want. Whatever you print to that stream will be output by PRINT-UNREADABLE-OBJECT and enclosed in the standard syntax for unreadable objects, #<>. [251] PRINT-UNREADABLE-OBJECT also signals an error if it's used when the printer control variable *PRINT-READABLY* is true. Thus, a PRINT-OBJECT method consisting solely of a PRINT-UNREADABLE-OBJECT form will correctly implement the PRINT-OBJECT contract with regard to *PRINT-READABLY* .

PRINT-UNREADABLE-OBJECT also lets you include the type of the object and an indication of the object's identity via the keyword parameters type and identity . If they're non- NIL , the output will start with the name of the object's class and end with an indication of the object's identity similar to what's printed by the default PRINT-OBJECT method for STANDARD-OBJECT s. For word-feature, you probably want to define a PRINT-OBJECT method that includes the type but not the identity along with the values of the word, ham-count, and spam-countslots. Such a method would look like this:

(defmethod print-object ((object word-feature) stream)

(print-unreadable-object (object stream :type t)

(with-slots (word ham-count spam-count) object

(format stream "~s :hams ~d :spams ~d" word ham-count spam-count))))

Now when you test extract-featuresat the REPL, you can see more clearly what features are being extracted.

SPAM> (extract-features "foo bar baz foo bar")

(#

#

#)

Now that you have a way to keep track of individual features, you're almost ready to implement score. But first you need to write the code you'll use to train the spam filter so scorewill have some data to use. You'll define a function, train, that takes some text and a symbol indicating what kind of message it is— hamor spam—and that increments either the ham count or the spam count of all the features present in the text as well as a global count of hams or spams processed. Again, you can take a top-down approach and implement it in terms of other functions that don't yet exist.

(defun train (text type)

(dolist (feature (extract-features text))

(increment-count feature type))

(increment-total-count type))

You've already written extract-features, so next up is increment-count, which takes a word-featureand a message type and increments the appropriate slot of the feature. Since there's no reason to think that the logic of incrementing these counts is going to change for different kinds of objects, you can write this as a regular function. [252] If you decide later that you do need to have different versions of increment-feature for different classes, you can redefine increment-count as a generic function and this function as a method specialized on word-feature . Because you defined both ham-countand spam-countwith an :accessoroption, you can use INCF and the accessor functions created by DEFCLASS to increment the appropriate slot.

(defun increment-count (feature type)

(ecase type

(ham (incf (ham-count feature)))

(spam (incf (spam-count feature)))))

The ECASE construct is a variant of CASE , both of which are similar to casestatements in Algol-derived languages (renamed switchin C and its progeny). They both evaluate their first argument—the key form —and then find the clause whose first element—the key —is the same value according to EQL . In this case, that means the variable typeis evaluated, yielding whatever value was passed as the second argument to increment-count.