2
\$\begingroup\$

I am writing a crude artificial intelligence program. I am happy with my program's 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 rewrote 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 programming. I have rewritten this to the point that I am cross eyed but at the moment it works.

Each word is stored in the global vocab list as an a word. some words are used as verbs or relationship words stored in the a words in assoc arrays. C words are the subjects which are placed in assoc arrays nested in the b word arrays. The (unk) words are just placeholders until an actual word is placed in the array.

; 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))
\$\endgroup\$
2
  • \$\begingroup\$ The code has missing parentheses and can't work as such. \$\endgroup\$ Feb 18 '18 at 21:05
  • \$\begingroup\$ I repaired the missing parenthesis I lost them when I posted the question but they are back now \$\endgroup\$ Feb 18 '18 at 21:15
2
\$\begingroup\$

Readability

It's hard express how important it is - we write programs to be read by humans, and only at times by machines. Programming languages were designed by humans for humans, not for machines. And your responsibility is not only write code that works (somehow), but most important - code that is most clear and simple to read description of your intentions for other readers (and for yourself in the future).

Naming

It's not good idea to use names like a, b, c etc. It doesn't tell anything. And you had to describe in comments thei meanings. Call them what they are, ie:

the A word is the subject. The B word is the verb or relationship and the C is the object.

Why not call them subject-word, verb-word and object-word?

Also function names like ABCphrase, ABCphrase-b, ABCphrase-c are not very descriptive. Later you use some long, descriptive function names, why not here?

Formatting

Please make some space between function definitions. Do not:

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

Do:

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

Don't put additional spaces in lists. Do not:

(defun ABCphrase-c ( a b c origin)

Do:

(defun ABCphrase-c (a b c origin)

Do use at least one space (white character) between list elements. Do not:

((not(member 

Do:

((not (member

Indent your code properly. Wrong indentation in Common Lisp is like placing dot and comma characters in wrong places in natural language. If you focus hard, you can still try to figure out what you read, but it leads to errors and is painfull. If you use IDE created with Lisp requirements in mind (ie Emacs), it will indent your code properly, and also every time you see your code not aligning properly - it's clear sign there is something wrong with expression. Do not:

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

Do:

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

Descriptions

You have a lot of comments, and that's good. However in Common Lisp you can include them in your code, and refere to them in programmatic way.

In global function and variable definition you can add string with description. Later you can get those descriptions using describe. So for example if you change learn function to:

(defun learn (a b c)
  "user friendly ersion of ABCphrase to input phrases."
  (ABCphrase a b c "none"))

later you can ask for description on repl:

(describe #'learn)

Same goes to global variable/parameter definitions.

Bottom-Up

When you first define top functions, and later move to defining lower level functions, you force reader to skip from top to some random parts. If I read learn function, it's body doesn't tell me much. It references some other function that I haven't read yet. It would be easier to read if you place simpler functions on top. So before you define learn, first define function referenced by it, so ABCphrase. And since ABCphrase references ABCphrase-b, define it first. And so on...

Tech

global vars

You can't setf something that doesn't exist! It's an error. Use defparameter or defvar instead. And always *mark* global variables properly. Do not:

(setf *vocab* '()) ; all words live here

(setf sym '())

Do:

(defvar *vocab* '()
  "all words live here.")

(defvar *sym* '())

return

In Common Lisp you don't have to use return-from in fashion similar to return is a must. In Common Lisp function returns result of evaluating last expression. As a rule of thumb - if you are about to write return-from, stop and think, you overcomplicated something. Do not:

(defun get-word (a b c) 
    (let ((word (read-from-string (read-line))))  
        (add-to-vocab-if-not word)
        (return-from get-word  word)))

Do:

(defun get-word (a b c) 
    (let ((word (read-from-string (read-line))))  
        (add-to-vocab-if-not word)
        word)))

Also if add-to-vocab-if-not returns word, you don't need the last line at all. And do not:

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

Do:

(defun resolve-word (word)
    (cond
        ((assoc 'is-synonym (symbol-value word)) 
            (first(first(first(cdr (assoc 'is-synonym (symbol-value word)))))))
        (t word)))

first is good, car even better

At the beginning, first look and reads much better than car. But you can chain car and cdr nicely. So use (caar instead of (first (first etc:

(defun resolve-word (word)
    (cond
        ((assoc 'is-synonym (symbol-value word)) 
            (caaadr (assoc 'is-synonym (symbol-value word))))
        (t word)))

when if cond

cond is let's say heavy. In many cases code reads better if you use if (if you need both actions, for true and false). And even better when you can use when (when you don't need false action) :)

(defun resolve-word (word)
    (if (assoc 'is-synonym (symbol-value word)) 
        (caaadr (assoc 'is-synonym (symbol-value word)))
        word))

format

You mix format and princ, why? I can understand you don't like format and prefere princ etc. But be consistent.

equality

equal is only one of many equality checks. In your code it would be better to use eq or string= in many places.

functional programming

loops

loop macro is for iterative programming, not for functional. In functional programming you use recurence. "Little Schemer" is great, practical read on the subject.

global vars

In the essence, every time you call function with the same parameters, it should return the same result. However in your functions you use global variables very often, so behaviour of functions changes in time. It's not functional.

there is...

...a lot more problems with your code. But for the beggining I hope my suggestions are helpful. Best luck with your app!

\$\endgroup\$
2
  • \$\begingroup\$ Thank you I have been rewriting this code based on some other peoples suggestions. I had posted it in the wrong place but I got a few good responses like yours. I am using strings instead of symbols. I very much like your idea of the subject verb and object very much and will take every suggestion you made. I appreciate your careful explanations and using my own code as example. I just couldn't figure this out without people like you. Thanks. \$\endgroup\$ Feb 20 '18 at 0:17
  • \$\begingroup\$ glad I could help! :) you are welcome to upvote and accept answer if you like it ;) \$\endgroup\$
    – rsm
    Feb 20 '18 at 0:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.