;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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.model)

;;; cocomo name canonicalization

(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) (low           . 2)
	 (vl . 1) (1 . 1) (verylow       . 1))))
  
  (defun coco1 (x)
    "Converts a single COCOMO name into canonical form."
    (or (cdr (assoc x names))
        (when (and (numberp x)
                   (<= 1 x 6))
          x)
	(warn "~a not a known coco-name" x)
	x))
  
  (defun coco (l)
    "Converts a list of COCOMO names into canonical form."
    (mapcar #'coco1 l))
  
  (defun coco-restrict (old new)
    "Returns the intersection of two lists of COCOMO names."
    (let* ((old1 (coco old))
	   (new1 (coco new))
	   (overlap (intersection new1 old1 :test #'equalp)))
      (or overlap
	  (warn "~a does not intersect with ~a" old new)
          old))))

;;; cocomo tuning parameters

(defstruct (one-a (:include num)))
(defstruct (one-b (:include num)))
(defstruct (one-c (:include num)))
(defstruct (one-d (:include num)))

(defvar *a-b-correlation* nil "line specifing a-b correlation")
(defvar *a-b-correlation-wiggle* nil "wiggle is added after correlation")

(defmethod guess ((x one-b))
  (if *a-b-correlation*
      (let* ((conf (get-current-attribute-configuration 'b))
             (lower (one-b-min conf))
             (upper (one-b-max conf)))
        (numlimit (+ (line-y (! 'a)
                             *a-b-correlation*)
                     (if *a-b-correlation-wiggle*
                         (guess *a-b-correlation-wiggle*)
                         0))
                  lower
                  upper))
      (call-next-method)))

;;; cocomo factors

(defstruct (sf (:include bag)) effort rsf dsf csf)        ; scale factor
(defstruct (em (:include bag)) effort rin din cin)        ; effort multiplier
(defstruct (augmented-em (:include em)) augment-range-fn) ; em that range is augmented
(defstruct (dr (:include bag)) rout dout cout)            ; defect remover


;;FIXME object that describes sf/em/... and object returned by guess should be different
(defmethod guess ((x sf))
  (make-sf :range    (call-next-method)
	   :effort   (guess (sf-effort x))
	   :rsf      (guess (sf-rsf    x))
	   :dsf      (guess (sf-dsf    x))
	   :csf      (guess (sf-csf    x))))

(defmethod guess ((x em))
  (make-em :range    (call-next-method)
	   :effort   (guess (em-effort x))
	   :rin      (guess (em-rin    x))
	   :din      (guess (em-din    x))
	   :cin      (guess (em-cin    x))))


(defmethod guess ((x augmented-em))
  (let ((em (call-next-method)))
    (setf (em-range em)
          (funcall (augmented-em-augment-range-fn x)
                   (em-range em)))
    em))

(defmethod guess ((x dr))
  (make-dr :range    (call-next-method)
	   :rout     (guess (dr-rout  x))
	   :dout     (guess (dr-dout  x))
	   :cout     (guess (dr-cout  x))))

;;; cocomo calculations

(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 (if (symbolp x) (! x) x))) (pivoted-line         (em-range x1) (em-effort x1))))
(defun em2rin    (x) (let ((x1 (if (symbolp x) (! x) x))) (pivoted-line         (em-range x1) (em-rin    x1))))
(defun em2din    (x) (let ((x1 (if (symbolp x) (! x) x))) (pivoted-line         (em-range x1) (em-din    x1))))
(defun em2cin    (x) (let ((x1 (if (symbolp x) (! x) x))) (pivoted-line         (em-range x1) (em-cin    x1))))

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

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