#lang racket


(define sublista
  (lambda (lista i j)
    (if (= i j)
        '()
        (cons
         (list-ref lista i)
         (sublista lista (add1 i) j)
         )
        )
    ))
;;cromosoma
;;representación (P1 P2...P15 O1... P1 P2...P15 O15... P1 P2...P15 S1... P1 P2...P15 S4)
;; donde P1 : Peso de la conexión de neurona 1 a neurona 1
;; y donde O1 : Umbral de la neurona 1

(define set-parametros
  (lambda (red cromosoma)
    (let* ((parametros_o_1 (sublista cromosoma 0 9))
           (parametros_o_2 (sublista cromosoma 9 18))
           (parametros_o_3 (sublista cromosoma 18 27))
           (parametros_o_4 (sublista cromosoma 27 36))
           (parametros_o_5 (sublista cromosoma 36 45))
           (parametros_o_6 (sublista cromosoma 45 54))
           (parametros_o_7 (sublista cromosoma 54 63))
           (parametros_o_8 (sublista cromosoma 63 72))
           
           (parametros_s_1 (sublista cromosoma 72 81))
           (parametros_s_2 (sublista cromosoma 81 90))
           (parametros_s_3 (sublista cromosoma 90 99))
           (parametros_s_4 (sublista cromosoma 99 108))
           (parametros_s_5 (sublista cromosoma 108 117))
           (parametros_s_6 (sublista cromosoma 117 126))
           (parametros_s_7 (sublista cromosoma 126 135))
           (parametros_s_8 (sublista cromosoma 135 144))

           (pesos_capa_oculta
            (list
             (take parametros_o_1 8)
             (take parametros_o_2 8)
             (take parametros_o_3 8)
             (take parametros_o_4 8)
             (take parametros_o_5 8)
             (take parametros_o_6 8)
             (take parametros_o_7 8)
             (take parametros_o_8 8)
             )
            )
           (pesos_capa_salida
            (list
             (take parametros_s_1 8)
             (take parametros_s_2 8)
             (take parametros_s_3 8)
             (take parametros_s_4 8)
             (take parametros_s_5 8)
             (take parametros_s_6 8)
             (take parametros_s_7 8)
             (take parametros_s_8 8)
             )
            )
           (O_1 (last parametros_o_1))
           (O_2 (last parametros_o_2))
           (O_3 (last parametros_o_3))
           (O_4 (last parametros_o_4))
           (O_5 (last parametros_o_5))
           (O_6 (last parametros_o_6))
           (O_7 (last parametros_o_7))
           (O_8 (last parametros_o_8))
           
           (S_1 (last parametros_s_1))
           (S_2 (last parametros_s_2))
           (S_3 (last parametros_s_3))
           (S_4 (last parametros_s_4))
           (S_5 (last parametros_s_5))
           (S_6 (last parametros_s_6))
           (S_7 (last parametros_s_7))
           (S_8 (last parametros_s_8))
           
           (capas (send red get-capas))
           (capa_e (first capas))
           (capa_o (second capas))
           (capa_s (third capas))
           (neuronas_capa_o (send capa_o get-neuronas))
           (neuronas_capa_s (send capa_s get-neuronas))
           )
      (send capa_o set-pesos pesos_capa_oculta)
      (send capa_s set-pesos pesos_capa_salida)
      
      (for-each
       (lambda (neuron umbral)
         (send neuron set-umbral umbral)
         )
       neuronas_capa_o
       (list O_1 O_2 O_3 O_4 O_5 O_6 O_7 O_8)
       )
      (for-each
       (lambda (neuron umbral)
         (send neuron set-umbral umbral)
         )
       neuronas_capa_s
       (list S_1 S_2 S_3 S_4 S_5 S_6 S_7 S_8)
       )
      )
    ))


;;;LA REGLA DELTA
(define error-neurona
  (lambda (R_deseada R_dada)
    (- R_deseada R_dada)
    ))
(define error-todas-neuronas
  (lambda (lst-deseada lst-dada)
    (if (null? lst-deseada)
        0
        (+
         (expt (error-neurona (car lst-deseada) (car lst-dada)) 2)
         (error-todas-neuronas (cdr lst-deseada) (cdr lst-dada)))
        )
    ))
(define suma-errores
  (lambda (red conj-e)
    (if (null? conj-e)
        0
        (let* ((row (car conj-e))
               (input (car row))
               (r_deseada (cadr row));(cadr row));
               (r_dada (send red proceso! input));(car (send red proceso! input)));
               )
          (+ 
           (error-todas-neuronas r_deseada r_dada)
           (suma-errores red (cdr conj-e))) 
          )
        )
    ))

(define error-medio
  (lambda (red training-set)
    (* (/ 1 (length training-set))
       (suma-errores red training-set))
    ))
;;;;;;;;;;;;;;;;;;
(require "Training-olfato.rkt")
;;;;;;;;;;;;;;;;;;
;Dada una red y un training_set
;se calcula el error-medio. Se imputa como fitness

(define fitness error-medio)


(define aplicar-fitness
  (lambda (red poblacion)
    (if (null? poblacion)
        '()
        (begin
          (set-parametros red (car poblacion))
          (cons
           (list 
            (fitness red training)
            (car poblacion)
                 )
           (aplicar-fitness red (cdr poblacion))
           )
          )
        )
    ))

(define orden-pob-fitness
  (lambda (poblacion)
    (sort poblacion #:key car <) ))

(define hay-un-optimo?
  (lambda (poblacion);cada individuo : (fitness cromosoma)
    (cond
      ((null? poblacion) #f)
      ((= (caar poblacion) 0) #t)
      (else
       (hay-un-optimo? (cdr poblacion)) )
      ) ))

(define extrae-optimos
  (lambda (poblacion);cada individuo : (fitness cromosoma)
    (cond
      ((null? poblacion) '())
      ((= (first (car poblacion)) 0)
       (cons
        (second (car poblacion))
        (extrae-optimos (cdr poblacion))) )
      (else
       (extrae-optimos (cdr poblacion)))
      ) ))

(define criterio-parada hay-un-optimo?)

(provide
 set-parametros
 aplicar-fitness
 orden-pob-fitness
 criterio-parada
 hay-un-optimo?
 extrae-optimos
 )

