;;; -*- Mode: LISP; Package: GTRE-EXAMPLE; Syntax: Common-lisp; -*-
;;;
;;; *******************************************************
;;;
;;; PORTABLE AI LAB - EPFL
;;;
;;; *******************************************************
;;;
;;; Filename:   car-design-ex.cl
;;; Short Desc: Example of Dynamic Constraint Satisfaction 
;;;             Problem (using NMJTMS)
;;; Version:    1.0
;;; Status:     experimental
;;; Last Mod:   24.11.91 - Fatma FEKIH-AHMED
;;; Authors:    Fatma FEKIH-AHMED
;;;
;;; Copyright (c) 1992 Istituto Dalle Molle (IDSIA), University of
;;; Zurich, Swiss Federal Institute of Technology Lausanne.
;;;
;;; Permission is granted to any individual or institution to use, copy,
;;; modify, and distribute this software, provided that this complete
;;; copyright and permission notice is maintained, intact, in all
;;; copies and supporting documentation.
;;;
;;; IDSIA provides this software "as is" without express or implied
;;; warranty.  
;;;

;;Simple Dynamic Constraint Satisfaction Problem example: 
;;(adapted to car design)
;;
;;;SPECIFICATION:
;;
;; V= {engine, battery, air-cond, sunroof}
;; Vi= {engine, battery}
;;
;; D1={small, large}  D2={small, large}  D3={included, no}  D4={included, no}
;;
;; Compatibility constraints Cc:
;;(Notice that a variable can be assigned a value only if it's active)
;;
;;  1- engine <- small => battery <- small
;;
;;  2- engine <- large => battery <- large
;;
;;  3- battery <- large and air-cond <- included => sunroof <- no
;;
;; Activity constraints Ca:
;;
;;  1- engine <- large => active:air-cond
;;
;;  2- air-cond <- no => active:sunroof
;;
;; Goal:
;;
;; Find an assignment such that:
;;
;;   - Constraints in both Cc and Ca are satisfied
;;   - All the variables in Vi are active (<-> appear in the solution)
;;   - Each value assigned to a variable belongs to its associated domain.
;;   - A variable is assigned a value iff it is active.
;;
;;;;;;;;;

;;; =======================================================================
;;; PACKAGE DECLARATIONS
;;; =======================================================================

(in-package :gtre-example)

(import '(pail-lib::tre-example
	  gtre::rule
	  gtre::assert!
	  gtre::rassert!
	  gtre::retract!
	  gtre::rretract!
	  gtre::contradiction
	  gtre::GOD
	  gtre::USER
	  ))

;;; =======================================================================
;;; CAR DESIGN
;;; =======================================================================

(let ((car-design (make-instance 'tre-example
		    ;;rules in NMJTRE syntax
		    :rule-set '(;;THIS FIRST RULE IS A GENERAL COHERENCE RULE.
				(rule ((:in (active ?v) :var ?V1)
				       (:in (assign ?v ?val1) :var ?V2)
				       (:in (assign ?v ?val2) :var ?V3
					:test (different ?val1 ?val2)))
				 (rassert! contradictory-design 
				  (just (:in ?V1) (:in ?V2) (:in ?V3))))
				
				;;THE FOLLOWING RULE IS A SPECIFIC COHERENCE RULE.
				;;One cannot allow not to have a value assigned to 
				;;the Engine variable.
				(rule ((:in (active engine) :var ?V1)
				       (:out (assign engine small) :var ?V2)
				       (:out (assign engine large) :var ?V3))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:out ?V2) (:out ?V3))))

				;;COMPATIBILITY CONSTRAINTS RULES.
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine small) :var ?V2)
				       (:in (active battery) :var ?V3))
				 (rassert! (assign battery small)
				  (just (:in ?V1) (:in ?V2) (:in ?V3))))
				
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine small) :var ?V2)
				       (:in (active battery) :var ?V3)
				       (:out (assign battery small) :var ?V4))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:out ?V4))))
				
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine large) :var ?V2)
				       (:in (active battery) :var ?V3))
				 (rassert! (assign battery large)
				  (just (:in ?V1) (:in ?V2) (:in ?V3))))
				
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine large) :var ?V2)
				       (:in (active battery) :var ?V3)
				       (:out (assign battery large) :var ?V4))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:out ?V4))))
				
				(rule ((:in (active battery) :var ?V1)
				       (:in (assign battery large) :var ?V2)
				       (:in (active air-cond) :var ?V3)
				       (:in (assign air-cond included) :var ?V4)
				       (:in (active sunroof) :var ?V5))
				 (rassert! (assign sunroof no)
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:in ?V4) 
					(:in ?V5))))
				
				(rule ((:in (active battery) :var ?V1)
				       (:in (assign battery small) :var ?V2)
				       (:in (active air-cond) :var ?V3))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:in ?V3))))
				
				(rule ((:in (active battery) :var ?V1)
				       (:in (assign battery large) :var ?V2)
				       (:in (active air-cond) :var ?V3)
				       (:in (assign air-cond included) :var ?V4)
				       (:in (active sunroof) :var ?V5)
				       (:out (assign sunroof no) :var ?V6))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:in ?V4) 
					(:in ?V5) (:out ?V6))))
				
				;;ACTIVITY CONSTRAINTS RULES.
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine large) :var ?V2))
				 (rassert! (active air-cond)
				  (just (:in ?V1) (:in ?V2))))
				
				(rule ((:in (active engine) :var ?V1)
				       (:in (assign engine large) :var ?V2)
				       (:out (active air-cond) :var ?V3))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:out ?V3))))
				
				(rule ((:in (active air-cond) :var ?V1)
				       (:in (assign air-cond no) :var ?V2))
				 (rassert! (active sunroof)
				  (just (:in ?V1) (:in ?V2))))
				
				(rule ((:in (active air-cond) :var ?V1)
				       (:in (assign air-cond no) :var ?V2)
				       (:out (active sunroof) :var ?V3))
				 (rassert! contradictory-design
				  (just (:in ?V1) (:in ?V2) (:out ?V3))))
				
				;;FIRST, DETERMINING WHICH VARIABLES WILL 
				;;APPEAR IN THE SOLUTION
				(rule ((:in (active ?v) :var ?V1)
				       (:in (assign ?v ?val) :var ?V2))
				 (rassert! (in-solution ?v ?val)
				  (just (:in ?V1) (:in ?V2))))
				

				;;BUILDING THE SOLUTION
				(rule ((:out (active ?v) :var ?V1)
				       (:in (in-solution ?v ?val) :var ?V2))
				 (rassert! contradictory-design
				  (just (:out ?V1) (:in ?V2))))
				
				(rule ((:in (in-solution engine ?val1) :var ?V1)
				       (:in (in-solution battery ?val2) :var ?V2)
				       (:out (active air-cond) :var ?V3)
				       (:out (active sunroof) :var ?V4))
				 (rassert! (solution engine ?val1 battery ?val2)
				  (just (:in ?V1) (:in ?V2) (:out ?V3) (:out ?V4))))
				
				(rule ((:in (in-solution engine ?val1) :var ?V1)
				       (:in (in-solution battery ?val2) :var ?V2)
				       (:in (in-solution air-cond ?val3) :var ?V3)
				       (:out (active sunroof) :var ?V4))
				 (rassert! (solution engine ?val1 battery ?val2 
						     air-cond ?val3)
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:out ?V4))))
				
				(rule ((:in (in-solution engine ?val1) :var ?V1)
				       (:in (in-solution battery ?val2) :var ?V2)
				       (:in (in-solution air-cond ?val3) :var ?V3)
				       (:in (in-solution sunroof ?val4) :var ?V4))
				 (rassert! (solution engine ?val1 battery ?val2 
					    air-cond ?val3 sunroof ?val4)
				  (just (:in ?V1) (:in ?V2) (:in ?V3) (:in ?V4)))))

				  ;; assertions in NMJTRE syntax
		    :assertions '(
				  ;;IN ASSUMPTIONS
				  (assert! '(assign engine small) 'USER)

				  (assert! '(assign engine large) 'USER)
				  
				  (assert! '(assign battery small) 'USER)

				  (assert! '(assign battery large) 'USER)
				  
				  ;;OUT ASSUMPTIONS
				  (assert! '(assign air-cond included) 'USER)
				  (retract! '(assign air-cond included) 'USER)

				  (assert! '(assign air-cond no) 'USER)
				  (retract! '(assign air-cond no) 'USER)
				  
				  (assert! '(assign sunroof included) 'USER)
				  (retract! '(assign sunroof included) 'USER)

				  (assert! '(assign sunroof no) 'USER)
				  (retract! '(assign sunroof no) 'USER)
				  				
				  (assert! '(active air-cond) 'USER)
				  (retract! '(active air-cond) 'USER)

				  (assert! '(active sunroof) 'USER)
				  (retract! '(active sunroof) 'USER)

				  ;; PREMISES
				  (assert! '(active engine) 'GOD)

				  (assert! '(active battery) 'GOD))				  
		    
		    :contradiction '((contradiction 'contradictory-design))

		    :lisp-code '((defun different (x1 x2)
				   (not (eq x1 x2)))))))
  
  (pail-lib::put-pool pail-lib:*pail-pool* car-design :name "CAR DESIGN"))


;;; =======================================================================
;;; END OF FILE
;;; =======================================================================
