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

;; rxy macros mutate the risk tables using (min . max) pairs
;; x = original peak value, y = original tabled value
(labels ((r-- () '(0   . 0   ))
	 (r20 () '(0   . 0.75))
	 (r21 () '(0.5 . 1.5 ))
	 (r22 () '(1   . 3   ))
	 (r40 () '(0   . 0.5 ))
	 (r41 () '(0.5 . 1   ))
	 (r42 () '(1   . 2   ))
	 (r44 () '(2   . 4   )))
  
  (defun vl-vl-2 ()
    (make-array '(6 6) :initial-contents `((,(r22) ,(r21) ,(r20) ,(r--) ,(r--) ,(r--))
					   (,(r21) ,(r20) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r20) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))

  (defun vl-vl-4 ()
    (make-array '(6 6) :initial-contents `((,(r44) ,(r42) ,(r41) ,(r40) ,(r--) ,(r--))
					   (,(r42) ,(r41) ,(r40) ,(r--) ,(r--) ,(r--))
					   (,(r41) ,(r40) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r40) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))

  (defun vl-vh-2 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r20) ,(r21) ,(r22) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r20) ,(r21) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r20) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))
  
  (defun vl-xh-4 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r40) ,(r41) ,(r42) ,(r44))
					   (,(r--) ,(r--) ,(r--) ,(r40) ,(r41) ,(r42))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r40) ,(r41))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r40))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))

  (defun vh-vl-2 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r20) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r21) ,(r20) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r22) ,(r21) ,(r20) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))

  (defun vh-vl-4 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r40) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r41) ,(r40) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r42) ,(r41) ,(r40) ,(r--) ,(r--) ,(r--))
					   (,(r44) ,(r42) ,(r41) ,(r40) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--)))))
  
  (defun xh-vl-2 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r20) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r21) ,(r20) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r22) ,(r21) ,(r20) ,(r--) ,(r--) ,(r--)))))
  
  (defun xh-vl-4 ()
    (make-array '(6 6) :initial-contents `((,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r--) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r40) ,(r--) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r41) ,(r40) ,(r--) ,(r--) ,(r--) ,(r--))
					   (,(r42) ,(r41) ,(r40) ,(r--) ,(r--) ,(r--))
					   (,(r44) ,(r42) ,(r41) ,(r40) ,(r--) ,(r--))))))

(defparameter *risk-tables*
  `(((sced rely) . ,(vl-vh-2))
    ((sced cplx) . ,(vl-xh-4))
    ((sced time) . ,(vl-xh-4))
    ((sced pvol) . ,(vl-vh-2))
    ((sced tool) . ,(vl-vl-2))
    ((sced plex) . ,(vl-vl-4))
    ((sced pcap) . ,(vl-vl-4))
    ((sced aexp) . ,(vl-vl-4))
    ((sced acap) . ,(vl-vl-4))
    ((sced ltex) . ,(vl-vl-2))
    ((sced pmat) . ,(vl-vl-2))
    ((rely acap) . ,(vh-vl-4))
    ((rely pcap) . ,(vh-vl-4))
    ((cplx acap) . ,(xh-vl-4))
    ((cplx pcap) . ,(xh-vl-4))
    ((cplx tool) . ,(xh-vl-4))
    ((rely pmat) . ,(vh-vl-4))
    ((pmat acap) . ,(vl-vl-2))
    ((stor acap) . ,(xh-vl-4))
    ((time acap) . ,(xh-vl-4))
    ((tool acap) . ,(vl-vl-2))
    ((tool pcap) . ,(vl-vl-2))
    ((ruse aexp) . ,(xh-vl-4))
    ((ruse ltex) . ,(xh-vl-4))
    ((pmat pcap) . ,(vl-vl-2))
    ((stor pcap) . ,(xh-vl-4))
    ((time pcap) . ,(xh-vl-4))
    ((ltex pcap) . ,(vl-vl-4))
    ((pvol plex) . ,(vh-vl-2))
    ((tool pmat) . ,(vl-vl-2))
    ((time tool) . ,(xh-vl-2))
    ((team aexp) . ,(vl-vl-2))
    ((team sced) . ,(vl-vl-2))
    ((team site) . ,(vl-vl-2))))

(defun threat ()
  "Returns the total threat of schedule overrun."
  (/ (+ (schedule-risk) (product-risk) (personnel-risk)
	(process-risk) (platform-risk) (reuse-risk))
     3.73))

(defmacro r (row col)
  "Returns the product of risk values and the risk multiplier"
  `(* (2risk ',row) (2risk ',col)
    (let* ((x     (bag-range (! ',row)))
	   (y     (bag-range (! ',col)))
	   (table (cdr (assoc (list ',row ',col) *risk-tables* :test #'equal)))
	   (range (aref table (1- x) (1- y)))
	   (min   (car range))
	   (max   (cdr range)))
      (?quantity min max))))

(defun 2risk (x)
  "Returns the risk value.  For effort multipliers, this is the same as the
   tabled COCOMO value.  For scale factors, see cocomo.c lines 856 to 866."
  (cond ((subtypep (type-of (! x)) 'em)
	 (em2effort x))
	((subtypep (type-of (! x)) 'sf)
	 (let* ((range (sf-range (! x)))
		(power (case range
			 (1 0.02)
			 (2 0.01)
			 (t 0.00))))
	   (expt (! 'kloc) power)))
	(t
	 (warn "can't handle ~a of type ~a" x (type-of (! x))))))

(defun schedule-risk ()
  "Calculates schedule risk."
  (+ (r sced rely) (r sced time) (r sced pvol) (r sced tool)
     (r sced acap) (r sced aexp) (r sced pcap) (r sced plex)
     (r sced ltex) (r sced pmat)))

(defun product-risk ()
  "Calculates product risk."
  (+ (r rely acap) (r rely pcap) (r cplx acap) (r cplx pcap)
     (r cplx tool) (r rely pmat) (r sced cplx) (r sced rely)
     (r sced time) (r ruse aexp) (r ruse ltex)))

(defun personnel-risk ()
  "Calculates personnel risk."
  (+ (r pmat acap) (r stor acap) (r time acap) (r tool acap)
     (r tool pcap) (r ruse aexp) (r ruse ltex) (r pmat pcap)
     (r stor pcap) (r time pcap) (r ltex pcap) (r pvol plex)
     (r sced acap) (r sced aexp) (r sced pcap) (r sced plex)
     (r sced ltex) (r rely acap) (r rely pcap) (r cplx acap)
     (r cplx pcap) (r team aexp)))

(defun process-risk ()
  "Calculates process risk."
  (+ (r tool pmat) (r time tool) (r team aexp) (r team sced)
     (r team site) (r sced tool) (r sced pmat) (r cplx tool)
     (r pmat acap) (r tool acap) (r tool pcap) (r pmat pcap)))

(defun platform-risk ()
  "Calculates platform risk."
  (+ (r sced time) (r sced pvol) (r stor acap) (r time acap)
     (r stor pcap) (r pvol plex) (r time tool)))

(defun reuse-risk ()
  "Calculates reuse risk."
  (+ (r ruse aexp) (r ruse ltex)))