Hi there,
You can find attached to this message a copy of Steven Tanimoto's
Linneus program from his book "The Elements of Artificial
Intelligence" 1st edition.
I don't understand how the GET function operates in LISP, and
as you can see, it's very important in the operation of this program.
If someone could explain how GET works and how it operates I
would be very grateful.
Here's how the program works:
(a dog is a mammal)
(a cat is a mammal)
(a mammal is an animal)
(what is a dog)
>a dog is a mammal
(is a dog an animal)
>yes indeed, a dog is an animal
(is a dog a cat)
>sorry, not that I know of
(why is a dog an animal)
>becasue a dog is a mammal and a mammal is an animal
Thanks in advance,
Rob
Note: To email a reply replace "null_device" with "gormally" in
my email address. This helps avoid junk mail and spamming.
---LINNEUS---
;;; LINNEUS.LISP
;;; (c) Copyright 1990 by S. Tanimoto.
;;; This program appears in The Elements of Artificial Intelligence
;;; Using Common Lisp, published by W. H. Freeman, 41 Madison Ave.,
;;; New York, NY 10010 in February, 1990.
;;; Permission is granted to use or modify this program
;;; provided that this copyright notice is retained and followed
;;; by a notice of any modifications made to the program.
;;; Common Lisp version of the Linneus program.
;;; December 16, 1988, updated Aug. 28, 1989.
;;; The function LINNEUS embodies the main loop.
(defun linneus ()
(format t "(THIS IS LINNEUS. PLEASE TALK TO ME)~%")
(loop (format t "--> ") ; Print prompt symbol.
(if (eq (interpret (read)) 'bye)
(return '(goodbye)) ) ) )
;;; INTERPRET contains the production rules.
(defun interpret (text)
(cond
;; rule for statements, e.g., (A DOG IS A MAMMAL):
((match '((match-article article1)(? x) is
(match-article article2)(? y))
text)
(add-superset x y)
(add-subset y x)
(setf (get x 'article) article1)
(setf (get y 'article) article2)
(format t "(I UNDERSTAND)~%") )
;; rule for queries of the form (WHAT IS A DOG):
((or (match '(what is (? p)) text)
(match '(what is (match-article article1)(? x)) text))
(setq isaflag nil)
(setq includeflag nil)
(cond ((setq y (get x 'isa))(setq isaflag t))
((setq y (get x 'includes))(setq includeflag t))
(t (format t "(I DON'T KNOW)~%")
(return-from interpret) ) )
(prin1 (append
(list (get x 'article))
(list x)
(cond (isaflag '(is))
(includeflag
'(is something more general than) ) )
(make-conj y) ))
(terpri) )
;; rule for queries of the form (IS A DOG AN ANIMAL):
((match '(is (match-article article1) (? x)
(match-article article2) (? y))
text)
(cond ((isa-test x y 10)
(prin1 (append '(yes indeed)
(list (get x 'article))
(list x)
'(is)
(list (get y 'article))
(list y) ))
(terpri) )
(t (format t "(SORRY, NOT THAT I KNOW OF)~%")) ) )
;; rule for WHY questions:
((match '(why is (match-article article1) (? x)
(match-article article2) (? y))
text)
(cond ((isa-test x y 10)
(prin1 (cons 'because
(explain-links x y) ))
(terpri) )
(t (format t "(BUT IT ISN'T!)~%")) ) )
;; rule for session termination:
((match '(bye) text)
'bye)
;; rule for all other inputs:
(t (format t "(I DO NOT UNDERSTAND)~%")) ))
;;; ADD-TO-LIST inserts ELT into LST if it's not
;;; already a member:
(defun add-to-list (elt lst)
(cond ((member elt lst) lst) (t (cons elt lst)) ))
;;; ADD-SUPERSET makes X one of the supersets of ANAME:
(defun add-superset (aname x)
(setf (get aname 'isa)
(add-to-list x (get aname 'isa)) ) )
(defun match-article (x)
(member x '(a an the that this those these)) )
;;; MAKE-CONJ takes a list, e.g., (X Y Z) and inserts
;;; appropriate articles in front of each element, and
;;; inserts the atom AND between successive elements,
;;; e.g., (AN X AND A Y AND A Z):
(defun make-conj (lst)
(cond
((null lst) nil)
((null (cdr lst))
(cons (get (car lst) 'article) lst))
(t (cons (get (car lst) 'article)
(cons (car lst)
(cons 'and
(make-conj (cdr lst)) ) ) )) ) )
;;; ADD-SUBSET makes X one of the subsets of ANAME:
(defun add-subset (aname x)
(setf (get aname 'includes)
(add-to-list x (get aname 'includes)) ) )
;;; ISA-TEST returns T if there is a path from X to Y
;;; consisting of ISA links, with path length no more
;;; than N.
(defun isa-test (x y n)
(catch 'isa (isa-test1 x y n)) )
;;; ISA-TEST1 is the recursive slave of ISA-TEST.
(defun isa-test1 (x y n)
(cond ((eq x y) t)
((member y (get x 'isa)) (throw 'isa t))
((zerop n) nil)
(t (any (mapcar
(function
(lambda (xx)
(isa-test xx
y
(1- n) ) ) )
(get x 'isa) ))) ) )
;;; ANY returns T if at least one top-level element
;;; of LST is not NIL.
(defun any (lst)
(cond ((null lst) nil)
((car lst) t)
(t (any (cdr lst))) ) )
;;; EXPLAIN-LINKS answers "Why" questions.
(defun explain-links (x y)
(cond
((eq x y) '(they are identical)) ; 1st special case
((member y (get x 'isa)) '(you told me)); 2nd special case
(t (explain-chain x (get x 'isa) y)) ) ); general case
;;; The recursive function EXPLAIN-CHAIN is called by
;;; EXPLAIN-LINKS. EXPLAIN-CHAIN produces an
;;; explanation of the first chain from X to Y that passes
;;; through a member of L.
(defun explain-chain (x l y)
(cond ((null l) nil) ; L should never be null.
((member y l) ; See if last link --
(cons 'and (tell x y)) ) ; Yes, precede by AND.
((isa-test (car l) y 10) ; Does chain go through CAR L?
(append (tell x (car l)) ; Yes, explain this link, etc.
(explain-chain (car l)
(get (car l) 'isa)
y) ) )
(t (explain-chain x (cdr l) y)) ) ) ;else try next in L.
;;; The helping function TELL
;;; explains the (single) link from X to Y.
(defun tell (x y)
(list (get x 'article) x 'is (get y 'article) y) )
(defun match
(p s)
(cond ((null p)(null s))
((and (null s)
(or (atom (car p))
(and (atom (caar p))
(null (eq (caar p) '*)) ) ) )
nil)
((null s)
(and (null (atom (car p)))
(eq (caar p) '*)
(null (cdr p))
(prog nil (set (cadar p) nil) (return t)) ) )
((atom (car p))
(cond ((eq (car p)(car s)) (match (cdr p)(cdr s)))
(t nil)))
((eq (caar p) '?)
(and (match (cdr p)(cdr s))
(prog nil (set (cadar p) (car s)) (return t)) ) )
((eq (caar p) '*)
(cond ((match (cdr p) s)
(prog () (set (cadar p) nil)(return t)) )
((match (cdr p)(cdr s))
(prog () (set (cadar p) (list (car s)))
(return t) ) )
((match p (cdr s))
(prog () (set (cadar p) (cons (car s)(eval (cadar
p))))
(return t) ) )
(t nil) ) )
((and (apply (caar p) (list (car s)))
(match (cdr p) (cdr s)) )
(prog () (set (cadar p)(car s)) (return t)) )
(t nil)
) )
; the following code is for test purposes
;(linneus)
;(a turbot is a fish)
;(a fish is an animal)
;(a fish is a swimmer)
---END LINNEUS---
In article <················@news1.tinet.ie>, ···········@tinet.ie (Rob) wrote:
> Hi there,
> You can find attached to this message a copy of Steven Tanimoto's
> Linneus program from his book "The Elements of Artificial
> Intelligence" 1st edition.
>
> I don't understand how the GET function operates in LISP, and
> as you can see, it's very important in the operation of this program.
>
> If someone could explain how GET works and how it operates I
> would be very grateful.
GET symbol property &optional default
[Function]
searches the property list of symbol for property (using eq to test).
Returns the property value if found; otherwise returns default-value if
specified, or nil if no default-value is specified. get may be combined
with setf to add or change a property.
(get 'rainer :programs-in)
-> nil
(setf (get 'rainer :programs-in) :lisp)
-> :lisp
(get 'rainer :programs-in)
-> :lisp
(get 'rainer :goes-home-when)
-> nil
(setf (get 'rainer :goes-home-when) :soon)
-> :soon
(get 'rainer :goes-home-when)
-> :soon
(symbol-plist 'rainer)
-> (:GOES-HOME-WHEN :SOON :PROGRAMS-IN :LISP)
--
http://www.lavielle.com/~joswig