Question

I am trying to do my homework. I have the following collection.

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

I need to make it working in the way to pass the following tests.

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

I have managed to do work if I specify the value of the tweetie for example:

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

which returns seed.

but

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

returns nil, so how can I make it match it for the specified parent values
So when tested (eats tweetie ?x) should return seed and (has tweetie ?x) should return feathers.

Thanks guys.

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

Here’s one simple way of doing it. But in practice you will most likely use classes, or at least structs for this purpose, and they come with the functionality of “is a” relationship built-in and it is fairly robust and a complex one.

EDIT:

Below is some way to transform your input structure into a list of classes, with the benefit of later being able to use the built-in OO functionality to assess inheritance, access field (slots) etc:

(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