;-*- Mode: LISP; Syntax: Common-lisp; Package: USER-*-

;;; This file is ">bps>code>tcon>examples"

;;; To run this gde.

;;; Load the file atms
;;; Load the file atcon
;;; Load the file gde
;;; Load the file models
;;; Load the file condef
;;; Call standard-poly.

(defun standard-poly ()
  (setq *atcon* (create-atcon "Poly"))
  (create 'p 'poly)
  (set-parameter (>> a p) 3)
  (set-parameter (>> b p) 2)
  (set-parameter (>> c p) 2)
  (set-parameter (>> d p) 3)
  (set-parameter (>> e p) 3)

  (format T "~% Measured f to be 10")
  (set-parameter (>> f p) 10)
  (print-minimal-conflicts)
  (print-minimal-diagnoses)
  (print-smallest-diagnoses)
  (score-measurements (smallest-diagnoses))
  (format T "~% Measured g to be 12")
  (set-parameter (>> g p) 12)
  (print-minimal-conflicts)
  (print-minimal-diagnoses)
  (print-smallest-diagnoses)
  (score-measurements (smallest-diagnoses)))

(defun ole-string (node &aux value)
  (setq value (tms-node-datum node))
  (cond ((stringp value) value)
	((value-string value))
	((eq (cell-name (value-cell value)) 'OK)
	 (format nil "~A" (constraint-pretty-name (cell-owner (value-cell value)))))
	(t (format nil "~A = ~A" (cell-pretty-name (value-cell value))
		   (value-datum value)))))


(defun standard-ole ()
  (setq *atcon* (create-atcon "ole"))
  (create 'add '2-bit-adder-ok)
  (change-atms (atcon-atms *atcon*) :node-string 'ole-string)
  (set-parameter (>> a bit0 add) 0)
  (set-parameter (>> b bit0 add) 0)
  (set-parameter (>> a bit1 add) 0)
  (set-parameter (>> b bit1 add) 0)
  (set-parameter (>> ci bit0 add) 0)
  (set-parameter (>> q bit1 add) 1)
;  (assume-parameter (>> co bit1 add) 1)
  (diagnose))




(defun ole-adder ()
  (setq *atcon* (create-atcon "Poly" :prototype-file ">bps>code>tcon>condef" :debugging t))
  (create *atcon* 'add '2-bit-adder)
  (assume-parameter (>> a bit0 add) 1 "a0=1")
  (assume-parameter (>> b bit0 add) 1 "b0=1")
  (assume-parameter (>> a bit1 add) 1 "a1=1")
  (assume-parameter (>> b bit1 add) 1 "b1=1")
  (assume-parameter (>> ci bit0 add) 1 "ci=1")
;  (assume-parameter (>> q bit1 add) 0 "q1=0")
  (assume-parameter (>> co bit1 add) 0 "co=0")
  (show-network *atcon*))

(defun ole-bad ()
  (create-atcon "Poly" :prototype-file ">bps>code>tcon>condef" :debugging t)
  (create 'add '2-bit-adder)
  (assume-parameter (>> a bit0 add) 1 "a0=1")
  (assume-parameter (>> b bit0 add) 1 "b0=1")
  (assume-parameter (>> a bit1 add) 1 "a1=1")
  (assume-parameter (>> b bit1 add) 1 "b1=1")
  (assume-parameter (>> ci bit0 add) 1 "ci=1")
  (show-network *atcon*)
  (set-parameter (>> co bit1 add) 0)
  (show-network *atcon*))

(defun ole-all ()
  (create-atcon "Poly" :prototype-file ">bps>code>tcon>condef" :debugging t)
  (create 'add '2-bit-adder)
  (assume-parameter (>> a bit0 add) 1 "a0=1")
  (assume-parameter (>> a bit0 add) 0 "a0=0")
  (assume-parameter (>> b bit0 add) 1 "b0=1")
  (assume-parameter (>> b bit0 add) 0 "b0=0")
  (assume-parameter (>> a bit1 add) 1 "a1=1")
  (assume-parameter (>> a bit1 add) 0 "a1=0")
  (assume-parameter (>> b bit1 add) 1 "b1=1")
  (assume-parameter (>> b bit1 add) 0 "b1=0")
  (assume-parameter (>> ci bit0 add) 1 "ci=1")
  (assume-parameter (>> ci bit0 add) 0 "ci=0")

  (show-network *atcon*))

(defun test-delay (&aux as1 as2 as3)
  (create-atcon "Test delay" :prototype-file ">bps>code>tcon>condef" :debugging t)
  (setq *atms* (atcon-atms *atcon*))
  (create 'a 'adder)
  (setq as1 (tms-create-node *atms* "as1" :assumptionp t)
	as2 (tms-create-node *atms* "as2" :assumptionp t)
	as3 (tms-create-node *atms* "as3" :assumptionp t))
  (set! (>> a1 a) 1 'test-delay (list as1))
  (set! (>> a2 a) 1 'test-delay (list as2))
  (nogood-nodes 'test-delay (list as1 as2))
  (fire-constraints *atcon*)
  (show-network *atcon*)
  (set! (>> a1 a) 1 'test-delay (list as3))
  (set! (>> a2 a) 1 'test-delay (list as3))
  (fire-constraints *atcon*)
  (show-network *atcon*))