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))