anchor.diff:  ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: PHENEX; Base: 10 -*-
   
   (in-package #:phenex)
  +
  +(defconstant jiggle-rate 1.5)
  +
  +(defun count-classes (cases)
  +  (let ((ht (make-hash-table :test #'equal)))
  +    (mapc 
  +     #'(lambda (x) (setf (gethash (car x) ht) t))
  +     cases)
  +    (hash-table-count ht)))
   
   (defun normalize (w-arr)
     "Destructively normalizes an array."
  
positive.code: 		  class k)
  	 finally (return class)))))
  
  (defun update-weights (h cases weights)
    "Internal function used for adaboost-training. Updates the weights
  properly. Immutable."
    (let* ((err (loop for (yi . xi) in cases
  		 for w across weights
  		 if (not (= yi (funcall h xi)))
  		   summing w))
  	 (edited-weights 
  	  (map 'vector 
  	       #'(lambda (yx wi)
  		   (destructuring-bind (yi . xi)
  		       yx
  		     (if (= (funcall h xi) yi)
  			 (* wi (/ err 
  				  (max (- 1 err) EPSILON)))
  			 wi)))
  	       cases weights)))
      (values (normalize edited-weights)
  	    err)))
  
  (defun adaboost-training (hyp-type cases)
    "Defines the ADABOOST-TRAINING algorithm. Takes in a list of hypotheses and a
  
negative.code: pair (h-fn . w), where w is how much weight a the hypothesis should be given."
    (let* ((N (length cases))
  	 (K (sum hyp-type :key #'cdr))
  	 (L (count-classes cases))
  	 (w (make-array N :initial-element (/ 1.0 N)))
  	 (h (make-array K :initial-element nil))
  	 (z (make-array K :initial-element 0)))
      (loop with k = 0
         for (hyp-fn . l-n) in hyp-type 
         do (dotimes (_ l-n)
  	    (princ ".")
  	    (let ((h-fn (funcall hyp-fn cases w)))
  	      (multiple-value-bind (w+ h-err)
  		    (update-weights h-fn cases w L)
  		    (setf w w+
  			  (svref h k) h-fn
  			  (svref z k) h-err)
  		    (incf k)))))
      (list h z))) ;; cons h z
  