#| This prog will score the area under the 
curve for a given trial PB, AG, AG2, HY
|#

;removing the labels
(defun trim-label (lst)
  (if (null lst)
      nil
      (append (list (rest (car lst))) (trim-label (rest lst)))))

;triangle area
(defun tri-area (b h)
  (float (/ (* b h) 2)))

;rectangle area
(defun rec-area (b h)
  (float (* b h)))

;cumulate the cost and values of the list
(defun cumulate (lst)
  (cumulat-value (cumulat-cost lst (get-cost-cumulat lst)) (get-value-cumulat lst)))
;cumulative cost
(defun cumulat-cost (lst costLst)
  (if (null lst)
      nil 
	(append (list (list (car costLst) (second (car lst))))
		(cumulat-cost (cdr lst) (cdr costLst)))))

;cumulative value
(defun cumulat-value (lst valueLst)
  (if (null lst)
      nil 
	(append (list (list (car (car lst)) (car valueLst)))
		(cumulat-value (cdr lst) (cdr valueLst)))))

;accumulate list of costs 
(defun get-cost-cumulat (lst)
  (cd-rec (reverse (get-cost lst))))

;accumulate list of costs 
(defun get-value-cumulat (lst)
  (cd-rec (reverse (get-value lst))))


;utility function needed for get-cost fun
(defun get-cost (lst)
  (if (null lst)
      nil
      (append  (list (car (car lst))) (get-cost (cdr lst)))))

;utility function to get the value
(defun get-value (lst)
   (if (null lst)
      nil
      (append  (list (second (car lst))) (get-value (cdr lst)))))

;find area under the curve
(defun score (first lst)
  (if (null lst)
      0
  (let* ((cost1 (car first))
	 (cost2 (car (car lst)))
	 (value1 (second first))
	 (value2 (second (car lst))))
    (if (and (= cost1 0) (= value1 0))
	(+(tri-area cost2 value2) (score (car lst) (rest lst)))
	(+ (+(rec-area (- cost2 cost1) value1) (tri-area (- cost2 cost1) (- value2 value1)))
	   (score (car lst) (rest lst)))))))
	
	
;;; score the treatment
;;; return a consed list: (treatment . score)
(defun scit (inp &key (mdl #'p2plan) (runs 5))
  (labels ((gv (ch)
	     (gethash ch inp)))
    (setf *pomseed* (reset-seed))
    (let ((scrs nil)
	  (ss nil)
	  (meds 0))
      (dotimes (i runs)
	(let* ((strt '(0 0))
	       (rlst (funcall mdl 
			      :req-value-sigma (gv 'req-value-sigma)
			      :ave-new-req-per-ite (gv 'ave-new-req-per-ite)
			      :end-dev-prob (gv 'end-dev-prob)
			      :xcr (floor (gv 'xcr))
			      :cr (gv 'cr)
			      :al (gv 'al)
			      :be (gv 'be)
			      :size (floor (gv 'size))
			      :cul (gv 'cul)))
	       (olst (progn
		       (setf *pomseed* (reset-seed))
		       (funcall 'of2
			      :req-value-sigma (gv 'req-value-sigma)
			      :ave-new-req-per-ite (gv 'ave-new-req-per-ite)
			      :end-dev-prob (gv 'end-dev-prob)
			      :xcr (floor (gv 'xcr))
			      :cr (gv 'cr)
			      :al (gv 'al)
			      :be (gv 'be)
			      :size (floor (gv 'size))
			      :cul (gv 'cul))))
	       (scr1 (score strt (cumulate (trim-label rlst))))
	       (scr2 (score strt (cumulate (trim-label olst))))
	       (totsc (/ scr1 scr2)))
	  (set-seed (random-seed))
	  (push totsc scrs)))
      (setf ss (sort scrs #'<))
      (setf meds (nth (floor (/ (length ss) 2))
		      ss))
      meds
;      (if (> meds 0)
;	  (cons inp (log meds 10))
;	  (cons inp 0))
)))