孩子 - 父母关系

Question

我正在努力做我的功课。我有以下收藏。

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

。

但

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

返回nil，所以我怎么可以让它搭配它指定的父值 所以测试时(eats tweetie ?x)应该返回种子和(has tweetie ?x)应该返回羽毛。

谢谢你们。

Answer 1

(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