(defun score (result) (let ((initial (pop result)) (front (pop result)) (run (pop result)) (cumValRun 0) (cumCostRun 0) (cumValFront 0) (cumCostFront 0) (cumCostInitial 0) (cumValInitial 0) (areaUnderFront (list)) (areaUnderInitial (list)) (areaUnder (list))) ;(setf (result-endCosts run) (reverse (result-endCosts run))) ;(setf (result-endCosts front) (reverse (result-endCosts front))) ;(setf (result-endCosts initial) (reverse (result-endCosts initial))) ;;(setf (result-endCosts run) (reverse (result-endCosts run))) ;;(setf (result-endValues run) (reverse (result-endValues run))) ;(setf (result-endValues run) (reverse (result-endValues run))) ;(setf (result-endValues front) (reverse (result-endValues front))) ;(setf (result-endValues initial) (reverse (result-endValues initial))) (let ((pCost 0) (pValue 0)) (while (first (result-endCosts run)) (let ((cost (pop (result-endCosts run))) (value (pop (result-endValues run)))) ;(incf areaUnder (+ (* cumCostRun value) (/ (* cost value) 2))) ;(setf pCost cost) ;(setf pValue value) (incf cumCostRun cost) (incf cumValRun value) (push (list cumCostRun cumValRun) areaUnder)))) (let ((pCost 0) (pValue 0)) (while (first (result-endCosts front)) (let ((cost (pop (result-endCosts front))) (value (pop (result-endValues front)))) ;(incf areaUnderFront (+ (* cumCostFront value) (/ (* cost value) 2))) ;(setf pCost cost) ;(setf pValue value) (incf cumCostFront cost) (incf cumValFront value) (push (list cumCostFront cumValFront) areaUnderFront)))) (let ((pCost 0) (pValue 0)) (while (first (result-endCosts initial)) (let ((cost (pop (result-endCosts initial))) (value (pop (result-endValues initial)))) ;(incf areaUnderInitial (+ (* cumCostInitial value) (/ (* cost value) 2))) ;(setf pCost cost) ;(setf pValue value) (incf cumCostInitial cost) (incf cumValInitial value) (push (list cumCostInitial cumValInitial) areaUnderInitial)))) ;(print (reverse areaUnder)) (setf areaUnder (score-helper (list 0 0) (reverse areaUnder))) (setf areaUnderFront (score-helper (list 0 0) (reverse areaUnderFront))) (setf areaUnderInitial (score-helper (list 0 0) (reverse areaUnderInitial))) ;(format t "~%f:~A, p:~A, r:~A~%" areaUnderFront areaUnderInitial areaUnder) (if (or (= (- areaUnder areaUnderInitial) 0) (= (- areaUnderFront areaUnderInitial) 0)) 0 (/ (- areaUnder areaUnderInitial) (- areaUnderFront areaUnderInitial))))) ;triangle area (defun tri-area (b h) (float (/ (* b h) 2))) ;rectangle area (defun rec-area (b h) (float (* b h))) (defun score-helper (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-helper (car lst) (rest lst))) (+ (+(rec-area (- cost2 cost1) value1) (tri-area (- cost2 cost1) (- value2 value1))) (score-helper (car lst) (rest lst)))))))