;;; useful functions for LISP natural language parsing program
;;; Set up the parse-obj and word-dict
(setf parse-obj (MAKE-HASH-TABLE))
(setf word-dict (MAKE-HASH-TABLE))
(setf table-ht (MAKE-HASH-TABLE))
;;; processRequest
;;; Parameters:
;;; request - a list of words making a request
;;; Purpose:
;;; - Sets up necessary information (see below) and invokes the student's checkRequest
;;; function.
;;; - Since the student's checkRequest sets the parts of speech, processRequest prints
;;; those parts of speech.
;;; - Returns T if the request is a valid request. Otherwise, NIL is returned.
;;; Notes:
;;; - Sets the parse-obj hash table to contain the request
;;; - Sets the cursor position to zero.
;;; - Uses resetPartsOfSpeech to reset the values of each part of speech.
;;; - Prints the request
;;; - Invokes checkRequest to check for valid syntax and prints
;;; the result.
;;; - Prints the value for each part of speech
;;; - Invokes makeDBRequest to generate a database request from the parts of speech
;;; Notes:
;;; - Requests will not contain punctuation since
;;; -- commas have a meaning in Common LISP associated with backquote
;;; -- periods are used for dotted pairs
;;;
(defun processRequest(request)
(PROG (result)
;;; Save the request in parse-obj.
(putp 'request parse-obj request) ;; KEY=request; VAL=whatever the request was
;;; Set the cursor position to 0.
(putp 'cursor parse-obj 0)
;;; reset the parts of speech to NIL
(resetPartsOfSpeech parse-obj 'verb 'directObj 'prep 'indirectObj 'QualIndirectPrep 'QualIndirectObj)
(resetPartsOfSpeech parse-obj 'Comparator 'NotQual 'QualPrep 'QualValue)
(format T "~% ******************************************************************")
(format T "~% ~a" request)
(setf result (checkRequest parse-Obj))
(format T "~% checkRequest returned ~a" result)
(format T "~% verb= ~a" (getp 'verb parse-obj))
(format T "~% directObj= ~a" (getp 'directObj parse-obj))
(format T "~% prep= ~a" (getp 'prep parse-obj))
(format T "~% indirectObj= ~a" (getp 'indirectObj parse-obj))
;;; if we have a qual indirect, show it (SECOND FORM)
(cond ((or (getp 'QualIndirectPrep parse-obj)
(getp 'QualIndirectObj parse-obj))
(format T "~% QualIndirectPrep= ~a" (getp 'QualIndirectPrep parse-obj))
(format T "~% QualIndirectObj= ~a" (getp 'QualIndirectObj parse-obj))
))
(cond ((or (getp 'Comparator parse-obj)
(getp 'NotQual parse-obj)
(getp 'QualPrep parse-obj)
(getp 'QualValue parse-obj))
(if (getp 'NotQual parse-obj)
(format T "~% NotQual = ~a" (getp 'NotQual parse-obj)))
(format T "~% Comparator= ~a" (getp 'Comparator parse-obj))
(format T "~% QualPrep= ~a" (getp 'QualPrep parse-obj))
(format T "~% QualValue= ~a" (getp 'QualValue parse-obj))
))
(if (not result) (return result))
;;; see if doing extra credit, return if not
(if (NOT doingExtra)
(return result))
;;; generate the SQL and show that SQL query
(setf query (genSQL parse-Obj))
(format T "~% DBRequest= ~a" query)
(return result) ) )
;;; putp
;;; Parameters:
;;; symbol - symbol to be given the property value
;;; ht - hash table to store the symbol and its property value
;;; value - the property value
;;; Purpose:
;;; stores the property value for the symbol in the specified hash table
;;; Notes:
;;; If the symbol isn't an ATOM, putp breaks execution with an ERROR.
;;; Example Usage:
;;; (putp 'prep parse preposition)
;;; (putp word word-dict partOfSpeech)
;;; KEY VALUE
(defun putp (symbol ht value)
(if (ATOM symbol)
(setf (gethash symbol ht) value)
(ERROR "~s is not a valid symbol for putp" symbol)
)
)
;;; getp
;;; Parameters:
;;; symbol - symbol about which we want its property value
;;; ht - hash table which stores the symbol and its property value
;;; Purpose:
;;; Returns the property value for the symbol in the specified hash table
;;; If not found, it returns NIL.
;;; Example Usage:
;;; (getp word word-dict) would return the partOfSpeech for that word
;;; (getp 'request parse-obj) would return the original request from the parse-obj.
(defun getp (symbol ht)
(gethash symbol ht) )
;;; getCursor
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; Purpose:
;;; returns the current cursor position (relative to zero)
(defun getCursor (parse)
(getp 'cursor parse) ) ;; should be a number
;;; setCursor
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; cursorPosition - new cursor position
;;; Purpose:
;;; Sets the value of the cursor position (relative to zero) in the
;;; parse object
;;; Notes:
;;; If the cursorPosition isn't a numeric, setCursor breaks execution
;;; with an ERROR.
(defun setCursor (parse cursorPosition)
(if (numberp cursorPosition)
(putp 'cursor parse cursorPosition)
(ERROR "~s is not a numeric argument for setCursor" cursorPosition)
)
)
;;; getToken
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; Purpose:
;;; returns the next token from the request. If there are no more
;;; tokens, it returns NIL.
;;; Notes:
;;; This modifies the cursor position after getting the current token
;;; at the old position.
(defun getToken (parse)
(prog (temp)
(setf temp (nth (getp 'cursor parse) (getp 'request parse)))
(setCursor parse (1+ (getp 'cursor parse)))
(return temp) ) )
;;; checkRequest
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; Purpose:
;;; Checks for a valid reqest according based on the request passed in
;;; from the parse-obj and returns T if the request is valid; otherwise
;;; it returns NIL. Additionally, checkRequest also saves identified parts
;;; of speech.
;;; Notes:
;;; -Parts of speech are validated at the end based on what values they
;;; have in the parse-obj hash table.
;;; -wordCount keeps a count of the number of words passed in and
;;; articleCount keeps a count of the number of articles passed in. This
;;; is done to determine which form the request is in by doing
;;; wordCount - articleCount
(defun checkRequest (parse)
(PROG (result)
(setf result T) ; initially T unless otherwise later
(setf word (getToken parse))
(setf articleCount 0) ; keep track of article count
(do ()
((NULL word)) ; loop until no more words
(setf wordCount (getCursor parse)) ; authorizes which conditions to enter
(if (isa word 'verb) (putp 'verb parse word))
(if (isa word 'article) ; if word was an article increment count
(prog ()
(putp 'article parse word)
(+= articleCount 1) ) )
;; FIRST FORM (VERB DIRECTOBJ PREP INDIRECTOBJ)
(if (EQL (- wordCount articleCount) 3)
(prog ()
(if (isa word 'prep) (putp 'prep parse word))
; Set back by 2 to get directObj
(setCursor parse (- (getCursor parse) 2))
(setf w (getToken parse))
(if (isa w 'noun) (putp 'directObj parse w))
; Set forward by 1 to get indirectObj
(setCursor parse (+ 1 (getCursor parse)))
(setf w (getToken parse))
(if (isa w 'article) ; check for article
(prog ()
(setf w (getToken parse)) ; sets cursor forward
(putp 'article parse word)
(+= articleCount 1) ) )
(if (isa w 'noun) (putp 'indirectObj parse w) ) ) )
;; SECOND FORM (FIRSTFORM + QUALIFIERS + COMPARATOR) 1/2
(if (EQL (- wordCount articleCount) 5)
(prog ()
(if (isa word 'prep) (putp 'QualIndirectPrep parse word))
(setf w (getToken parse)) ; check for article
(if (isa w 'article)
(prog ()
(setf w (getToken parse))
(putp 'article parse word)
(+= articleCount 1) ) )
(if (isa w' adjective) ;check for adjective
(prog ()
(putp 'QualValue parse w) ; set it as QualValue
(setf w (getToken parse)) ; in order to get QualInObj
(putp 'comparator parse 'EQUAL) ; hardcoded for adjective
(putp 'QualPrep parse 'TO) ) ) ; hardcoded for adjective
(if (isa w 'noun) (putp 'QualIndirectObj parse w)) ) )
;; SECOND FORM (FIRSTFORM + QUALIFIERS + COMPARATOR) 2/2
(if (EQL (- wordCount articleCount) 7)
(prog ()
(if (EQL word 'NOT) ; check for NotQual
(prog ()
(putp 'NotQual parse word)
(setf word (getToken parse)) ) )
(if (isa word 'comparator) (putp 'comparator parse word))
(setf w (getToken parse)) ; w=prep || w=QualVal
(if (isa w 'prep) ; check for optional QualPrep
(prog ()
(putp 'QualPrep parse w)
(setf w (getToken parse)) ) ) ; move up cursor if QualPrep
(if (NULL (getp 'QualValue parse)) (putp 'QualValue parse w)) ) )
(setf word (getToken parse)) )
;; ALWAYS CHECK
(if (NULL (getp 'verb parse)) (return NIL))
(if (NULL (getp 'directObj parse)) (return NIL))
(if (NULL (getp 'prep parse)) (return NIL))
(if (NULL (getp 'indirectObj parse)) (return NIL))
;; CHECK IF MORE THAN 4 WORDS (SECOND FORM)
(if (AND (> wordCount 4) (NULL (getp 'QualIndirectPrep parse))) (return NIL))
(if (AND (> wordCount 4) (NULL (getp 'QualIndirectObj parse))) (return NIL))
(if (AND (NOT (NULL (getp 'NotQual parse))) (NOT (EQL (getp 'NotQual parse)'NOT))) (return NIL))
(if (AND (> wordCount 4) (NULL (getp 'comparator parse))) (return NIL))
(if (AND (> wordCount 4) (NULL (getp 'QualValue parse))) (return NIL))
(return result) ) )
;;; genSQL
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; Purpose:
;;; Generates and returns a list containing a well formed SQL statement.
;;; Notes:
;;; -If the verb is COUNT, it generates SELECT COUNT(*). Otherwise it
;;; generates SELECT directObj.
;;; -The FROM tableName uses table-ht to generate the correct table name.
;;; -If there is a QualifyingPhrase, WHERE clause is generated.
(defun genSQL (parse)
(prog (result)
(if (EQL (getp 'verb parse) 'count)
(setf verb "SELECT count(*)") ; verb was COUNT
(setf verb "SELECT")) ; verb was NOT COUNT
(setf from "FROM")
(setf where "WHERE")
(setf directObj (getp 'directObj parse))
(setf tableName (getp 'IndirectObj parse))
(if (EQUAL verb "SELECT")
(putp 'request parse (LIST verb directObj from (getp tableName table-ht)))
(putp 'request parse (LIST verb from (getp tableName table-ht))))
(setf result (getp 'request parse))
;; SECOND FORM
(if (NOT (NULL (getp 'QualIndirectObj parse)))
(prog ()
(setf QualIndObj (getp 'QualIndirectObj parse))
(setf comp (getp 'comparator parse))
(setf notQual (getp 'NotQual parse))
(setf qualValue (getp 'QualValue parse))
(if (EQL comp 'EQUAL) (setf comp '=)) ; EQUAL -> "="
(if (EQL comp 'AFTER) (setf comp '>)) ; AFTER -> ">"
(if (EQL comp 'BEFORE) (setf comp '<)) ; BEFORE -> "<"
; adjust comparator if we have a NotQual
(if (AND (NOT (NULL notQual)) (EQL comp '=)) (setf comp '<>))
(if (AND (NOT (NULL notQual)) (EQL comp '>)) (setf comp '<=))
(if (AND (NOT (NULL notQual)) (EQL comp '<)) (setf comp '>=))
(setf qualValue (format NIL "\"~a\"" qualValue))
(setf where (LIST where QualIndObj comp qualValue))
; Append lists together
(putp 'request parse (APPEND result where))
(setf result (getp 'request parse)) ) )
(return result) ) ) ; return SQL statement
;;; resetPartsOfSpeech
;;; Parameters:
;;; parse - the parse object containing a request, cursor position, and
;;; value for each part of speech
;;; speech - x number of words to be reset to NILL
;;; Purpose:
;;; Resets the value for each of the specified parts of speech to NILL
;;; using putp.
(defun resetPartsOfSpeech (parse &rest speech)
(dolist (part speech) (putp part parse NIL))
)
;;; set_isa
;;; Parameters:
;;; word - word that will have parts of speech that define as that word
;;; i.e. WORD=VALUE
;;; partOfSpeech - x number of words that will define word
;;; i.e. partsOfSpeech=KEYS
;;; Purpose:
;;; Defines each word in the list of words to be specified partOfSpeech
;;; in the dictionary (hard coded word-dict).
;;; Notes:
;;; Uses putp to put each word in the word-dict hash table.
(defmacro set_isa (word &rest partOfSpeech)
(dolist (part partOfSpeech) (putp part word-dict word))
)
;;; isa
;;; Parameters:
;;; word - word to be compared to grammar in parse-obj
;;; partOfSpeech - grammar in parse-obj
;;; Purpose:
;;; Returns T if the specified word is that specified partOfSpeech,
;;; otherwise return NIL.
;;; Example Usage:
;;; (isa show 'verb) would return T since "show" is a verb
;;; (isa with 'verb) would return NIL since "with" is not a verb
(defun isa (word partOfSpeech)
(COND ((EQL (getp word word-dict) partOfSpeech)))
)
;;; +=
;;; Parameters:
;;; num - represents number variable to be
;;; incremented
;;; inc - represents increment value
;;; Purpose:
;;; Takes in a variable which is incremented
;;; and assigns the new value to that variable
;;; Expansion example:
;;; x=10; num=x; inc=5
;;;
;;; (+= (X 5)
;;; (SETF X (+ X 5 ) )
;;; )
(defmacro += (num inc)
`(setf ,num (+ ,num ,inc))
)
;;; defaulting doingExtra to NIL
(setf doingExtra 'EC2)
;;; p4LispRun.txt - run the student's code
;;; Use set_isa to set the part of speech for each of the words.
(set_isa article a an the)
(set_isa noun movies movie rentals rental customer customers)
(set_isa noun ID title genre rating custNr name state date number gender)
(set_isa verb count select show print)
(set_isa prep of with to in for)
(set_isa comparator equal after before)
(set_isa adjective horror scifi romance comedy action male female g pg pg13 r x )
(putp 'movie table-ht 'movie)
(putp 'movies table-ht 'movie)
(putp 'rental table-ht 'rental)
(putp 'rentals table-ht 'rental)
(putp 'customer table-ht 'customer)
(putp 'customers table-ht 'customer)
;;;
;;; first form: verb [article] directObj prep [article] indirectObj
;;;
(processRequest '(count the number of rentals ))
(processRequest '(count the number of movies ))
(processRequest '(show ID for movies ))
;;;
;;; second form: verb [article] directObj prep [article] indirectObj
;;; prep [article] qualIndirectObj comparator [prep] qualValue
;;;
(processRequest '(show the title of movies with rating equal to PG13))
(processRequest '(Count the number of rentals with date after 2018-10-01))
(processRequest '(Show the title for the movie with ID equal to HP001))
(processRequest '(Select the name of the customer with custNr not before to 111))
;;;
;;; Examples with NOT
;;;
(processRequest '(Show title for movies with rating not equal to G))
;;;
;;; Some invalid requests
;;;
(processRequest '(Show title for videos with a rating of G))
(processRequest '(Show title for movies having a rating of G))
(processRequest '(Show title for movies with a rating of G or PG))
;;; see if doing extra credit, return if not
(if (NOT(EQL doingExtra 'EC2))
(abort))
(processRequest '(Show the title of movies in the horror genre))
(processRequest '(Show the genre of movies with a G rating))
(processRequest '(Count the number of customers with a male gender))
(processRequest '(Count the number of movies with a PG13 rating))
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more
