;;;; Evett's 1994 algorithm for determining LRs


(defun calculate-t (lam j)
  "Calculates the value of Tj given lamda and j"
  (/ (* (exp (- lam)) (expt lam j)) (fact j)))

(defun plot-t ()
  "Plots the T values for Evett94"
  (let* ((path (make-pathname :name "t-values"))
	 (str (open path :direction :output :if-exists :supersede)))
    (format str "#~10A ~10A ~10A~%" "Lambda" "J" "TsubJ")
    (dotimes (lam 8)
      (dotimes (j 8)
	(format str "~10A ~10A ~10A ~%" lam j (calculate-t lam j))))
    (close str)))

  
(defun plot-naive-evett94 ()
  "Plots the naive Evett94 algorithm using different lambas."
  (let* ((path (make-pathname :name "evett-values"))
	 (str (open path :direction :output :if-exists :supersede)))
    (format str "#~10A ~10A ~10A ~%" "LAMBDA" "N" "RESULT")
    (dotimes (lam 7)
      (dotimes (n 5)
	(format str "~10A ~10A ~10A ~%" lam n (naive-evett94 :lam lam :n n))))
    (close str)))

(defun naive-evett94 
    (&optional &key
     (lam 4)
     (n 4)
     (p-values #(.25 .22 .14 .14 .069 .064 .033 .033 .022 .02 .013))
     (s-values #(.728 .166 .065 .018 .018 .006))
     (f-value .03)
     )
  "Performs the naive algorithm for determining the LR using
data supplied by the LHS survey."
  (+ (/ (* (elt p-values 0) (calculate-t lam 1)) (* (elt p-values 1) (elt s-values n) f-value)) (calculate-t lam 0)))

(defun fact (f)
  (if (< f 2) 1 (* f (fact (- f 1)))))

(defun evett94
    (
     &optional
     &key
     (z 1)
     (n 1)
     (p-values #(.41 .28 .13 .1 .05 .02 .01 .005))
     (s-values #(.70 .18 .08 .025 .015))
     (t-values #(.02 .075 .145 .195 .195 .155 .105 
.06 .03 .01 .005))
     (f-value .03)
     )
  "Performs the algorithm for determining the LR using
data supplied by the LHS given a factor of z, and a
number of fragments on clothing n."
  (/ (+ (* (elt t-values 0) (elt p-values 1) (elt s-values n) 
f-value) (* (elt t-values n) (elt p-values 0))) (* (elt p-values 1) (elt 
s-values n) f-value))
  )