자녀 - 부모 관계

Question

나는 숙제를하려고합니다. 다음 컬렉션이 있습니다.

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

다음 테스트를 통과하는 방식으로 작동시켜야합니다.

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

종자를 반환

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

내가 예를 들어 트위티의 값을 지정하면 일을 관리했다.

하지만

(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 

여기에 한 가지 간단한 방법이 있습니다. 그러나 실제로는 이러한 목적을 위해 클래스 나 구조체를 사용할 가능성이 높습니다. "is a"관계가 내장되어 있으며 매우 견고하고 복잡한 구조입니다.

편집 : 아래

클래스의 목록으로 입력 구조를 변형 할 수있는 방법은 나중에 내장 된 OO 기능 상속, 액세스 필드를 평가하기 위해 (슬롯을 사용할 수 있다는 장점과 함께,이다) 등 :

(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