2012-12-07 300 views
3

我正在努力做我的功課。我有以下收藏。孩子 - 父母關係

(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)應該返回羽毛。

謝謝你們。

+0

您的集合是給定的,還是允許您使用不同的數據結構?反映關係結構的不同數據結構可能會讓你的生活變得更輕鬆... – RonaldBarzell

回答

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