#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 3))
           (parametros_o_2 (sublista cromosoma 3 6))
           
           (parametros_s_1 (sublista cromosoma 6 9))

           (pesos_capa_oculta
            (list
             (take parametros_o_1 2)
             (take parametros_o_2 2)
             )
            )
           (pesos_capa_salida
            (list
             (take parametros_s_1 2)
             )
            )
           (O_1 (last parametros_o_1))
           (O_2 (last parametros_o_2))
           
           (S_1 (last parametros_s_1))
           
           (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)
       )
      (for-each
       (lambda (neuron umbral)
         (send neuron set-umbral umbral)
         )
       neuronas_capa_s
       (list S_1)
       )
      )
    ))


;;;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 (cdr 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_set-bicondicional.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
 )

