;(load "d:\\ecal\\random.scm")


;;; Generic Programming
;;;     Select(fit prop), XO(replace 2 subtrees), Mutate(growing a tree from random location)


(define terminals '(x))

;;; GP functions 
(define functions '((+ 2) (- 2) (* 2) (new-dev 2) (IFLTE 4)))
(define (getOperator func) 
  (car func))
(define (getNumArgs func)
  (cadr func))

(define IFLTE
  (lambda(a b c d)
    (if (<= a b) c d)))

(define new-dev 
  (lambda(a b)
    (if (= b 0) 1 (/ a b))))

;;; Genome Creation 
(define createFullTree
  (lambda(functions terminals depth)
    
    (define (createArgs numArgs)
      (if (= 1 numArgs)
          (list (createFullTree functions terminals (- depth 1)))
          (cons (createFullTree functions terminals (- depth 1)) (createArgs (- numArgs 1))))) 
    
    (if (= depth 1) 
        (chooseRandom terminals)
        (let ((func (chooseRandom functions)))
          (cons (getOperator func) (createArgs (getNumArgs func)))))))

;choose a random element from collection
(define chooseRandom
  (lambda (collection)
    (let ((num (random (length collection))))
      (list-ref collection num))))


(define createGrowTreeFunc
  (lambda(functions terminals depth)
    (define (createArgs numArgs)
      (if (= 1 numArgs)
          (list (createGrowTreeFunc functions terminals (- depth 1)))
          (cons (createGrowTreeFunc functions terminals (- depth 1)) (createArgs (- numArgs 1))))) 
    
    (let* ((lenFunc (length functions))
           (lenTerm (length terminals))
           (rnd-num (random (+ lenFunc lenTerm))))
      
      (if (= depth 1) 
          (chooseRandom terminals)
          (if (>= rnd-num lenFunc) 
              (list-ref terminals (- rnd-num lenFunc)) 
              (let ((func (list-ref functions rnd-num)))
                (cons (getOperator func) (createArgs (getNumArgs func)))))))))

(define createGrowTree    
  (lambda(functions terminals depth)
    (let ((res (createGrowTreeFunc functions terminals depth)))
      (if (list? res) res (list res)))))


;;; TODO:  There are no similar trees in population

(define originalExp '(+ x 1))

(define startPoint -10)
(define endPoint 10)

(define getFitness
  (lambda (expression sampleInterval startPoint)
    (if (> startPoint endPoint)
        0
        (+ (diff expression startPoint)
           (getFitness expression sampleInterval (+ startPoint sampleInterval))))))

(define getFitness1
  (lambda(expression)
    (new-dev 1 (getFitness expression 2 -10))))

;returns the deference between correct express and expression for x=point
(define diff
  (lambda (expression point)
    (let ((newExpression `(let ((x ,point))
                            ,expression))
          (newOriginal `(let ((x ,point))
                          ,originalExp))) 
      ;(newLine)(newLine)
      ;(display newExpression)
      (abs (- (eval newOriginal) (eval newExpression))))))


(define createFirstPop 
  (lambda(functions terminals maxDepth popSize)
    (letrec ((loop (lambda (cur-pop size-left)
                     (if (<= size-left 0) cur-pop
                         (loop (cons (createFullTree functions terminals maxDepth) cur-pop)
                               (sub1 size-left))))))
      (loop '() popSize))))

(define createFirstPopRandom 
  (lambda(functions terminals maxDepth popSize)
    (letrec ((loop (lambda (cur-pop size-left)
                     (if (<= size-left 0) cur-pop
                         (let ((isGrow (random 2)))
                           (if (= isGrow 0)
                               (loop (cons (createFullTree functions terminals maxDepth) cur-pop)
                                     (sub1 size-left))
                               (loop (cons (createGrowTreeFunc functions terminals maxDepth) cur-pop)
                                     (sub1 size-left))
                               ))))))
      (loop '() popSize))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

(define numNodes
  (lambda (gen)
    (if (list? gen)
        (accumulate (lambda(gen val) (+ val (numNodes gen))) 0 gen)
        1)))

; replace node nodeNum with newnode - returns the outcome
(define replace
  (lambda (gen nodeNum newNode)
    (letrec ((num nodeNum)
             (rep (lambda(genome) 
                    (if (< nodeNum 0)
                        genome
                        (begin
                          (set! nodeNum (- nodeNum 1))
                          (if (= nodeNum -1)
                              newNode
                              (if (list? genome)
                                  (cons (car genome) (map (lambda (gen) (rep gen)) (cdr genome)))
                                  genome)))))))
      (rep gen))))


; returns a mutated gen
(define mutate
  (lambda (gen)
    (replace gen (random (numNodes gen)) (createFullTree functions terminals 3)))) 

; sets the given to be crossed over 
(define crossOver
  (lambda (gen1 gen2)
    (letrec ((accum (lambda (op initial sequence)
                      (if (null? sequence)
                          initial
                          (accum op (op (car sequence) initial) (cdr sequence))))) 
             
             (l1 (numNodes gen1))
             (l2 (numNodes gen2))
             (n1 (random l1))
             (n2 (random l2))
             (num2 n2)
             (num1 n1)
             (getNode1 (lambda (genome val)
                         (if (< n1 0) val
                             (begin
                               (set! n1 (- n1 1))
                               (if (= n1 -1) genome
                                   (loop getNode1 genome))))))
             (getNode2 (lambda (genome val)
                         (if (< n2 0) val
                             (begin
                               (set! n2 (- n2 1))
                               (if (= n2 -1) genome
                                   (loop getNode2 genome))))))
             (loop (lambda (op genome)
                     (if (list? genome)
                         (accum op 'STAM (cdr genome))
                         'STAM))))
      
      (list 
       (replace gen1 num1 (getNode2 gen2 'STAM)) 
       (replace gen2 num2 (getNode1 gen1 'STAM))))))


(define g '(a (b c) (d e f)))
;(crossOver g g)
;(crossOver '(a (b c) (d e f)) '(x y z))
(define fRandom
  (lambda()
    (let  ((res (/ (random 100000) 100000)))
      ;(display res) (newline)
      res)))


(define selectByRandom
  (lambda(lstValues itemList)
    (letrec (  ; picking a random float number between 0 and 1
             
             ; sum of all 1/fitness
             (sum (accumulate (lambda(genFit sumSoFar) 
                                (+ genFit sumSoFar)) 0 lstValues))
             
             (rndSelection (* (fRandom) sum))
             
             ; selecting the genome for next generation
             (select (lambda(fitnessList sumSoFar genomeList res)
;                       (display " sum = ")
;                       (display sumSoFar) (newline)
                       (if (null? genomeList) res
                           (if (< rndSelection sumSoFar) res
                               (select (cdr fitnessList) 
                                       (+ sumSoFar (car fitnessList))
                                       (cdr genomeList)
                                       (car genomeList)))))))   
      
      ;(display rndSelection) (newline)
      (select lstValues 
              0 
              itemList
              (car itemList)  ))))


(define fitnessPropSelection
  (lambda(pop)
    (letrec (
             ; list of fitnesses: 1/fitness
             (lstOfFitness (map (lambda(gen) (getFitness1 gen)) pop)))
      
      (selectByRandom lstOfFitness pop))))


(define select
  (lambda(pop)
    (fitnessPropSelection pop)))

(define selectWrapper
  (lambda(select)
   (list 1(lambda(pop)
       (list (select pop))))))
;; TODO: Create 2 wrappers to the mutate & crossOver functions (recieve only 'pop')
;;       Finish the run method

;; cross over is a function that recieves 2 genomes, we need to generalize this method to get 
;; population and activate a cross over. This function recieves a cross over of 2 genome
;; arguments and the return value is a cross over ( lambda(pop) ) which gets 1 argument, population.
(define xoWrapper
  (lambda(crossOver)
         (list 2(lambda(pop)
           ;(letrec ((genomeA (select pop))
                    ;(loop (lambda(gen)
                     ;       (if (eq? gen genomeA)
                      ;          (loop (select pop))
                       ;         gen)))
                  ;  (genomeB (loop (select pop))))
             
             ; (crossOver genomeA genomeB))))))
                  (crossOver (select pop) (select pop))))))

;; Generalization like xoWrapper only mutate is a function which receives only 1 argument.
(define mutateWrapper
  (lambda (mutate)
    (list 1 (lambda(pop)
              (list (mutate (select pop)))))))

(define newBestGenome
  (lambda(bestGenome genomes)
    (letrec ((findBest (lambda(genomesLeft best)
                         (if (null? genomesLeft) best
                             (if (> (getFitness1 (car genomesLeft)) (getFitness1 best))
                                 (findBest (cdr genomesLeft) (car genomesLeft))
                                 (findBest (cdr genomesLeft) best))))))
      (findBest genomes bestGenome))))
                             

(define run
  (lambda(mutateProb xoProb selectProb maxDepth popSize numGenerations)
    (letrec ((firstPop (createFirstPop functions terminals maxDepth popSize))
             (lstProb (list mutateProb xoProb selectProb))
             (lstOper (list (mutateWrapper mutate) (xoWrapper crossOver) (selectWrapper select)))
             (bestGenome (car firstPop))
             (runGenerations (lambda (curPop numGeneration nextPop genomesLeft)
                               ;(display genomesLeft) 
                               (if (zero? genomesLeft)
                                   (begin
                                     (display numGeneration) (newline) (display bestGenome) (display " ") 
                                     (display (getFitness1 bestGenome)) (newline)
                                     (set! bestGenome (newBestGenome bestGenome nextPop))
                                     (runGenerations nextPop (add1 numGeneration) '() popSize))
                                   
                                   (if (= numGeneration numGenerations) bestGenome ;(display "The end")
                                       (let* ((opToUse (selectByRandom lstProb lstOper))
                                              (genomeAfterOp ((cadr opToUse) curPop)))
                                         
                                         ;; TODO: when there is one genome left for next generation, need to pick the 
                                         ;; best fitness genome from the 2 crossed over.
                                         (if (and (eq? (car opToUse) 2) ; if method is cross Over
                                                  (>= genomesLeft 2))
                                             
                                             (runGenerations curPop numGeneration 
                                                             (cons (car genomeAfterOp) 
                                                                   (cons (cadr genomeAfterOp) nextPop))
                                                             (- genomesLeft 2))
                                            
                                             (runGenerations curPop numGeneration 
                                                             (cons (car genomeAfterOp) nextPop)
                                                             (sub1 genomesLeft)))))))))
      (runGenerations firstPop 0 '() popSize))))


;(run 0.1 0.8 0.1 3 5 4)

;(define p (createFirstPop functions terminals 2 3))
;p

;(map (lambda(gen) (getFitness1 gen)) p)
;
;(define loop (lambda(n) 
;               (display (fitnessPropSelection p)) (newline)
;               (if (< n 20) (loop (+ n 1)))))
;
(define l `( ,(/ 1 30) ,(/ 1 20) ,(/ 1 10)))
(define i '(A B C))
;
;(define sumPop
;  (lambda(pop)
;    (accumulate (lambda(genome sumSoFar) 
;                  (+ (getFitness1 genome) sumSoFar)) 0 pop)))  

; > (createFirstPop functions terminals 2 1)
;((+ x x))
;> (createFirstPop functions terminals 2 2)
;((+ x x) (new-dev x x))
;> (createFirstPop functions terminals 3 3)
;((new-dev (- x x) (new-dev x x)) (IFLTE (IFLTE x x x x) (new-dev x x) (new-dev x x) (* x x)) (new-dev (- x x) (- x x)))
;>   
;(replace  '(a (b c) (d e f))  4 4)                             



; > (createFirstPop functions terminals 2 1)
;((+ x x))
;> (createFirstPop functions terminals 2 2)
;((+ x x) (new-dev x x))
;> (createFirstPop functions terminals 3 3)
;((new-dev (- x x) (new-dev x x)) (IFLTE (IFLTE x x x x) (new-dev x x) (new-dev x x) (* x x)) (new-dev (- x x) (- x x)))
;> 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; We ran a test: (run 0.1 0.8 0.1 6 20 20) and we got this results:
;;; 
;;;;;;;;;; best of generation 1 ;;;;;;;;;;;;;;;;;;
;(define x -9) ; fitness = 45045/1116134
;(new-dev (IFLTE (IFLTE (IFLTE (new-dev x x) (+ x x) (new-dev x x) (new-dev x x)) 
;                       (new-dev (new-dev x x) (- x x)) 
;                       (IFLTE (IFLTE x x x x) (+ x x) (- x x) (* x x)) 
;                       (IFLTE (+ x x) (* x x) (IFLTE x x x x) (* x x))) 
;                (+ (* (- x x) (IFLTE x x x x)) (new-dev (+ x x) (+ x x))) 
;                (- (- (IFLTE x x x x) (* x x)) (- (+ x x) (IFLTE x x x x))) 
;                (- (* (+ x x) (new-dev x x)) (- (* x x) (+ x x))))
;         (- (* (IFLTE (- x x) (+ x x) (+ x x) (* x x)) (new-dev (IFLTE x x x x) (- x x)))
; (new-dev (+ (+ x x) (IFLTE x x x x)) (new-dev x x))))    
;
;;;;;;;;;; best of generation 5 ;;;;;;;;;;;;;;;;;;
;;; x ; fitness = 1/11
;;;;;;;;;; best of generation 16 ;;;;;;;;;;;;;;;;;;
;;; fitness = 1/10
(define x 180)
(IFLTE x (* x (+ x x)) (+ x (new-dev (+ x x) (* x x))) 
       (* (+ x (new-dev (+ x x) (+ x x))) x))