Defining a perceptron to classify messages

1 Setup

(require 2htdp/batch-io)

(require racket/string) ; Just for string-split

; A Vector (x) is a [List-of Numbers]

(define spam-emails

(list "buy these drugs" "drugs for sale" "how to buy buy buy"))

(define ham-emails

(list "how was your break?" "did you buy bread?"))

; A Vocabulary is a [List-of Strings]

(define VOCAB

(list "bread" "break" "sale" "buy" "drugs" "for" "these" "you" "your" "how" "to"))

; Add two vectors. Assumes equal length.

; Vector Vector -> Vector

(check-expect (vector+ (list 1 2 3) (list 4 5 6)) (list 5 7 9))

(define (vector+ v1 v2)

(cond

[(and (empty? v1) (empty? v2)) '()]

[else (cons (+ (first v1) (first v2))

(vector+ (rest v1) (rest v2)))]))

; Retrieves the index of a given word in

; the provided vocabulary (list of words).

; w2idx : String Vocabulary -> Maybe Number

(check-expect (w2idx "break") 1)

(check-expect (w2idx "eggs") #false)

(define (w2idx w)

(local [; ACCUMULATOR: just keep track of current index

(define (w2idx/a vocab idx)

(cond

[(empty? vocab) #false] ; This word is not in our vocab

[(string=? (first vocab) w) idx]

[(cons? vocab) (w2idx/a (rest vocab) (add1 idx))]))]

(w2idx/a VOCAB 0)))

; Map a word to a "one-hot" vector encoding it.

; word2vector : String -> Vector

(check-expect (word2vector "bread") (list 1 0 0 0 0 0 0 0 0 0 0))

(check-expect (word2vector "to") (list 0 0 0 0 0 0 0 0 0 0 1))

(check-expect (word2vector "drugs") (list 0 0 0 0 1 0 0 0 0 0 0))

(check-expect (word2vector "eggs") (list  0 0 0 0 0 0 0 0 0 0 0))

(define (word2vector w)

(local [; look-up the index for this word.

(define w-idx (w2idx w))]

(cond

[(boolean? w-idx) (make-zero-vector (length VOCAB))]

[else

(append (make-zero-vector w-idx) (list 1)

(make-zero-vector (sub1 (- (length VOCAB) w-idx))))])))

; Create a "zero vector" (vector w/all zero entries)

; of the given size.

; make-zero-vector : Number -> Vector

(check-expect (make-zero-vector 10) (list 0 0 0 0 0 0 0 0 0 0))

(define (make-zero-vector size)

(build-list size (lambda (whatever) 0)))

; Create a vector representation of a given text, in particular

; using the "bag of words" encoding.

; text2vector : String -> Vector

(check-expect (text2vector "bread drugs") (list 1 0 0 0 1 0 0 0 0 0 0))

(define (text2vector s)

(local [

(define init-s-vec (make-zero-vector (length VOCAB)))

; Make a list of word vectors for each word in the string.

(define list-of-word-vecs (map word2vector (string-split s)))]

(foldr vector+ (make-zero-vector (length VOCAB)) list-of-word-vecs)))

; A Label (y) is one of:

;   1

;   -1

(define-struct instance [x y])

; An Instance is a (make-instance Vector Label)

(define (strs-to-instances strs label)

(local [; Create an instance using a given

; String and the provided label.

(define (str-to-instance s)

(make-instance (text2vector s) label))]

(map str-to-instance strs)))

(define spam-instances (strs-to-instances spam-emails 1))

(define ham-instances (strs-to-instances ham-emails -1))

2 The perceptron itself

(define inst0 (make-instance (list 1 0.5 1) 1))

(define inst1 (make-instance (list 1 0.2 0.2) -1))

(define inst2 (make-instance (list 1 0.3 0.2) -1))

(define inst3 (make-instance (list 1 0.8 0.5) 1))

(define w0 (list 0 0 0))

(define w1 (list 0.2 0.1 0.2))

; expect: (0 0 0) + .2 * (1 .5 1) = (.2 .1 .2)

(check-expect (observe-point inst0 w0 0.2) w1)

; now should be unchanged because it will classify correctly

(check-expect (observe-point inst0 w1 0.2) w1)

; This will result in a mistake:

;  (1 .3 .2) * (.2 .1 .2) = .3 –> 1

; Update:

;  (.2 .1 .2) - (1 .2 .2) = (-.8 -.1 0)

(check-expect (observe-point inst1 w1 1) (list -0.8 -0.1 0))

; observe-point : Instance Vector Number -> Vector

; Consumes a labeled example (an Instance) and a weight

; vector, and a learning rate, and produces a new weight vector

; that is modified in accordance with the instance

;

(define (observe-point instance w alpha)

(local

[

(define x (instance-x instance))

(define y (instance-y instance))

; current prdiction

(define y-hat (predict w x))

; update-w : Label -> Vector

; Returns a new weight vector adjusted for the mistake

(define (update-w direction)

; w + direction (\alpha * x)

(vector+ w (scalar-mult (* alpha direction) x))) ; WISHLIST scalar-mult]

(cond

[(= y-hat y) w]

; mistake need to update w

[else (update-w (* -1 y-hat))])))

; Makes a prediction for x in terms of its class label, given

; a weight vector

; predict : Vector Vector -> Label

(define (predict w x)

(sign (vector* w x)))

; Take a dot product between two vectors. Assume equal length.

; Vector Vector -> Number

(check-expect (vector* (list 1 2 3) (list 4 5 6)) 32)

(define (vector* v1 v2)

(cond

[(and (empty? v1) (empty? v2)) 0]

[else (+ (* (first v1) (first v2))

(vector* (rest v1) (rest v2)))]))

; sign : Number -> Label

; Return 1 if the number is positive; -1 otherwise

(define (sign a)

(if (positive? a) 1 -1))

; Multiply a vector by a constant

; scalar-mult : Number Vector -> Vector

(define (scalar-mult scalar vec)

(map (λ (x) (* x scalar)) vec))

; train-on-instances : [List-of Instances] Number Vector -> Vector

; Learns a weight vector that separates the given instances

(define training-set  (list inst0 inst1 inst3 inst2))

(define some-points (list inst1))

(check-expect (train-on-instances some-points 1 (list 1 0.8 0.8)) (list 0 0.6 0.6))

(define (train-on-instances instances alpha w-t)

(cond

[(empty? instances) w-t]

[(cons? instances)

(train-on-instances (rest instances) alpha

(observe-point (first instances) w-t alpha))]))