(defparameter *MAX-PITCH-VARIATION* 100)
(defparameter *PITCH-RANGE* 10000)
(defparameter *HALF-MAX-PITCH* 50)
(defparameter *AMP-FIXED-RANGE* 40000)

;; probability of a given point in the stringto mutate
(defparameter *MUTATION-PROBABILITY* 0.5)
(defparameter *VALUE-MUTATION-PROBABILITY* 0.12)  ;; 0.1
(defparameter *STRUCTURAL-MUTATION-PROBABILITY* 0.06)  ;; 0.1
(defparameter *FIXED-MUTATION-RANGE* 0.04)

;; probablility of the mutation of towards more complex
;;  this means we bias it slightly towards simplifying 
;;  mutations so that the number of oscilators doesn't
;;  get out of hand.  I may also try equalizing this
;;  value and instead making low computation time one of 
;;  the evolutionary rules
(defparameter *COMPLEXITY-PROBABILITY* 0.5) 

(defparameter *GENE_NIL* '_gnil)
(defparameter *DEBUG* NIL)
(defparameter *DEBUG-SHORT* NIL)


(defparameter gene-mutations '(gene-add gene-drop gene-wrap gene-unwrap))
(defparameter gene-allowed-generators '(sine-new))
(defparameter gene-allowed-wrappers '(amp-new))   ; filter-new
(defparameter wrapper-types '(amp))   ; filter-new



(defun val-mutatep ()
  (< (random 1.0) *VALUE-MUTATION-PROBABILITY*))
(defun struct-mutatep ()
  (< (random 1.0) *STRUCTURAL-MUTATION-PROBABILITY*))

(defun mutate (seq)
  (let ((mf nil)
	(sym (first seq)))
    (if (eql sym 'SINE) (setf mf 'SINE-MUTATE)) 
    (if (eql sym 'GENE) (setf mf 'GENE-MUTATE)) 
    (if (eql sym 'FIXED) (setf mf 'FIXED-MUTATE)) 
    (if (eql sym 'AMP) (setf mf 'AMP-MUTATE)) 
  (if mf (funcall mf seq))
))

;  sine-mutate - core mutation for sine constructs, allowable mutations
;                 are only changing the value
;                
;               could eventually include changing the function for square, etc
(defun sine-mutate (seq)
  (if (not (eq (length seq) 2)) 
      (error "sine should take exactly one argument, you have ~d~%    ~s" (- (length seq) 1) seq))

;  (if *DEBUG* (format t "sine-mutate~%"))
  ;  this should be a fixed element, just mutate it and return
  ; ( no prob check, that happens in the fixed itself)
  (list 'SINE (mutate (second seq)))
)

(defun sine-new (&optional f)
  (if f 
      (list 'sine (fixed-new f))
    (list 'sine (fixed-new (random *PITCH-RANGE*)))
))

(defun fixed-mutate (seq)
  (if (not (eq (length seq) 2)) 
      (error "fixed should take exactly one argument, you have ~d~%    ~s" (- (length seq) 1) seq))

  
  (if (val-mutatep)
      (let* ((curval (second seq))
	    (delta (balanced-random (* curval *FIXED-MUTATION-RANGE*))))
	(if *DEBUG* (format t "fixed-mutate  newval ~d~%" (floor (+ curval delta))))
	(setf curval (floor (+ curval delta)))
	(list 'FIXED curval) 
	)
    
    seq)
)

(defun fixed-new (v)
  (list 'fixed v))


(defun amp-mutate (seqin)
  ; mutate the wrapper portion
  (if *DEBUG* (format t "amp-mutate~%"))
  (let ((seq (copy-list seqin)))
    (setf (third seq) (mutate (third seq)))
    (if (struct-mutatep)
	(setf (second seq) 
	      (if (eql (first (second seq)) 'fixed)
		  (gene-new (sine-new (second (second seq))))
		(gene-mutate-struct (second seq))))
      (if (val-mutatep)
	  (setf (second seq) (mutate (second seq))))
      )
    seq
))

(defun amp-revert (seq)
  (if *DEBUG* (format t "amp-revert~%"))
  (if (not (eql (first (third seq)) 'GENE))
      (error "Invalid format for amp construct ~s~%" seq))
  (third seq))

(defparameter *AMP-FIXED-RANGE* 16000)
(defun amp-new (seq)
  (list 'amp (fixed-new (random *AMP-FIXED-RANGE*)) (gene-new seq)))

(defun gene-mutate (seq)
  (if *DEBUG* (format t "gene-mutate~%"))
  (gene-mutate-values 
   (if (struct-mutatep)
       (gene-mutate-struct seq)
     seq))

)

(defun gene-mutate-struct (seq)
  (if *DEBUG* (format t "gene-mutate-struct~%"))
  (funcall 
   (nth (random (length gene-mutations)) gene-mutations) seq)
)

(defun gene-mutate-values (seqin)
  (if *DEBUG* (format t "gene-mutate-values~%"))
  (loop for el in seqin collecting
    (if (eql el 'GENE) el
      (mutate el))))

(defun gene-new (&optional seq)
  (if seq
      (list 'gene seq)
    (list 'gene (sine-new (random 10000)))
))

(defun gene-add (seq)
  (if *DEBUG* (format t "gene-add~%"))
  (append seq 
	  (list (funcall 
		 (nth 
		  (random (length gene-allowed-generators)) 
		  gene-allowed-generators)))))

(defun gene-drop (seq)
  (if *DEBUG* (format t "gene-drop~%"))
  (if (> (length seq) 1)
      (let* ((len (length seq))
	     (removal-point (+ 1 (random (- len 1)))))
					;    (format t "dropping ~d~%" removal-point)
	(append (butlast seq (- len removal-point)) 
		(last seq (- (- len removal-point) 1)))
	seq)
    seq)
)
  
(defun gene-wrap (seqin)
  (if *DEBUG* (format t "gene-wrap~%"))
  (let* ((seq (copy-list seqin))
	 (len (length seq))
	(wrap-point (+ 1 (random (- len 1)))))
    (setf (nth wrap-point seq)
	  (funcall (nth (random (length gene-allowed-wrappers))
			gene-allowed-wrappers)
		   (nth wrap-point seq)))
    seq
))

(defun gene-unwrap (seqin)
  (if *DEBUG* (format t "gene-unwrap~%"))
  (let* ((seq (copy-list seqin))
	 (idxcount 0)   ; this is pulled into the lambda function as a closure
	                ; so we can trace the index to the list element
	 (candidates (remove-if #'null (mapcan #'(lambda (el) 
						   (incf idxcount)
				 (loop for typ in wrapper-types collecting
				   (progn 
				     (if (eql typ (first el)) idxcount)
				     )))
			     (last seq (- (length seq) 1))
			     )))
	 )
    (if (> (length candidates) 0)
	(let* ((chosenidx (nth (random (length candidates)) candidates))
	       (chosen (nth chosenidx seq))
	       (chosentype (first chosen))
	       (func NIL))
	  (if (eql chosentype 'AMP) (setf func 'amp-revert))

	  (setf (nth chosenidx seq) (funcall func chosen))
	  seq)
      seq)
))