Natural Language Processing
I have a Natural Language Processing (NLP) library that I wrote in Common Lisp. Here we will use code that I wrote in pure Scheme and converted to Racket.
The NLP library is still a work in progress so please check for future updates to this live eBook.
Since we will use the example code in this chapter as a library we start by defining a main.rkt file:
1 #lang racket/base
2
3 (require "fasttag.rkt")
4 (require "names.rkt")
5
6 (provide parts-of-speech)
7 (provide find-human-names)
8 (provide find-place-names)
There are two main source files for the NLP library: fasttag.rkt and names.rkt.
The following listing of fasttag.rkt is a conversion of original code I wrote in Java and later translated to Common Lisp. The provided Racket Scheme code is designed to perform part-of-speech tagging for a given list of words. The code begins by loading a hash table (lex-hash) from a data file (“data/tag.dat”), where each key-value pair maps a word to its possible part of speech. Then it defines several helper functions and transformation rules for categorizing words based on various syntactic and morphological criteria.
The core function, parts-of-speech, takes a vector of words and returns a vector of corresponding parts of speech. Inside this function, a number of rules are applied to each word in the list to refine its part of speech based on both its individual characteristics and its context within the list. For instance, Rule 1 changes the part of speech to “NN” (noun) if the previous word is “DT” (determiner) and the current word is categorized as a verb form (“VBD”, “VBP”, or “VB”). Rule 2 changes a word to a cardinal number (“CD”) if it contains a period, and so on. The function applies these rules in sequence, updating the part of speech for each word accordingly.
The parts-of-speech function iterates over each word in the input vector, checks it against lex-hash, and then applies the predefined rules. The result is a new vector of tags, one for each input word, where each tag represents the most likely part of speech for that word, based on the rules and the original lexicon.
1 #lang racket
2
3 (require srfi/13) ; the string SRFI
4 (require racket/runtime-path)
5
6 (provide parts-of-speech)
7
8 (define-runtime-path my-data-path "data")
9
10 ;; FastTag.lisp
11 ;;
12 ;; Conversion of KnowledgeBooks.com Java FastTag to Scheme
13 ;;
14 ;; Copyright 2002 by Mark Watson. All rights reserved.
15 ;;
16
17
18 (display "loading lex-hash...")
19 (log-info "loading lex-hash" "starting")
20 (define lex-hash
21 (let ((hash (make-hash)))
22 (with-input-from-file
23 (string-append (path->string my-data-path) "/tag.dat")
24 (lambda ()
25 (let loop ()
26 (let ((p (read)))
27 (if (list? p) (hash-set! hash (car p) (cadr p)) #f)
28 (if (eof-object? p) #f (loop))))))
29 hash))
30 (display "...done.")
31 (log-info "loading lex-hash" "ending")
32
33 (define (string-suffix? pattern str)
34 (let loop ((i (- (string-length pattern) 1)) (j (- (string-length str) 1)))
35 (cond
36 ((negative? i) #t)
37 ((negative? j) #f)
38 ((char=? (string-ref pattern i) (string-ref str j))
39 (loop (- i 1) (- j 1)))
40 (else #f))))
41 ;;
42 ; parts-of-speech
43 ;
44 ; input: a vector of words (each a string)
45 ; output: a vector of parts of speech
46 ;;
47
48 (define (parts-of-speech words)
49 (display "\n+ tagging:") (display words)
50 (let ((ret '())
51 (r #f)
52 (lastRet #f)
53 (lastWord #f))
54 (for-each
55 (lambda (w)
56 (set! r (hash-ref lex-hash w #f))
57 ;; if this word is not in the hash table, try making it ll lower case:
58 (if (not r)
59 (set! r '("NN"))
60 #f)
61 ;;(if (list? r) (set! r (car r))))
62 ;; apply transformation rules:
63
64 ; rule 1: DT, {VBD, VBP, VB} --> DT, NN
65 (if (equal? lastRet "DT")
66 (if (or
67 (equal? r "VBD")
68 (equal? r "VBP")
69 (equal? r "VB"))
70 (set! r '("NN"))
71 #f)
72 #f)
73 ; rule 2: convert a noun to a number if a "." appears in the word
74 (if (string-contains "." w) (set! r '("CD")) #f)
75
76 ; rule 3: convert a noun to a past participle if word ends with "ed"
77 (if (equal? (member "N" r) 0)
78 (let* ((slen (string-length w)))
79 (if (and
80 (> slen 1)
81 (equal? (substring w (- slen 2)) "ed"))
82 (set! r "VBN") #f))
83 #f)
84
85 ; rule 4: convert any type to an adverb if it ends with "ly"
86 (let ((i (string-suffix? "ly" w)))
87 (if (equal? i (- (string-length w) 2))
88 (set! r '("RB"))
89 #f))
90
91 ; rule 5: convert a common noun (NN or NNS) to an adjective
92 ; if it ends with "al"
93 (if (or
94 (member "NN" r)
95 (member "NNS" r))
96 (let ((i (string-suffix? "al" w)))
97 (if (equal? i (- (string-length w) 2))
98 (set! r '("RB"))
99 #f))
100 #f)
101
102 ; rule 6: convert a noun to a verb if the receeding word is "would"
103 (if (equal? (member "NN" r) 0)
104 (if (equal? lastWord "would")
105 (set! r '("VB"))
106 #f)
107 #f)
108
109 ; rule 7: if a word has been categorized as a common noun and it
110 ; ends with "s", then set its type to a plural noun (NNS)
111 (if (member "NN" r)
112 (let ((i (string-suffix? "s" w)))
113 (if (equal? i (- (string-length w) 1))
114 (set! r '("NNS"))
115 #f))
116 #f)
117
118 ; rule 8: convert a common noun to a present participle verb
119 ; (i.e., a gerand)
120 (if (equal? (member "NN" r) 0)
121 (let ((i (string-suffix? "ing" w)))
122 (if (equal? i (- (string-length w) 3))
123 (set! r '("VBG"))
124 #f))
125 #f)
126
127 (set! lastRet ret)
128 (set! lastWord w)
129 (set! ret (cons (first r) ret)))
130 (vector->list words)) ;; not very efficient !!
131 (list->vector (reverse ret))))
The following listing of file names.rkt identifies human and place names in text. The Racket Scheme code is a script for Named Entity Recognition (NER). It is specifically designed to recognize human names and place names in given text:
- It provides two main functions:
find-human-namesandfind-place-names. - Uses two kinds of data: human names and place names, loaded from text files.
- Employs Part-of-Speech tagging through an external
fasttag.rktmodule. - Uses hash tables and lists for efficient look-up.
- Handles names with various components (prefixes, first name, last name, etc.)
The function process-one-word-per-line reads each line of a file and applies a given function func on it.
Initial data preparation consists of defining the hash tables *last-name-hash*, *first-name-hash*, *place-name-hash* are populated with last names, first names, and place names, respectively, from specified data files.
We define two Named Entity Recognition (NER) functions:
-
find-human-names: Takes a word vector and an exclusion list.- Utilizes parts-of-speech tags.
- Checks for names that have 1 to 4 words.
- Adds names to
retlist if conditions are met, considering the exclusion list. - Returns processed names (
ret2).
-
find-place-names: Similar tofind-human-names, but specifically for place names.- Works on 1 to 3 word place names.
- Returns processed place names.
We define one helper functions not-in-list-find-names-helper to ensures that an identified name does not overlap with another name or entry in the exclusion list.
Overall, the code is fairly optimized for its purpose, utilizing hash tables for constant-time look-up and lists to store identified entities.
1 #lang racket
2
3 (require "fasttag.rkt")
4 (require racket/runtime-path)
5 (provide find-human-names)
6 (provide find-place-names)
7
8 (define-runtime-path my-data-path "data")
9
10 (define (process-one-word-per-line file-path func)
11 (with-input-from-file file-path
12 (lambda ()
13 (let loop ()
14 (let ([l (read-line)])
15 (if (equal? l #f) #f (func l))
16 (if (eof-object? l) #f (loop)))))))
17
18 (define *last-name-hash* (make-hash))
19 (process-one-word-per-line
20 (string-append
21 (path->string my-data-path)
22 "/human_names/names.last")
23 (lambda (x) (hash-set! *last-name-hash* x #t)))
24 (define *first-name-hash* (make-hash))
25 (process-one-word-per-line
26 (string-append
27 (path->string my-data-path)
28 "/human_names/names.male")
29 (lambda (x) (hash-set! *first-name-hash* x #t)))
30 (process-one-word-per-line
31 (string-append
32 (path->string my-data-path)
33 "/human_names/names.female")
34 (lambda (x) (hash-set! *first-name-hash* x #t)))
35
36 (define *place-name-hash* (make-hash))
37 (process-one-word-per-line
38 (string-append
39 (path->string my-data-path)
40 "/placenames.txt")
41 (lambda (x) (hash-set! *place-name-hash* x #t)))
42 (define *name-prefix-list*
43 '("Mr" "Mrs" "Ms" "Gen" "General" "Maj" "Major" "Doctor" "Vice" "President"
44 "Lt" "Premier" "Senator" "Congressman" "Prince" "King" "Representative"
45 "Sen" "St" "Dr"))
46
47 (define (not-in-list-find-names-helper a-list start end)
48 (let ((rval #t))
49 (do ((x a-list (cdr x)))
50 ((or
51 (null? x)
52 (let ()
53 (if (or
54 (and
55 (>= start (caar x))
56 (<= start (cadar x)))
57 (and
58 (>= end (caar x))
59 (<= end (cadar x))))
60 (set! rval #f)
61 #f)
62 (not rval)))))
63 rval))
64
65 ;; return a list of sublists, each sublist looks like:
66 ;; (("John" "Smith") (11 12) 0.75) ; last number is an importance rating
67 (define (find-human-names word-vector exclusion-list)
68 (define (score result-list)
69 (- 1.0 (* 0.2 (- 4 (length result-list)))))
70 (let ((tags (parts-of-speech word-vector))
71 (ret '()) (ret2 '()) (x '())
72 (len (vector-length word-vector))
73 (word #f))
74 (display "\ntags: ") (display tags)
75 ;;(dotimes (i len)
76 (for/list ([i (in-range len)])
77 (set! word (vector-ref word-vector i))
78 (display "\nword: ") (display word)
79 ;; process 4 word names: HUMAN NAMES
80 (if (< i (- len 3))
81 ;; case #1: single element from '*name-prefix-list*'
82 (if (and
83 (not-in-list-find-names-helper ret i (+ i 4))
84 (not-in-list-find-names-helper exclusion-list i (+ i 4))
85 (member word *name-prefix-list*)
86 (equal? "." (vector-ref word-vector (+ i 1)))
87 (hash-ref *first-name-hash* (vector-ref word-vector (+ i 2)) #f)
88 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 3)) #f))
89 (if (and
90 (string-prefix? (vector-ref tags (+ i 2)) "NN")
91 (string-prefix? (vector-ref tags (+ i 3)) "NN"))
92 (set! ret (cons (list i (+ i 4)) ret))
93 #f)
94 #f)
95 ;; case #1: two elements from '*name-prefix-list*'
96 (if (and
97 (not-in-list-find-names-helper ret i (+ i 4))
98 (not-in-list-find-names-helper exclusion-list i (+ i 4))
99 (member word *name-prefix-list*)
100 (member (vector-ref word-vector (+ i 1)) *name-prefix-list*)
101 (hash-ref *first-name-hash* (vector-ref word-vector (+ i 2)) #f)
102 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 3)) #f))
103 (if (and
104 (string-prefix? (vector-ref tags (+ i 2)) "NN")
105 (string-prefix? (vector-ref tags (+ i 3)) "NN"))
106 (set! ret (cons (list i (+ i 4)) ret))
107 #f)
108 #f))
109 ;; process 3 word names: HUMAN NAMES
110 (if (< i (- len 2))
111 (if (and
112 (not-in-list-find-names-helper ret i (+ i 3))
113 (not-in-list-find-names-helper exclusion-list i (+ i 3)))
114 (if (or
115 (and
116 (member word *name-prefix-list*)
117 (hash-ref *first-name-hash* (vector-ref word-vector (+ i 1)) #f)
118 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 2)) #f)
119 (string-prefix? (vector-ref tags (+ i 1)) "NN")
120 (string-prefix? (vector-ref tags (+ i 2)) "NN"))
121 (and
122 (member word *name-prefix-list*)
123 (member (vector-ref word-vector (+ i 1)) *name-prefix-list*)
124 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 2)) #f)
125 (string-prefix? (vector-ref tags (+ i 1)) "NN")
126 (string-prefix? (vector-ref tags (+ i 2)) "NN"))
127 (and
128 (member word *name-prefix-list*)
129 (equal? "." (vector-ref word-vector (+ i 1)))
130 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 2)) #f)
131 (string-prefix? (vector-ref tags (+ i 2)) "NN"))
132 (and
133 (hash-ref *first-name-hash* word #f)
134 (hash-ref *first-name-hash* (vector-ref word-vector (+ i 1)) #f)
135 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 2)) #f)
136 (string-prefix? (vector-ref tags i) "NN")
137 (string-prefix? (vector-ref tags (+ i 1)) "NN")
138 (string-prefix? (vector-ref tags (+ i 2)) "NN")))
139 (set! ret (cons (list i (+ i 3)) ret))
140 #f)
141 #f)
142 #f)
143 ;; process 2 word names: HUMAN NAMES
144 (if (< i (- len 1))
145 (if (and
146 (not-in-list-find-names-helper ret i (+ i 2))
147 (not-in-list-find-names-helper exclusion-list i (+ i 2)))
148 (if (or
149 (and
150 (member word '("Mr" "Mrs" "Ms" "Doctor" "President" "Premier"))
151 (string-prefix? (vector-ref tags (+ i 1)) "NN")
152 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 1)) #f))
153 (and
154 (hash-ref *first-name-hash* word #f)
155 (hash-ref *last-name-hash* (vector-ref word-vector (+ i 1)) #f)
156 (string-prefix? (vector-ref tags i) "NN")
157 (string-prefix? (vector-ref tags (+ i 1)) "NN")))
158 (set! ret (cons (list i (+ i 2)) ret))
159 #f)
160 #f)
161 #f)
162 ;; 1 word names: HUMAN NAMES
163 (if (hash-ref *last-name-hash* word #f)
164 (if (and
165 (string-prefix? (vector-ref tags i) "NN")
166 (not-in-list-find-names-helper ret i (+ i 1))
167 (not-in-list-find-names-helper exclusion-list i (+ i 1)))
168 (set! ret (cons (list i (+ i 1)) ret))
169 #f)
170 #f))
171 ;; TBD: calculate importance rating based on number of occurences of name in text:
172 (set! ret2
173 (map (lambda (index-pair)
174 (string-replace
175 (string-join (vector->list (vector-copy word-vector (car index-pair) (cadr index-pair))))
176 " ." "."))
177 ret))
178 ret2))
179
180 (define (find-place-names word-vector exclusion-list) ;; PLACE
181 (define (score result-list)
182 (- 1.0 (* 0.2 (- 4 (length result-list)))))
183 (let ((tags (parts-of-speech word-vector))
184 (ret '()) (ret2 '()) (x '())
185 (len (vector-length word-vector))
186 (word #f))
187 (display "\ntags: ") (display tags)
188 ;;(dotimes (i len)
189 (for/list ([i (in-range len)])
190 (set! word (vector-ref word-vector i))
191 (display "\nword: ") (display word) (display "\n")
192 ;; process 3 word names: PLACE
193 (if (< i (- len 2))
194 (if (and
195 (not-in-list-find-names-helper ret i (+ i 3))
196 (not-in-list-find-names-helper exclusion-list i (+ i 3)))
197 (let ((p-name (string-append word " " (vector-ref word-vector (+ i 1)) " " (vector-ref word-vector (+ i 2)))))
198 (if (hash-ref *place-name-hash* p-name #f)
199 (set! ret (cons (list i (+ i 3)) ret))
200 #f))
201 #f)
202 #f)
203 ;; process 2 word names: PLACE
204 (if (< i (- len 1))
205 (if (and
206 (not-in-list-find-names-helper ret i (+ i 2))
207 (not-in-list-find-names-helper exclusion-list i (+ i 2)))
208 (let ((p-name (string-append word " " (vector-ref word-vector (+ i 1)))))
209 (if (hash-ref *place-name-hash* p-name #f)
210 (set! ret (cons (list i (+ i 2)) ret))
211 #f)
212 #f)
213 #f)
214 #f)
215 ;; 1 word names: PLACE
216 (if (hash-ref *place-name-hash* word #f)
217 (if (and
218 (string-prefix? (vector-ref tags i) "NN")
219 (not-in-list-find-names-helper ret i (+ i 1))
220 (not-in-list-find-names-helper exclusion-list i (+ i 1)))
221 (set! ret (cons (list i (+ i 1)) ret))
222 #f)
223 #f))
224 ;; TBD: calculate importance rating based on number of occurences of name in text: can use (count-substring..) defined in utils.rkt
225 (set! ret2
226 (map (lambda (index-pair)
227 (string-join (vector->list (vector-copy word-vector (car index-pair) (cadr index-pair))) " "))
228 ret))
229 ret2))
230
231 #|
232 (define nn (find-human-names '#("President" "George" "Bush" "went" "to" "San" "Diego" "to" "meet" "Ms" "." "Jones" "and" "Gen" "." "Pervez" "Musharraf" ".") '()))
233 (display (find-place-names '#("George" "Bush" "went" "to" "San" "Diego" "and" "London") '()))
234 |#
Let’s try some examples in a Racket REPL:
1 > Racket-AI-book/source-code/nlp $ racket
2 Welcome to Racket v8.10 [cs].
3 > (require nlp)
4 loading lex-hash......done.#f
5 > (find-human-names '#("President" "George" "Bush" "went" "to" "San" "Diego" "to" "meet" "Ms" "." "Jones
6 " "and" "Gen" "." "Pervez" "Musharraf" ".") '())
7
8 + tagging:#(President George Bush went to San Diego to meet Ms . Jones and Gen . Pervez Musharraf .)
9 tags: #(NNP NNP NNP VBD TO NNP NNP TO VB NNP CD NNP CC NNP CD NN NN CD)
10 word: President
11 word: George
12 word: Bush
13 word: went
14 word: to
15 word: San
16 word: Diego
17 word: to
18 word: meet
19 word: Ms
20 word: .
21 word: Jones
22 word: and
23 word: Gen
24 word: .
25 word: Pervez
26 word: Musharraf
27 word: .'("Gen. Pervez Musharraf" "Ms. Jones" "San" "President George Bush")
28 > (find-place-names '#("George" "Bush" "went" "to" "San" "Diego" "and" "London") '())
29
30 + tagging:#(George Bush went to San Diego and London)
31 tags: #(NNP NNP VBD TO NNP NNP CC NNP)
32 word: George
33
34 word: Bush
35
36 word: went
37
38 word: to
39
40 word: San
41
42 word: Diego
43
44 word: and
45
46 word: London
47 '("London" "San Diego")
48 >
The following diagram shows the high-level architecture of the NLP library developed in this chapter:
NLP Wrap Up
The NLP library is still a work in progress so please check for updates to this live eBook and the GitHub repository for this book:
Optional Practice Problems
- Dynamic Lexicon Updates: The Part-of-Speech tagger loads its word lexicon from static files. Implement a function
add-to-lexicon!that allows developers to dynamically register new words and their corresponding tags at runtime without modifying the source data files. - Enhance Named Entity Recognition (NER): Heuristics in
names.rktextract sequences of proper nouns (NNP). Extend these rules to correctly handle titles (e.g., “Dr.”, “Professor”) and middle initials (e.g., “George W. Bush”) when extracting complete names. - Sentence Tokenizer: Implement a sentence tokenizer function that segments paragraphs into individual sentences. Make sure it correctly distinguishes between sentence-ending punctuation and abbreviations such as “e.g.”, “i.e.”, or “Ms.”.