;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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/>. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; treatments stuff ;;; a treatment is a list in the form (feature range) ;;; the treatments (flex 3) (flex 4) (flex 5) are "separated" or "singletons" ;;; the treatment (flex 3 4 5) is "coalesced" (defun coalesce-treatments (treatments) "Coalesces treatments so that each feature only appears once." (let (out) (dolist (treatment treatments out) (let* ((feature (car treatment)) (range (cdr treatment)) (current (assoc feature out))) (if current (setf (cdr (assoc feature out)) (append (cdr current) range)) (push (cons feature range) out)))))) (defun separate-treatments (treatments) "Separates treatments into singletons." (let (out) (dolist (treatment treatments out) (let ((feature (car treatment)) (range (cdr treatment))) (dolist (value range) (push (list feature value) out)))))) (egs :treatments (eg '(coalesce-treatments '((flex 1) (flex 2) (pmat 1) (pmat 2))) :of "coalescing treatments" :out '((pmat 1 2) (flex 1 2))) (eg '(separate-treatments '((flex 1 2) (pmat 1 2))) :of "separating treatments" :out '((pmat 2) (pmat 1) (flex 2) (flex 1)))) (defun apply-treatments (treatments) "Restricts COCOMO ranges in the *db* to the specified treatments." (dolist (treatment (coalesce-treatments treatments)) (let* ((feature (car treatment)) (range (cdr treatment)) (old (range? feature)) (new (coco-restrict old range))) (range! feature new)))) (defun force-treatments (treatments) "Forces COCOMO ranges in the *db* to the specified treatments." (dolist (treatment (coalesce-treatments treatments)) (let ((feature (car treatment)) (range (cdr treatment))) (range! feature range)))) (defun singleton-p (treatment) "Returns whether the treatment is a singleton." (= 2 (length treatment))) (defun singletons-p (treatments) "Returns whether all the given treatments are singletons." (every #'singleton-p (coalesce-treatments treatments))) (defun singletons? (treatments) "Returns a list of singletons from the given treatments." (remove-if-not #'singleton-p (coalesce-treatments treatments))) (defun non-singletons? (treatments) "Returns a list of non-singletons from the given treatments." (let ((singletons (singletons? treatments))) (remove-if #'(lambda (treatment) (find treatment singletons :test #'equal)) treatments))) ;;; case study and policy stuff ;;; a case study is a list of treatments like ((flex 3 4 5) (pmat 1 2) ...) ;;; and possibly a kloc constraint such as (kloc 100 200) ;;; case studies limit the search space to the ranges they specify (defun default-case-study () "Returns the default case study (constructed from COCOMO defaults)." (let (out) (dolist (default (cocomo-defaults) out) (let ((feature (car default)) (value (cdr default))) (cond ((eq feature 'kloc) (push (list 'kloc (num-min value) (num-max value)) out)) ((or (eq (type-of value) 'sf) (eq (type-of value) 'em) (eq (type-of value) 'dr)) (push (append (list feature) (bag-range (bag-range value))) out))))))) (defun complete-case-study (case-study) "Completes a case study by supplying COCOMO default ranges for any features that are not present." (let ((old (coalesce-treatments (default-case-study))) (new (coalesce-treatments case-study)) out) (dolist (old-treatment old out) (let* ((feature (car old-treatment)) (new-treatment (find feature new :key #'car))) (push (or new-treatment old-treatment) out))))) (defun feature-policies (feature) "Returns the list of policies that the given COCOMO feature belongs to." (let ((value (geta feature (cocomo-defaults)))) (case (type-of value) (sf (sf-policies value)) (em (em-policies value)) (dr (dr-policies value))))) ;;; completion stuff (defvar *monte-carlo-iterations* 100) (defun monte-carlo (&key (fn #'energy) (n *monte-carlo-iterations*)) "Runs n random completions and returns the median, spread, and quartiles." (let (results) (dotimes (i n (multiple-value-list (median results))) (zaps) (push (funcall fn) results)))) ;;; state and path stuff ;;; a state is a snapshot of a search at a particular instant ;;; containing the treatments being searched and any scores assigned by the search engine ;;; a path is a chronological list of states representing one complete run of a search engine (defstruct state tick ; time that the state was created ignore ; treatments to be ignored because their policy is not being searched open ; treatments that have not been discarded by the search closed ; treatments that have been discarded by the search ;; minimum and maximum kloc kloc-min kloc-max ;; median, spread, and quartiles effort months defects threat energy ;; dummy slot to be used as needed by a search engine score ) (defun make-state0 (kloc-min kloc-max ignore open closed) "Creates a state using the provided data." (make-state :tick (get-internal-run-time) :ignore ignore :open open :closed closed :kloc-min kloc-min :kloc-max kloc-max)) ;;; solution complexity is measured by "constraints" ;;; constraints are made by reducing the number of available ranges for a feature ;;; so (flex 1 2 3 4 5) represents 0 constraints and (flex 5) represents 4 ;;; note that having all of a feature's treatments on the open list is the same ;;; as having them all on the closed list...both situations represent 0 constraints (defun constraints? (state) "Returns a list of treatments for features that are constrained in the given state." (let (constraints) (dolist (treatment (state-open state) (nreverse constraints)) (let ((feature (car treatment))) (if (find feature (state-closed state) :key #'car) (push treatment constraints)))))) (defun constraint-count (state &key (which :ranges)) "Counts the features or ranges that are constrained in the given state." (let ((fcount 0) (rcount 0)) (dolist (treatment (coalesce-treatments (state-open state)) (cond ((eq which :features) fcount) ((eq which :ranges) rcount) (t (error "unsupported value ~a for which" which)))) (let* ((feature (car treatment)) (open-range (cdr treatment)) (closed-range (cdr (find feature (coalesce-treatments (state-closed state)) :key #'car)))) (when (and open-range closed-range) (incf fcount) (incf rcount (length closed-range))))))) (defun max-constraints (state &key (which :ranges)) "Returns the maximum number of constraints for the given state." (cond ((eq which :features) (length (coalesce-treatments (non-singletons? (append (state-open state) (state-closed state)))))) ((eq which :ranges) (- (+ (length (state-open state)) (length (state-closed state))) (length (coalesce-treatments (append (state-open state) (state-closed state)))))) (t (error "unsupported value ~a for which" which)))) (defun constrained% (state &key (which :ranges)) "Returns the number of constraints as a percentage of the maximum." (/ (constraint-count state :which which) (max-constraints state :which which))) (labels ((calculate (state fn) (init-db) (kloc! (state-kloc-min state) (state-kloc-max state)) (apply-treatments (append (state-ignore state) (state-open state) (state-closed state))) (apply-treatments (state-open state)) (monte-carlo :fn fn))) (defun effort? (state) "Calculates and caches effort or returns the cached value." (unless (state-effort state) (setf (state-effort state) (calculate state #'effort))) (car (state-effort state))) (defun months? (state) "Calculates and caches months or returns the cached value." (unless (state-months state) (setf (state-months state) (calculate state #'months))) (car (state-months state))) (defun defects? (state) "Calculates and caches defects or returns the cached value." (unless (state-defects state) (setf (state-defects state) (calculate state #'defects))) (car (state-defects state))) (defun threat? (state) "Calculates and caches threat or returns the cached value." (unless (state-threat state) (setf (state-threat state) (calculate state #'threat))) (car (state-threat state))) (defun energy? (state) "Calculates and caches energy or returns the cached value." (unless (state-energy state) (setf (state-energy state) (calculate state #'energy))) (car (state-energy state)))) (defstruct path start ; search start time end ; search end time states ; search states ) (defmacro states? (path) `(path-states ,path)) (defmacro first-state? (path) `(car (path-states ,path))) (defmacro last-state? (path) `(car (last (path-states ,path)))) (labels ((extreme-energy0 (states fn) (let ((e (apply fn (mapcar #'energy? states)))) (find e states :key #'energy?))) (extreme-energy (paths fn) (extreme-energy0 (apply #'append (mapcar #'(lambda (path) (states? path)) (as-list paths))) fn))) (defun max-energy? (p) "Returns the state with the maximum energy from a path or list of paths." (extreme-energy p #'max)) (defun min-energy? (p) "Returns the state with the minimum energy from a path or list of paths." (extreme-energy p #'min))) (defun min-energy-ttest? (p) "Returns the state with the minimum energy, back-selected for statistical sameness." (let* ((min-e-state (min-energy? p)) (min-e (state-energy min-e-state))) (dolist (path (as-list p)) (when (= (energy? (min-energy? path)) (energy? min-e-state)) (dolist (state (path-states path)) (let ((state-e (state-energy state))) (when (= 0 (ttest (fifth min-e) (sixth min-e) (seventh min-e) (fifth state-e) (sixth state-e) (seventh state-e))) (return-from min-energy-ttest? state)))) (error "statistically same minimum energy not found"))))) ;;; search stuff (defvar *debug-search* nil) ; whether to print debugging information while searching ;;; the following three macros are not generally usable outside of a (defsearch ...) form ;;; but we define them globally so we get nice formatting inside our search engine code (defmacro save-state () "Creates a new state using the search lists and adds it to the current path." `(push (make-state0 kloc-min kloc-max ignore open closed) (states? path))) (defmacro with-new-path (&body body) "Creates a temporary search context." `(let ((path (copy-path path)) (ignore ignore) (open open) (closed closed)) ,@body)) (defmacro switch-path (new-path) "Updates the search lists and path variable to match the provided path." `(progn (setf path ,new-path) (setf ignore (state-ignore (first-state? path))) (setf open (state-open (first-state? path))) (setf closed (state-closed (first-state? path))))) (defmacro defsearch (name parameters &body body) "Defines a search engine." (let ((kloc (gensym)) (runs (gensym)) (iterator (gensym))) `(defun ,name (&key (num-runs 20) (case-study (default-case-study)) policies file ,@parameters) ;; clear the output file (if file (with-open-file (str file :direction :output :if-exists :supersede))) (let (,kloc kloc-min kloc-max ignore open closed path paths ,runs) ;; determine kloc range from the provided (or default) case study (setf ,kloc (find 'kloc (complete-case-study case-study) :key #'car) kloc-min (second ,kloc) kloc-max (third ,kloc)) ;; iterate num-runs times (dotimes (,iterator num-runs (nreverse ,runs)) ;; initialize the search lists (setf open (separate-treatments (remove 'kloc (complete-case-study case-study) :key #'car))) (when policies (dolist (treatment open) (if (not (intersection policies (feature-policies (car treatment)))) (move-elt treatment open ignore)))) (setf closed nil path (make-path :start (get-internal-run-time)) paths nil) ;; cache the minimum and maximum effort/months/defects/threat for this search (when (zerop ,iterator) (init-db) (kloc! kloc-min kloc-max) (apply-treatments (append ignore open)) (cache-min-max)) ;; run the provided search code (format t "Run #~a~%" (1+ ,iterator)) ,@body ;; save and output the run (setf (path-end path) (get-internal-run-time) (states? path) (nreverse (states? path))) (push path ,runs) (if file (with-open-file (str file :direction :output :if-exists :append) (format str "~a~%" path)))))))) ;;; reporting stuff (defun print-state (state) "Prints a state's energy and constraints." (format t "~,6f " (energy? state)) (let ((constraints (constraints? state))) (dotimes (i (length constraints)) (if (and (> i 0) (zerop (mod i 9))) (format t "~%~9t")) (format t "~8a " (elt constraints i)))) (terpri)) (defun print-path (path) "Prints all of a path's states according to print-state." (dolist (state (states? path)) (print-state state)) (terpri)) (defun print-paths (paths &key (which :best)) "Prints a specific state from each path in a list of paths." (macrolet ((s () `(case which (:first (first-state? path)) (:last (last-state? path)) (:best (min-energy? path)) (t (error "unsupported value ~a for which" which))))) (cond ((zerop (length paths))) ((> (length paths) 5) (dotimes (i (ceiling (length paths) 5)) (print-paths (subseq paths (* i 5) (min (* (1+ i) 5) (length paths))) :which which))) (t (dotimes (i (apply #'max (mapcar #'(lambda (path) (length (coalesce-treatments (constraints? (s))))) paths))) (dolist (path paths) (format t "~18a " (if (> (length (coalesce-treatments (constraints? (s)))) i) (elt (coalesce-treatments (constraints? (s))) i) ""))) (terpri)) (dolist (path paths) (format t "~,6f~11a" (energy? (s)) "")) (terpri) (terpri)))))