Artificial Intelligence Question posted in
ChatGBT is becoming a world-wide phenomena, try it out here.

Correct Functional programming methods in lisp sbcl – Artificial Intelligence

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

2

Answers


  1. 0

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

    Login or Signup to reply.
  2. 0

    A few pointers:

    • Use files to keep your code. There are many programming environments that combine an editor with a REPL connection, so that you can then directly send toplevel forms to the REPL.
    • Style: comments for an entire file get four semicola on each line start (for a section or toplevel form 3, all other comments on lines for thenselves 2, line end comments 1).
    • Style: keep to 80 columns of text, so that you do not have to scroll sideways.

    • 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.

    • Style: Lisp upcases names while reading them by default, so 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.

    • Use strings for words. Symbols are for the programmer to use, not for user data. What would happen when someone enters *vocab* or sym as a word-symbol?
    • Related to that, use :test #'equal hash-tables (or alists) as associative data structures, not symbol cells.
    • Don’t read (or read-from-string) from user input. Just use the strings.
    • Adding an element to a list only if it is not already there can be done with pushnew.
    • Strive to eliminate all typos and misspellings from your code to avoid confusion (did you mean “reciprocal”?).
    • I recommend strongly not to go back to user interaction from the processing logic. If you need to get the reciprocal, do it after completely processing the original phrase first. The processing logic might return an indicator that this is needed, maybe as an additional value.
    • At least document precisely how the data structure returned by with-branch works. Better: use defstruct or defclass to create an explicit structure.
    • Use documentation strings for your functions.
    Login or Signup to reply.
Please signup or login to give your own answer.

Back To Top
Search