;;; Sample UNIMEM data with structured and linera features

(setf (get 'color 'type) 'structured)
(setf (get 'shape 'type) 'structured)
(setf (get 'size 'type) 'linear)(setf (get 'size 'linear-domain) '(1 10))

(setf t1 '((size 1)(color scarlet)(shape square)))
(setf t2 '((size 5)(color maroon)(shape trapezoid)))
(setf t3 '((size 10)(color crimson)(shape rectangle)))
(setf t4 '((size 1)(color aqua)(shape circle)))
(setf t5 '((size 5)(color indigo)(shape ellipse)))
(setf t6 '((size 10)(color sapphire)(shape circle)))

(setf test-examples '(t1 t2 t3 t4 t5 t6))

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


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