Reputation: 109
I am writing a crude artificial intelligence program. I am happy with my programs ability to file away new word in ways that will allow logic to be done on them. Before I start expanding the logic abilities of the program I re wrote it in what I understand to be functional programming. I want a solid base before I move forward. Any critique or insight would be greatly appreciated because I believe in good programing. I have rewritten this to the point that I am cross eyed but at the moment it works. (I apologize I have reposted several times and cannot format the code correctly)
; This program is used on an SBCL REPL
; this program recieves three word phrases via the LEARN function
; and stores them in symbols aranged in nested assoc arrays
; so that logical questions can be asked using the function ASK.
; The LEARN function can take lists as arguments to proces many As Bs or Cs.
; the A word is the subject. The B word is the verb or relationship and the C is the object.
; For every ABC phrase the recipical phrase is also recorded.
; If the b word does not yet have a recipical a user prompt is given.
; Synonyms are also disambiguated to one tearm to allow abreviated input and to eliminate words meaning the same thing.
(setf *vocab* '()) ; all words live here
(defun with-branch (word) (cons word (cons (list '(unk) (cons '(unk) nil))nil)))
(setf sym '())
(defun learn (a b c) ;user friendly ersion of ABCphrase to input phrases
(ABCphrase a b c "none"))
(defun ABCphrase (a b c origin) ;computer uses to input three word phrases or lists or A B and C words to build many phrases at once
(cond
((listp a)
(loop for w in a do
(ABCphrase-b w b c origin))) ;origin is to keep track of what function called ABCphrase in ordert to prevent infite loops
((not (listp a))
(ABCphrase-b a b c origin))))
(defun ABCphrase-b (a b c origin)
(cond
((listp b) ;proceses the list if b is a list
(loop for y in b do
(ABCphrase-c a y c origin)))
((not (listp b))
(ABCphrase-c a b c origin))))
(defun ABCphrase-c ( a b c origin)
(cond
((listp c) ;proceses the list if c is list
(loop for z in c do
(add-and-place-ABCphrase-words a b z origin)))
((not (listp c))
(add-and-place-ABCphrase-words a b c origin)))) ;all words are eventualy processed throuf add-and-place-ABCphrase-words
(defun add-and-place-ABCphrase-words (a b c origin)
(add-to-vocab-if-not a)(add-to-vocab-if-not b)
(add-to-vocab-if-not c)
(let ((a-resolved (word-or-synonym a b "a" ))
(b-resolved (word-or-synonym b b "b" ))
(c-resolved (word-or-synonym c b "c" )))
(add-as-b-if-not a-resolved b-resolved c-resolved origin)
(cond
((equal b-resolved 'has-synonym) ;if b is has-synonym then don't resolve the synonym
(add-as-c-if-not a-resolved b-resolved c ))
((not(equal b-resolved 'has-synonym))
(add-as-c-if-not a-resolved b-resolved c-resolved )))))
(defun add-to-vocab-if-not (word)
(cond
((not(member word *vocab*)) ;if already exists
(push word *vocab*) ;add a as a a
(setf (symbol-value word) sym))))
(defun add-as-b-if-not (a b c origin) ;ads b to assoc array inside a (unless it is already there)
(cond
((not (assoc b (symbol-value a))); if not allready in lista
(cond
((equal (symbol-value a) sym)
(setf (symbol-value a) (cons (with-branch b) nil)) )
((not(equal (symbol-value a) sym))
(push (with-branch b) (symbol-value a))))))
(cond
((not(equal origin "recipical")) ;this condition prevents an infint loop of flip flopping recipicals
(process-recipical a b c))))
; b recipical
(defun process-recipical (a b c) ; create the backward phrase frog is-colored green green is-color-of frog
(cond
((equal b 'is-recipical-of) ;this condition was necessary due to an error
(ABCphrase c 'is-recipical-of a "recipical")
(return-from process-recipical b)
((not(assoc 'is-recipical-of (symbol-value b))) ; if b does not have repical then prompt user for recipical
(format t "Please type recipical of: ")
(princ b)
(finish-output)
(let ((rec-word (get-word a b c)))
(ABCphrase c rec-word a "recipical") ;creates the recipical phrase
(ABCphrase b 'is-recipical-of rec-word "recipical") ;create prase stating recipical
(ABCphrase rec-word 'is-recipical-of b "recipical"))) ;create recipical phrase stating recipical
((assoc 'is-recipical-of (symbol-value b)) ;if b has recipical
(ABCphrase c (first(first(first(cdr (assoc 'is-recipical-of (symbol-value b)))))) a "recipical"))) )
(defun get-word (a b c)
(let ((word (read-from-string (read-line))))
(add-to-vocab-if-not word)
(return-from get-word word))
(defun add-as-c-if-not (a b c)
(cond
((not (assoc c (car (cdr(assoc b (symbol-value a)))))); if not in list b
(push (with-branch c) (second(assoc b (symbol-value a)))))))
(defun word-or-synonym (word b place)
(cond
((equal place "b")
(return-from word-or-synonym (resolve-word word)))
((equal place "a")
(cond
((equal b 'is-synonym)
(return-from word-or-synonym word))
((not(equal b 'is-synonym))
(return-from word-or-synonym (resolve-word word)))))
((equal place "c")
(cond
((equal b 'has-synonym)
(return-from word-or-synonym word))
((not(equal b 'has-synonym))
(return-from word-or-synonym (resolve-word word))))))
(defun resolve-word (word)
(cond
((assoc 'is-synonym (symbol-value word))
(return-from resolve-word (first(first(first(cdr (assoc 'is-synonym (symbol-value word)))))))))
(return-from resolve-word word
(defun ask (a b c)
(add-to-vocab-if-not a)
(add-to-vocab-if-not b)
(add-to-vocab-if-not c)
(let ((a-resolved (word-or-synonym a b "a" ))
(b-resolved (word-or-synonym b b "b" ))
(c-resolved (word-or-synonym c b "c" )))
(assoc c-resolved (cadr(assoc b-resolved (symbol-value a-resolved))))))
(learn 'is-recipical-of 'is-recipical-of 'is-recipical-of)
(learn 'is-synonym 'is-recipical-of 'has-synonym)
(learn 'syn 'is-synonym 'is-synonym)
(learn 'rec 'syn 'is-recipical-of )
(learn 'teaches 'rec 'is-taught-by)
(learn 'is-located-in 'rec 'is-location-of)
(learn 'auburn 'is-location-of '(upstairs downstairs industrial-arts-building))
(learn 'loc-of 'syn 'is-location-of)
(learn 'loc-in 'syn 'is-located-in)
(learn 'upstairs 'loc-of '(CNT-room ISS-room APM-room testing-room fish-bowl TPP-room ISTEM))
Upvotes: 1
Views: 207
Reputation: 51501
A few pointers:
Error: don't introduce global variables with setf
. Use defvar
or defparameter
(there is also defconstant
but let's stick to the basics for now). Setf
is for modifying places, not creating them.
(defvar *vobabulary* ())
I don't see where you ever set sym
to anything but nil
.
Lisp supports optional arguments directly:
(defun learn (a b c &optional (origin "none")
…)
Style: indent bodies by two spaces, align parameters of function calls.
ABCphrase
becomes ABCPHRASE
—camel case makes no sense here. Structure combined symbols with hyphens: abc-phrase
.In abc-phrase
, you can make the fact that all required arguments are list designators more apparent by using an ensure-list
helper (make your own, or use the one from the alexandria
library):
(let ((a (ensure-list a))
(b (ensure-list b))
(c (ensure-list c)))
…)
Simple two-branch conditionals can be written much clearer using if
.
*vocab*
or sym
as a word-symbol?:test #'equal
hash-tables (or alists) as associative data structures, not symbol cells.read
(or read-from-string
) from user input. Just use the strings.pushnew
.with-branch
works. Better: use defstruct
or defclass
to create an explicit structure.Upvotes: 2
Reputation: 4360
When constructing objects you can use syntactic sugar or list*
and mostly don’t need cons:
(defun with-branch (word)
`(,word ((unk) ((unk)))))
This suggests that you should probably describe somewhere what this data structure looks like.
In ABCphrase
you can use if
instead of cond
or at least use t
as the test for the “otherwise” case. Also note that by default Lisp symbols are not case sensitive (strictly speaking they are but are converted to upper case at read time)
You could probably convert your handling of ABCphrase-x
into three nested loops and making a function ensure-list
which takes a
to (a)
and takes (a)
to (a)
.
This is as far as I’ll go for now. As for functional style, although you don’t seem to be changing cars and cdrs much, you are doing lots of mutating global state. (setf symbol-value)
is particularly egregious and may lead to problems (e.g. what if you try to have pi
be synonymous to something?)
Upvotes: 1