;;;; Examples and data structure functions for adding structured variables to
;;;; the version-space learning algorithm.

(setf struc-example1 '((+ (big aqua square))
		       (+ (small sapphire trapezoid))
		       (- (big aqua circle))
		       (- (small emerald triangle))
		       (- (medium turquoise square))
		       (+ (medium indigo pentagon))))

(setf struc-example2 '((+ (big scarlet triangle))(+ (small aqua square))
		       (- (medium maroon pentagon))))

(setf struc-example3 '((+ (small aqua square)) (- (big crimson circle))
		       (+ (small sapphire circle))(- (big indigo triangle))))


(defun make-hierarchy (net)
  ;;; Takes a hierarchy represented as an s-expression and encodes it
  ;;; as SUBCLASSES and SUPERCLASS property links between classes.

  (setf (get (first net) 'SUBCLASSES)
	(mapcar #'(lambda (subnet)
		    (setf (get (first subnet) 'SUPERCLASS)
			  (first net))
		    (make-hierarchy subnet)
		    (first subnet))
		(rest net))))


(make-hierarchy '(shape (curved (ellipse) (circle))
			(polygon (triangle)
				 (quadrilateral (parallelogram (rectangle)
							       (square))
						(trapezoid))
				 (pentagon))))

(make-hierarchy '(color (red (maroon)(scarlet)(crimson))
			(blue (aqua) (indigo) (sapphire))
			(green (chartreuse)(turquoise) (emerald))))


;;; *domains* specifies the "top level" value for structured variables

(setq *domains* '((small medium big) color shape))



(defun subclass? (x y)
  ;;; Returns T iff x is a proper subclass of y in a hierarchy

  (cond ((null (get x 'SUPERCLASS)) nil)
	((eq (get x 'SUPERCLASS) y) t)
	(t (subclass? (get x 'SUPERCLASS) y))))