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

(let ((names  
       '((xh . 6) (6 . 6) (extremelyhigh . 6)
	 (vh . 5) (5 . 5) (veryhigh . 5)
	 (h  . 4) (4 . 4) (high .  4)
	 (n  . 3) (3 . 3) (nominal . 3)
	 (l  . 2) (2 . 2) (verylow . 2)
	 (vl . 1) (1 . 1) (low . 1))))
  (defun coco1 (x)
    (or (cdr (assoc x names))
	(warn "~a not a known coco-name" x)
	x))
  (defun coco (l) 
    (mapcar #'coco1 l))
  (defun coco-restrict (old new)
    (let* ((new1 (coco new))
	   (overlap (intersection new1 old)))
      (or overlap
	  (warn "~a does not intersect with ~a" old new)
          old)))
)

(egs :coco
     (eg  '(coco '(1 2 3))
	  :out '(1 2 3))
     (eg '(coco '(vl l n))
	 :out '(1 2 3))
     (eg '(coco '(vl 2 n))
	 :out '(1 2 3)))


(defstruct (sf   (:include bag)) effort rsf dsf csf)
(defstruct (em   (:include bag)) effort rin din cin)
(defstruct (dr   (:include bag)) rout dout cout)

; cocomo input ranges
(defstruct (r15  (:include bag (range (coco '(1 2 3 4 5  ))))))
(defstruct (r16  (:include bag (range (coco '(1 2 3 4 5 6))))))
(defstruct (r25  (:include bag (range (coco '(  2 3 4 5  ))))))
(defstruct (r26  (:include bag (range (coco '(  2 3 4 5 6))))))
(defstruct (r36  (:include bag (range (coco '(    3 4 5 6))))))

; read and write to ranges
(defmacro range? (x) ; declared as macro so we can "setf" it
  `(bag-range
    (bag-range 
     (cdr
      (assoc  ,x (db-settings *db*))))))

(defun range! (x y) ; simple as pie, once we've setf-ed range?"
  (setf (range? x)  (as-list y)))
  
(defmacro kloc? ()
  `(cdr (assoc 'kloc (db-settings *db*))))

(defun kloc! (min max)
  (setf (kloc?) (make-num :min min :max max)))

(defstruct (sfs  (:include num (max  -1.56  ) (min -1.015 ))))
(defstruct (em+  (:include num (max   0.25  ) (min  0.073 ))))
(defstruct (em-  (:include num (max  -0.178 ) (min -0.078 ))))

;; defect introduction,  factors for effort multiplers
; requirements
(defstruct (rin+ (:include num (max   0.112 ) (min  0     ))))
(defstruct (rin- (:include num (max  -0.146 ) (min -0.034 ))))

;  design time
(defstruct (din+ (:include num (max   0.117 ) (min  0.08  ))))
(defstruct (din- (:include num (max  -0.152 ) (min -0.038 ))))

; coding time
(defstruct (cin+ (:include num (max   0.117 ) (min  0.008 ))))
(defstruct (cin- (:include num (max  -0.152 ) (min -0.042 ))))

; defect introduction factors for scale factors
(defstruct (rsf  (:include num (max  -0.146 ) (min  0.0   ))))
(defstruct (dsf  (:include num (max  -0.208 ) (min  0.0   ))))
(defstruct (csf  (:include num (max  -0.190 ) (min  0.0   ))))

; defect removel factors for automatedAnalysis, peerReviews, execTest
(defstruct (rdr  (:include num (max   0.117 ) (min  0.083 ))))
(defstruct (ddr  (:include num (max   0.130 ) (min  0.083 ))))
(defstruct (codr (:include num (max   0.147 ) (min  0.092 ))))

; cocomo tuning parameters
(defstruct one-a line) 
(defstruct one-b num) ; b falls underneath the a line

(defun ?em (x)
  "from a floating em, pull fixed values"
  (make-em 
   :range  (?bag (em-range  x))
   :effort (?num (em-effort x))
   :rin    (?num (em-rin    x))
   :din    (?num (em-din    x))
   :cin    (?num (em-cin    x))))

(defun ?sf (x)
  "from a floating sf, pull fixed values"
  (make-sf 
   :range  (?bag (sf-range  x))
   :effort (?num (sf-effort x))
   :rsf    (?num (sf-rsf    x))
   :dsf    (?num (sf-dsf    x))
   :csf    (?num (sf-csf    x))))

(defun ?dr (x)
  "from a floating defect remover, pull fixed values"
  (make-dr
   :range (?bag (dr-range x))
   :rout  (?num (dr-rout x))
   :dout  (?num (dr-dout x))
   :cout  (?num (dr-cout x))))


(defun ?one-a (r)
  "from a floating a-line, pull fixed values"
  (let ((line  (one-a-line r)))
    (?quantity (line-x1 line) 
	       (line-x2 line))))

(defun ?one-b (r &optional 
	       (a-val (! 'a)) 
	       (a-line (one-a-line 
			(geta 'a (db-settings *db*)))))
  "from a floating b, pull fixed values"
  ; note that "b" is defined in terms of "a"
  (let ((inc (?num (one-b-num r))))
    (max 0 (- (line-y a-val a-line ) inc))))

 
(defun pivoted-line         (x m) (+ 1 (* m (- x 3))))
(defun  hinged-line         (x m) (* m (- x 6)))
(defun hinged-line-coqualmo (x m) (* m (- x 1)))

(defun em2effort (x) (let ((x1 (! x))) (pivoted-line          (em-range x1) (em-effort x1))))
(defun em2rin    (x) (let ((x1 (! x))) (pivoted-line          (em-range x1) (em-rin    x1))))
(defun em2din    (x) (let ((x1 (! x))) (pivoted-line          (em-range x1) (em-din    x1))))
(defun em2cin    (x) (let ((x1 (! x))) (pivoted-line          (em-range x1) (em-cin    x1))))

(defun sf2effort (x) (let ((x1 (! x))) (hinged-line           (sf-range x1) (sf-effort x1))))
(defun sf2rin    (x) (let ((x1 (! x))) (hinged-line           (sf-range x1) (sf-rsf    x1))))
(defun sf2din    (x) (let ((x1 (! x))) (hinged-line           (sf-range x1) (sf-dsf    x1))))
(defun sf2cin    (x) (let ((x1 (! x))) (hinged-line           (sf-range x1) (sf-csf    x1))))

(defun dr2rout   (x) (let ((x1 (! x))) (hinged-line-coqualmo  (dr-range x1) (dr-rout  x1))))
(defun dr2dout   (x) (let ((x1 (! x))) (hinged-line-coqualmo  (dr-range x1) (dr-dout   x1))))
(defun dr2cout   (x) (let ((x1 (! x))) (hinged-line-coqualmo  (dr-range x1) (dr-cout   x1))))

(defun init-db (&optional (settings (cocomo-defaults)))
  (setf *db* (init-db0 settings)))

(defun init-db0 (&optional (settings (cocomo-defaults)))
  (make-db :settings settings))

(defun demo123 ()
  (init-db)
  (dolist (item (db-settings *db*))
    (print (car item))
    (case (type-of (cdr item))
      (one-a (print (! 'a)))
      (one-b (print (! 'b)))
      (num 
       (print (?num (cdr item))))
      (em        
       (print (em2effort (car item)))
       (print (em2rin    (car item)))
       (print (em2din    (car item)))
       (print (em2cin    (car item))))
      (sf 
       (print (sf2effort (car item)))
       (print (sf2rin    (car item)))
       (print (sf2din    (car item)))
       (print (sf2cin    (car item))))
      (dr
       (print (dr2rout   (car item)))
       (print (dr2dout   (car item)))
       (print (dr2cout   (car item))))       
      )))

(defun demo456a (r &optional (*db* *db*))
  (dotimes (i r)
    (dolist (item (db-settings *db*))
      (case (type-of (cdr item))
	(one-a  (! 'a))
	(one-b  (! 'b))
	(num 
	 (?num (cdr item)))
	(em        
	 (em2effort (car item))
	 (em2rin    (car item))
	 (em2din    (car item))
	 (em2cin    (car item)))
	(sf 
	 (sf2effort (car item))
	 (sf2rin    (car item))
	 (sf2din    (car item))
	 (sf2cin    (car item)))
	(dr
	 (dr2rout   (car item))
	 (dr2dout   (car item))
	 (dr2cout   (car item)))       
	))))


(defun demo456 (&optional (r 10000))
  (init-db)
  (demo456a r ))