Lisp 亲子关系

我正在努力做作业。我有以下收藏

(defparameter *tuples* 
  '((has bird feathers)
  (color budgie yellow)
  (eats budgie seed)
  (color tweetie green)
  (isa tweetie budgie)
  (isa budgie bird)
    ))

我需要让它以通过以下测试的方式工作

(inherit tuples 'tweetie 'heart-rate) => nil
(inherit tuples 'tweetie 'color)      => green
(inherit tuples 'tweetie 'eats)       => seeds
(inherit tuples 'tweetie 'has)        => feathers

如果我指定了tweetie的值，我已经成功地完成了工作，例如：

(forevery (' ((isa ?b budgie)  (eats budgie ?x)) *tuples*) 
    (format t "~&~a" #?x)      #?x)

它返回种子

但是

返回nil，那么如何使其与指定的父值匹配 所以当测试时，

（吃tweetie？x）

应该返回种子，

（吃tweetie？x）

应该返回羽毛

谢谢各位

(defparameter *tuples* 
  '((has bird feathers)
    (color budgie yellow)
    (eats budgie seed)
    (color tweetie green)
    (isa tweetie budgie)
    (isa budgie bird)))

(defvar *traits-table* (make-hash-table))

(defun put-trait (trait object subject)
  (let ((object-table
         (gethash object *traits-table* (make-hash-table))))
    (setf (gethash trait object-table) subject
          (gethash object *traits-table*) object-table)))

(defun populate-traits ()
  (loop for (trait object subject) in *tuples* do
       (put-trait trait object subject)))

(defun inherits-p (object trait)
  (let ((object-table (gethash object *traits-table*)))
    (and object-table
         (or (gethash trait object-table)
             (inherits-p (gethash 'isa object-table) trait)))))

(populate-traits)

(inherits-p 'tweetie 'heart-rate)       ; nil
(inherits-p 'tweetie 'color)            ; GREEN
(inherits-p 'tweetie 'eats)             ; SEED
(inherits-p 'tweetie 'has)              ; FEATHERS

这里有一个简单的方法。但在实践中，您很可能会使用类，或者至少是结构来实现这一目的，并且它们具有内置的“is-a”关系的功能，这是一个相当健壮和复杂的关系

编辑：

下面是将输入结构转换为类列表的一些方法，其好处是以后可以使用内置的OO功能来评估继承、访问字段（插槽）等：

---

您的集合是给定的，还是允许您使用不同的数据结构？反映关系结构的不同数据结构可能会让你的生活更轻松。。。

(defparameter *tuples* 
  '((has bird feathers)
    (color budgie yellow)
    (eats budgie seed)
    (color tweetie green)
    (isa tweetie budgie)
    (isa budgie bird)))

(defvar *traits-table* (make-hash-table))

(defun put-trait (trait object subject)
  (let ((object-table
         (gethash object *traits-table* (make-hash-table))))
    (setf (gethash trait object-table) subject
          (gethash object *traits-table*) object-table)))

(defun populate-traits ()
  (loop for (trait object subject) in *tuples* do
       (put-trait trait object subject)))

(defun inherits-p (object trait)
  (let ((object-table (gethash object *traits-table*)))
    (and object-table
         (or (gethash trait object-table)
             (inherits-p (gethash 'isa object-table) trait)))))

(populate-traits)

(inherits-p 'tweetie 'heart-rate)       ; nil
(inherits-p 'tweetie 'color)            ; GREEN
(inherits-p 'tweetie 'eats)             ; SEED
(inherits-p 'tweetie 'has)              ; FEATHERS

(defmacro define-tuples (&body body)
  (loop for (trait object subject) in body
     ;; will will build a directed graph (assuming there
     ;; is only one root), where the root of the grpah
     ;; is the object, which maps to `nil', for simplicity
     ;; we will also assume there is always only one descendant
     with inheritance = (make-hash-table)
     with traits = (make-hash-table)
     with next-class = nil
     for object-table = (gethash object traits (make-hash-table))
     do (if (eql trait 'isa)
            (setf (gethash subject inheritance) object)
            (setf (gethash trait object-table) subject
                  (gethash (gethash object inheritance) inheritance)
                  (or (gethash (gethash object inheritance) inheritance) object)
                  (gethash object traits) object-table))
     finally
       (return                          ; We need to make sure
                                        ; we don't extend classes
                                        ; which we didn't define yet
         (let ((classes
                (cons nil
                      (loop for i from 0 to (hash-table-count traits)
                         collect
                           (setf next-class
                                 (gethash next-class inheritance))))))
           (append '(progn)
                   (loop for super in classes
                      for clazz in (cdr classes)
                      while (not (null clazz))
                      collect           ; generate class definitions
                        `(defclass ,clazz ,(when super (list super))
                           ,(loop for slot being the hash-key of
                                 (gethash clazz traits)
                               for slot-init-form being the hash-value of
                                 (gethash clazz traits)
                               collect  ; generate slot descriptors
                                 `(,slot :initarg
                                         ,(intern (string-upcase
                                                   (symbol-name slot)) "KEYWORD")
                                         :initform ',slot-init-form
                                         :accessor
                                         ,(intern
                                           (concatenate
                                            'string
                                            (string-upcase
                                             (symbol-name slot)) "-OF")))))))))))


(define-tuples
  (has bird feathers)
  (color budgie yellow)
  (eats budgie seed)
  (color tweetie green)
  (isa tweetie budgie)
  (isa budgie bird))

(let ((tweetie-instance (make-instance 'tweetie)))
  (format t "~&Tweetie eats ~s" (eats-of tweetie-instance))
  (format t "~&Tweetie has ~s" (has-of tweetie-instance))
  (format t "~&Tweetie color ~s" (color-of tweetie-instance))
  (format t "~&Tweetie has heart-rate ~s"
          (slot-exists-p tweetie-instance 'heart-rate)))
;; Tweetie eats SEED
;; Tweetie has FEATHERS
;; Tweetie color GREEN
;; Tweetie has heart-rate NIL