;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; energy calculation stuff

(defvar *rely-defect* 1.8)

(defun energy ()
  "Calculates energy, a combined measure of effort, months, defects, and threat."
  (/ (unnormalized-energy)
     (sqrt (+ (expt (effort-weight) 2)
	      (expt (months-weight) 2)
	      (expt (defect-weight) 2)
	      (expt (threat-weight) 2)))))

(defun unnormalized-energy ()
  "Calculates unnormalized energy."
  (let* ((effort   (effort))
	 (months   (months effort))
	 (defects  (defects))
	 (threat   (threat))
	 (neffort  (normalize 'effort  effort))
	 (nmonths  (normalize 'months  months))
	 (ndefects (normalize 'defects defects))
	 (nthreat  (if (< threat 5) 0 (normalize 'threat threat))))  ; ignore threat if less than 5
    (sqrt (+ (expt (* neffort  (effort-weight)) 2)
	     (expt (* nmonths  (months-weight)) 2)
	     (expt (* ndefects (defect-weight)) 2)
	     (expt (* nthreat  (threat-weight)) 2)))))

(defun effort-weight ()
  "Returns effort weight."
  1)

(defun months-weight ()
  "Returns months weight."
  1)

(defun defect-weight ()
  "Returns defect weight."
  (+ 1 (expt *rely-defect* (- (em-range (! 'rely)) 3))))

(defun threat-weight ()
  "Returns threat weight."
  1)

;;; normalization stuff

(let (mins maxes)
  (defun cache-min-max ()
    "Caches the minimum and maximum effort, months, defects, and threat.
     Call this function AFTER setting any ranges in db-settings."
    (setf mins  `((effort  . ,(min-effort))
		  (months  . ,(min-months))
		  (defects . ,(min-defects))
		  (threat  . ,(min-threat))))
    (setf maxes `((effort  . ,(max-effort))
		  (months  . ,(max-months))
		  (defects . ,(max-defects))
		  (threat  . ,(max-threat))))
    (list mins maxes))

  (defun normalize (which value)
    "Returns the normalized effort, months, defects, or threat."
    (let ((min (geta which mins))
	  (max (geta which maxes)))
      (cond ((< value min)
	     (warn "~a value ~,3f out of range ~,3f to ~,3f for normalization" which value min max)
	     0)
	    ((> value max)
	     (warn "~a value ~,3f out of range ~,3f to ~,3f for normalization" which value min max)
	     1)
	    (t
	     (/ (- value min)
		(- max min)))))))

;;; min and max functions for each component of energy

(defmacro with-new-db (&body body)
  "Creates a temporary db with the same db-settings as the current db."
  (let ((old-db  (gensym))
	(new-db  (gensym))
	(ret-val (gensym)))
    `(let ((,old-db *db*)
	   (,new-db (init-db))
	   ,ret-val)
      (dolist (setting (db-settings ,new-db))
	(let ((key   (car setting))
	      (value (cdr setting)))
	  (if (or (eq (type-of value) 'sf)
		  (eq (type-of value) 'em)
		  (eq (type-of value) 'dr))
	      (setf (bag-range (bag-range value))
		    (bag-range (bag-range (geta key (db-settings ,old-db))))))))
      (setf *db* ,new-db)
      (setf ,ret-val (progn ,@body))
      (setf *db* ,old-db)
      ,ret-val)))

(defun force-kloc (fn)
  "Forces kloc to its minimum or maximum value."
  (let ((value (funcall fn (num-min (kloc?)) (num-max (kloc?)))))
    (kloc! value value)))

(defun force-sf (fn)
  "Forces scale factors to their minimum or maximum values."
  (dolist (setting (db-settings *db*))
    (let ((key   (car setting))
	  (value (cdr setting)))
      (when (eq (type-of value) 'sf)
	(range! key (apply fn (bag-range (bag-range value))))))))

(labels ((other-fn (fn) (if (eq fn #'max) #'min #'max)))
  (defun force-em (fn)
    "Forces effort multipliers to their minimum or maximum values.
     The opposite action is taken for effort multipliers with negative slopes."
    (dolist (setting (db-settings *db*))
      (let ((key   (car setting))
	    (value (cdr setting)))
	(when (eq (type-of value) 'em)
	  (if (eq (type-of (em-effort value)) 'em+)
	      (range! key (apply fn            (bag-range (bag-range value))))
	      (range! key (apply (other-fn fn) (bag-range (bag-range value)))))))))

  (defun force-xin (fn)
    "Forces defect introduction factors to their minimum or maximum values.
     The opposite actions is taken for defect introduction factors with negative slopes."
    (dolist (setting (db-settings *db*))
      (let ((key   (car setting))
	    (value (cdr setting)))
	(when (eq (type-of value) 'em)
	  (if (eq (type-of (em-cin value)) 'cin+)
	      (range! key (apply fn            (bag-range (bag-range value))))
	      (range! key (apply (other-fn fn) (bag-range (bag-range value))))))))))

(defun force-xout (fn)
  "Forces defect removal factors to their minimum or maximum values."
  (dolist (setting (db-settings *db*))
    (let ((key   (car setting))
	  (value (cdr setting)))
      (when (eq (type-of value) 'dr)
	(range! key (apply fn (bag-range (bag-range value))))))))

(defun min-effort ()
  "Calculates minimum effort."
  (with-new-db
    (force-kloc #'min)
    (force-sf   #'max)
    (force-em   #'min)
    (car (monte-carlo :fn #'effort :n 1000))))

(defun max-effort ()
  "Calculates maximum effort."
  (with-new-db
    (force-kloc #'max)
    (force-sf   #'min)
    (force-em   #'max)
    (car (monte-carlo :fn #'effort :n 1000))))

(defun min-months ()
  "Calculates minimum months."
  (with-new-db
    (force-kloc #'min)
    (range! 'sced (apply #'min (range? 'sced)))
    (force-sf   #'max)
    (force-em   #'min)
    (car (monte-carlo :fn #'months :n 1000))))

(defun max-months ()
  "Calculates maximum months."
  (with-new-db
    (force-kloc #'max)
    (range! 'sced (apply #'max (range? 'sced)))
    (force-sf   #'min)
    (force-em   #'max)
    (car (monte-carlo :fn #'months :n 1000))))

(defun min-defects ()
  "Calculates the minimum defects."
  (with-new-db
    (force-kloc #'min)
    (force-sf   #'max)
    (force-xin  #'min)
    (force-xout #'max)
    (car (monte-carlo :fn #'defects :n 1000))))

(defun max-defects ()
  "Calculates the maximum defects."
  (with-new-db
    (force-kloc #'max)
    (force-sf   #'min)
    (force-xin  #'max)
    (force-xout #'min)
    (car (monte-carlo :fn #'defects :n 1000))))

(defun min-threat ()
  "Calculates the minimum threat."
  0)

(defun max-threat ()
  "Calculates the maximum threat."
  (macrolet ((minimize (x) `(range! ',x (apply #'min (range? ',x))))
	     (maximize (x) `(range! ',x (apply #'max (range? ',x)))))
    (with-new-db
      (force-kloc #'max)
      (minimize acap)
      (minimize aexp)
      (minimize ltex)
      (minimize pcap)
      (minimize plex)
      (minimize pmat)
      (minimize sced)
      (minimize site)
      (minimize team)
      (minimize tool)
      (maximize cplx)
      (maximize pvol)
      (maximize rely)
      (maximize ruse)
      (maximize stor)
      (maximize time)
      (third (monte-carlo :fn #'threat :n 1000)))))  ; take upper quartile instead of median for threat