;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :xomo.evaluation-methods)


;;;
;;; energy calculation stuff
;;;
(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)))))

(defvar *rely-defect* 1.8)

(let ((mode 'bfc)
      (alpha 1)
      (beta  1)
      (gamma 1)
      (delta 1))
  (labels ((set-coefficients (nalpha nbeta ngamma ndelta nrely-defect)
             (setf alpha nalpha
                   beta  nbeta
                   gamma ngamma
                   delta ndelta
                   *rely-defect* nrely-defect)))

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

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

    (defun defect-weight ()
      "Returns defect weight."
      (if (= *rely-defect* 0)
          0
          (+ gamma (expt *rely-defect* (- (bag-range (! 'rely)) 3)))))

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

    (defun set-energy-score-mode (new-mode)
      (ecase new-mode
        (bfc (set-coefficients 1 1 1 1 1.8))
        (bf  (set-coefficients 0 2 2 0 1.8))
        (fc  (set-coefficients 2 2 0 0 0  ))
        (bc  (set-coefficients 2 0 2 0 1.8)))
      (setf mode new-mode))

    (defun retrieve-energy-score-mode ()
      mode)

    ;;default mode to bfc
    (set-energy-score-mode 'bfc)))


;;;
;;; 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 display-min-max-cache (&optional (stream t))
    (format stream "~&Min: ~a~&Max: ~a" 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)))))))



;;FIXME need to max and min slopes

;;TODO move xomo force methods into coc-lib

;;;
;;; min and max functions for each component of energy
;;;
(defun force-kloc (fn)
  "Forces kloc to its minimum or maximum value."
  (let* ((conf (get-current-attribute-configuration 'kloc))
         (value (funcall fn (num-min conf) (num-max conf))))
    (setf (num-min conf) value
          (num-max conf) value))
  (values))

(labels ((force-sf-helper (conf fn)
           (setf (bag-range conf) (as-list (apply fn (bag-range conf))))))

  (defun force-sf (sf fn)
    "Forces a scale factor to it's minimum or maximum value."
    (force-sf-helper (get-current-attribute-configuration sf)
                     fn)
    (values))

  (defun force-all-sfs (fn)
    "Forces scale factors to their minimum or maximum values."
    (dolist (conf (mapcar #'get-current-attribute-configuration
                          (all-db-keys)))
      (when (typep conf 'sf)
        (force-sf-helper conf fn)))
    (values)))

(labels ((other-fn (fn) (if (eq fn #'max) #'min #'max))
         (force-em-helper (conf fn)
           (setf (bag-range conf) (as-list (apply fn (bag-range conf)))))
         (force-em-effort-helper (conf fn)
           (if (typep (em-effort conf) 'em+)
               (setf (bag-range conf) (as-list (apply fn (bag-range conf))))
               (setf (bag-range conf) (as-list (apply (other-fn fn) (bag-range conf))))))
         (force-em-xin-helper (conf fn)
           (if (typep (em-cin conf) 'cin+)
               (setf (bag-range conf) (as-list (apply fn (bag-range conf))))
               (setf (bag-range conf) (as-list (apply (other-fn fn) (bag-range conf)))))))

  (defun force-em (em fn)
    (force-em-helper (get-current-attribute-configuration em)
                    fn)
    (values))

  (defun force-em-based-on-effort (em fn)
    "Forces an effort multiplier to it's minimum or maximum value based on effort.
     The opposite action is taken for an effort multiplier with negative slopes."
    (force-em-effort-helper (get-current-attribute-configuration em)
                            fn)
    (values))

  (defun force-all-ems-based-on-effort (fn)
    "Forces effort multipliers to their minimum or maximum values based on effort.
     The opposite action is taken for effort multipliers with negative slopes."
    (dolist (conf (mapcar #'get-current-attribute-configuration
                          (all-db-keys)))
      (when (typep conf 'em)
        (force-em-effort-helper conf fn)))
    (values))

  (defun force-em-based-on-xin (em fn)
    "Forces an effort multiplier to it's minimum or maximum value based on xin.
     The opposite action is taken for an effort multiplier with negative slopes."
    (force-em-xin-helper (get-current-attribute-configuration em)
                         fn)
    (values))

  (defun force-all-ems-based-on-xin (fn)
    "Forces defect introduction factors to their minimum or maximum value based on xin.
     The opposite actions is taken for defect introduction factors with negative slopes."
    (dolist (conf (mapcar #'get-current-attribute-configuration
                          (all-db-keys)))
      (when (typep conf 'em)
        (force-em-xin-helper conf fn)))
    (values)))

(labels ((force-dr-helper (conf fn)
           (setf (bag-range conf) (as-list (apply fn (bag-range conf))))))

  (defun force-dr (dr fn)
    "Forces defect removal factors to their minimum or maximum values."
    (force-dr-helper (get-current-attribute-configuration dr) fn)
    (values))

  (defun force-all-drs (fn)
    "Forces defect removal factors to their minimum or maximum values."
    (dolist (conf (mapcar #'get-current-attribute-configuration
                          (all-db-keys)))
      (when (typep conf 'dr)
        (force-dr-helper conf fn)))
    (values)))

(defun max-of-list (l)
  (apply #'max l))

(defun min-of-list (l)
  (apply #'max l))

;;;
;;; effort
;;;

(defun min-effort ()
  "Calculates minimum effort."
  (with-new-db
    (init-db)
    (force-kloc #'min)
    (force-all-sfs   #'max)
    (force-all-ems-based-on-effort   #'min)
    (monte-carlo :score-fn #'effort :combine-fn #'min-of-list :n 1000)))

(defun max-effort ()
  "Calculates maximum effort."
  (with-new-db
    (init-db)
    (force-kloc #'max)
    (force-all-sfs   #'min)
    (force-all-ems-based-on-effort   #'max)
    (monte-carlo :score-fn #'effort :combine-fn #'max-of-list :n 1000)))

;;;
;;; months
;;;

(defun min-months ()
  "Calculates minimum months."
  (with-new-db
    (init-db)
    (force-kloc #'min)
    (force-em 'sced #'min)
    (force-all-sfs #'max)
    (force-all-ems-based-on-effort #'min)
    (let ((meffort (min-effort)))
      (monte-carlo :score-fn #'(lambda () (months meffort))
                   :combine-fn #'min-of-list :n 1000))))

(defun max-months ()
  "Calculates maximum months."
  (with-new-db
    (init-db)
    (max-effort)
    (force-kloc #'max)
    (force-em 'sced #'max)
    (force-all-sfs #'min)
    (force-all-ems-based-on-effort #'max)
    (let ((meffort (max-effort)))
      (monte-carlo :score-fn #'(lambda () (months meffort))
                   :combine-fn #'max-of-list :n 1000))))

;;;
;;; defects
;;;

(defun min-defects ()
  "Calculates the minimum defects."
  (with-new-db
    (init-db)
    (force-kloc #'min)
    (force-all-sfs #'max)
    (force-all-ems-based-on-xin  #'min)
    (force-all-drs #'max)
    (monte-carlo :score-fn #'defects :combine-fn #'min-of-list :n 1000)))

(defun max-defects ()
  "Calculates the maximum defects."
  (with-new-db
    (init-db)
    (force-kloc #'max)
    (force-all-sfs   #'min)
    (force-all-ems-based-on-xin  #'max)
    (force-all-drs #'min)
    (monte-carlo :score-fn #'defects :combine-fn #'max-of-list :n 1000)))

;;;
;;; threat
;;;

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

(defun max-threat ()
  "Calculates the maximum threat."
  (labels ((extreme-value (attr fn)
             (let ((conf (get-current-attribute-configuration attr)))
               (setf (bag-range conf) (as-list (apply fn (bag-range conf)))))))
    (macrolet ((minimize (x) `(extreme-value ',x #'min))
               (maximize (x) `(extreme-value ',x #'max)))
      (with-new-db
        (init-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)
        ;;peaks
        (maximize rp-sced-rely)
        (maximize rp-sced-cplx)
        (maximize rp-sced-time)
        (maximize rp-sced-pvol)
        (maximize rp-sced-tool)
        (maximize rp-sced-plex)
        (maximize rp-sced-pcap)
        (maximize rp-sced-aexp)
        (maximize rp-sced-acap)
        (maximize rp-sced-ltex)
        (maximize rp-sced-pmat)
        (maximize rp-rely-acap)
        (maximize rp-rely-pcap)
        (maximize rp-cplx-acap)
        (maximize rp-cplx-pcap)
        (maximize rp-cplx-tool)
        (maximize rp-rely-pmat)
        (maximize rp-pmat-acap)
        (maximize rp-stor-acap)
        (maximize rp-time-acap)
        (maximize rp-tool-acap)
        (maximize rp-tool-pcap)
        (maximize rp-ruse-aexp)
        (maximize rp-ruse-ltex)
        (maximize rp-pmat-pcap)
        (maximize rp-stor-pcap)
        (maximize rp-time-pcap)
        (maximize rp-ltex-pcap)
        (maximize rp-pvol-plex)
        (maximize rp-tool-pmat)
        (maximize rp-time-tool)
        (maximize rp-team-aexp)
        (maximize rp-team-sced)
        (maximize rp-team-site)
        (monte-carlo :score-fn #'threat :combine-fn #'max-of-list :n 1000)))))  ; take upper quartile instead of median for threat


;;
;; cache-min-max
;;
(with-new-db
  (init-db)
  (cache-min-max))

;;;
;;; register
;;;
(register-evaluation-method-by-parameters 'energy
                                          "energy"
                                          (augment-evaluate-state-function-by-ids #'energy
                                                                                  :store-evaluation-score
                                                                                  :with-constraints
                                                                                  :xomo-scores
                                                                                  :ignore-state)
                                          #'<)