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

たとえば、ツイートの値を指定すれば、なんとか仕事をすることができます。

(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) が返され、フェザーが返されます。

みんなありがとう。

4

1 に答える 1

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

これを行う簡単な方法の 1 つを次に示します。しかし実際には、この目的のためにクラス、または少なくとも構造体を使用する可能性が高く、それらには「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
于 2012-12-07T21:28:18.927 に答える