#lang racket

;;;;;;;Procedimiento general usado en varios sitios
(define sumatorio
  (lambda (lista-señales lista-pesos);igual length
    (if (null? lista-señales)
        0
        (+
         (* (first lista-señales)
            (first lista-pesos))
         (sumatorio 
          (cdr lista-señales) (cdr lista-pesos)))
        )
    ))
;;;;;;;
(define neuron_R%
  (class object%
    (init-field
     (rho 1)
     )
    (field
     (estimulo '())
     (salida_categoria '())
     )
    ;;LA RELACIÓN DE SEMEJANZA
    (define relacion-semejanza
      (lambda ()
        (let ((denominador (apply + estimulo))
              )
          ;;Cuando el estímulo suma 0
          (if (zero? denominador)
              (if (equal? estimulo salida_categoria)
                  1
                  0)
              (/ (sumatorio estimulo salida_categoria) denominador)
              )
          )
        ))
    ;;PROCESO
    (define/public proceso!
      (lambda (input esquema-V);neuron_cat)
        (set! estimulo input)
        (set! salida_categoria esquema-V);(send neuron_cat get-V))
        (let ((RS (relacion-semejanza)) )
          (if (>= RS rho)
              (values RS #t)
              (values RS #f)
              )
          )
        ))
    (super-new)
    ))
;;;;;;;
(define R
  (make-object neuron_R% 1))
;;;;;;;
(define neuron_e%
  (class object%
    (init-field
     id
     )
    (field
     (input #f)
     (activacion 0)
     (salida 0)
     (umbral 1.5)
     )
    ;;
    (define/public get-id
      (lambda ()
        id))
    (define/public get-input
      (lambda ()
        input))
    (define/public get-activacion
      (lambda ()
        activacion ))
    (define/public get-salida
      (lambda ()
        salida))
    ;;RESET
    (define/public reset-neuron!
      (lambda ()
        (set! input #f)
        (set! activacion 0)
        (set! salida 0)
        ))
    ;;
    (define/public proc_estimulo!
      (lambda (señal)
        (set! input señal)
        (set! activacion input);lineal
        ))
    (define/public proc_categoria!
      (lambda (señal)
        (set! salida;escalón
              (if
               (< (+ activacion señal) umbral)
               0
               1))
        ))
    ;;
    (super-new)
    ))
;;;;;;
(define capa_e%
  (class object%
    (init-field
     (lista-neuronas '())
     (input '())
     )
    ;;
    (define/public get-neuronas
      (lambda ()
        lista-neuronas ))
    (define/public get-input
      (lambda ()
        input ))
    ;;
    (define/public get-activacion
      (lambda ()
        (map
         (lambda (n)
           (send n get-activacion)
           )
         lista-neuronas)
        ))
    (define/public get-salida
      (lambda ()
        (map
         (lambda (n)
           (send n get-salida)
           )
         lista-neuronas)
        ))
    (define/public propagar!
      (lambda (estimulo)
        (for-each
         (lambda (n e)
           (send n proc_estimulo! e)
           )
         lista-neuronas estimulo)
        (get-activacion)
        ))
    (define/public recibir!
      (lambda (señales)
        (for-each
         (lambda (n s)
           (send n proc_categoria! s)
           )
         lista-neuronas señales)
        (get-salida)
        ))
    (super-new)
    ))
;;;;;
(define e_0
  (make-object neuron_e% 0))
(define e_1
  (make-object neuron_e% 1))
(define e_2
  (make-object neuron_e% 2))
(define e_3
  (make-object neuron_e% 3))
(define e_4
  (make-object neuron_e% 4))
(define e_5
  (make-object neuron_e% 5))
(define e_6
  (make-object neuron_e% 6))

(define capa_e 
  (make-object capa_e%
    (list e_0 e_1 e_2 e_3 e_4 e_5 e_6)))
;;;;;
(define neuron_c%
  (class object%
    (init-field
     id
     (pesos_w '());los W
     (pesos_v '());los V
     (pesos_l '());laterales y auto. Ejemplo:n_5 (-0.6 1). (señal_de_1 señal_de_2 this señal_de_4 señal_de_5...)
     (input '())
     )
    (field
     (propagacion 0)
     (competicion 0)
     (salida 0)
     (inhibicion #f)
     )
    ;;obtención de valores
    (define/public get-id
      (lambda ()
        id))
    (define/public get-W
      (lambda ()
        pesos_w))
    (define/public get-V
      (lambda ()
        pesos_v))
    (define/public get-L
      (lambda ()
        pesos_l))
    (define/public get-input
      (lambda ()
        input))
    (define/public get-propagacion
      (lambda ()
        propagacion ))
    (define/public get-competicion
      (lambda ()
        competicion ))
    (define/public get-salida
      (lambda ()
        salida ))
    (define/public get-inhibicion
      (lambda ()
        inhibicion ))
    ;;Inhibición
    (define/public set-inhibicion
      (lambda ()
        (set! inhibicion #t)
        ))
    ;;reajuste pesos laterales según total de neuronas
    (define/public ajustar-pesos_L
      (lambda (total)
        (set!
         pesos_l
         (let go ((p_L (- (+ (/ 1 total) 0.01)))
                  (i 0)
                  (j total)
                  (lst '())
                  )
           (if (= i j)
               (reverse lst)
               (if (= i id)
                   (go p_L (add1 i) j (cons 1 lst))
                   (go p_L (add1 i) j (cons p_L lst))
                   )
               )
           )
         )
        ))
    ;;reajuste pesos, cuando es ganadora
    (define reajusta_aux
      (lambda (pesos input)
        (map
         (lambda (p i)
           (* p i) )
         pesos input)
        ))
    (define/public reajusta-pesos!
      (lambda ()
        (set! pesos_w
              (reajusta_aux pesos_w input))
        (set! pesos_v
              (reajusta_aux pesos_v input))
        ))
    ;;Al iniciar un nuevo proceso hay que resetear
    (define/public reset-neuron!
      (lambda ()
        (set! input '())
        (set! propagacion 0)
        (set! competicion 0)
        (set! salida 0)
        (set! inhibicion #f)
        ))
    ;;función de propagación
    (define/public propagacion!
      (lambda (señales)
        (set! input señales)
        (set! propagacion
              (sumatorio señales pesos_w))
        ))
    ;;función de competición
    (define/public competicion!
      (lambda (lista_propag)
        (set! competicion
              (sumatorio lista_propag pesos_l))
        ))
    ;;Se establece la salida después de la competición:
    (define/public set-salida
      (lambda (valor)
        (set! salida valor) ))
    ;;reajuste pesos laterales según total de neuronas. Ver ART-3
    ;;reajuste pesos, cuando es ganadora
    (super-new) 
    ))
;;;;;;;;;;;;;;;;
(define capa_c%
  (class object%
    (init-field
     (lista-neuronas '())
     (input '())
     )
    ;;
    (define/public get-neuronas
      (lambda ()
        lista-neuronas ))
    ;;Construye una lista de señales según mensa. Ver ART-3
    (define cons-lista_señales
      (lambda (mensa)
        (map
         (lambda (n)
           (cond
             ((eq? mensa 'propagacion) 
              (send n get-propagacion) )
             ((eq? mensa 'competicion)
              (send n get-competicion) )
             ((eq? mensa 'salida)
              (send n get-salida) )
             ))
         lista-neuronas)
        ))
    ;;Reset neuronas. Class neuron
    (define/public reset-neuronas
      (lambda ()
        (for-each
         (lambda (n)
           (send n reset-neuron!))
         lista-neuronas)
        ))
    ;;Proceso de propagación de señales aferentes
    (define señales->neuronas
      (lambda (señales)
        (for-each
         (lambda(n)
           (send n propagacion! señales)
           )
         lista-neuronas)
        ))
    ;;Proceso de conexiones laterales
    ;;Procesar las señales de una lista. Competición
    (define competicion_procesar-señales
      (lambda (señales)
        (for-each
         (lambda (n)
           (send n competicion! señales)
           )
         lista-neuronas)
        ))
    ;;La competición. Se computa primero según lista de propagación.
    ;;Después, i > 0, según lista de competición.
    (define proceso_competicion
      (lambda ()
        (let salta ((lista-señales 
                     (cons-lista_señales 'propagacion))
                    (i 0)
                    (j (length lista-neuronas));10)
                    )
          (if (= i j)
              (la-mejor 
               (cdr lista-neuronas) (car lista-neuronas))
              (begin
                (competicion_procesar-señales lista-señales)
                (salta
                 (cons-lista_señales 'competicion)
                 (add1 i) j)
                )
              )
          )
        ))
    ;;En el caso de dos o más mejores, se coge la primera
    (define la-mejor
      (lambda (rest_lista-neuronas first-neuron)
        (if (null? rest_lista-neuronas)
            (if (send first-neuron get-inhibicion)
                #f
                first-neuron)
            (let ((first-inhibida?
                   (send first-neuron get-inhibicion))
                  (valor_comp_first
                   (send first-neuron get-competicion))
                  (valor_comp_next 
                   (send (car rest_lista-neuronas) get-competicion))
                  (next-inhibida?
                   (send (car rest_lista-neuronas) get-inhibicion))
                   )
              (cond
                (first-inhibida?
                 (la-mejor (cdr rest_lista-neuronas) (car rest_lista-neuronas)) )
                (next-inhibida?
                 (la-mejor (cdr rest_lista-neuronas) first-neuron) )
                (else
                 (if (> valor_comp_next valor_comp_first)
                     (la-mejor (cdr rest_lista-neuronas) (car rest_lista-neuronas))
                     (la-mejor (cdr rest_lista-neuronas) first-neuron)
                     )
                 )
                )
              )
            )
        ))
    ;;Añadir una categoría
    (define pesos-W
      (lambda (num-neuronas)
        (letrec
            ((peso-W (/ 1 (+ 1 num-neuronas)))
             (aux
              (lambda (num-neuronas p_w)
                (if (= num-neuronas 0)
                    '()
                    (cons
                     p_w
                     (aux (sub1 num-neuronas) p_w))
                    )
                ))
             )
          (aux num-neuronas peso-W)
          )
        ))
    (define pesos-V
      (lambda (num-neuronas)
        (if (= num-neuronas 0)
            '()
            (cons 1
                  (pesos-V (sub1 num-neuronas)))
            )
        ))
    (define ajustar-pesos-L
      (lambda (total-neuronas)
        (for-each
         (lambda (n)
           (send n ajustar-pesos_L total-neuronas)
           )
         lista-neuronas)
        ))
    (define/public add-una-neurona!
      (lambda ();= input
        (let* ((total_w (length input))
               (total_v total_w)
               (num_ord (length lista-neuronas))
               (neuron
                (make-object neuron_c%
                  ;;id
                  num_ord
                  ;;los W
                  (pesos-W total_w)
                  ;;los V
                  (pesos-V total_v)
                  ;;auto y laterales. lateral< - (/ 1 2)
                  '()
                  ;;input
                  input
                  ))
               )
          (send neuron reajusta-pesos!)
          (set! lista-neuronas
                (append lista-neuronas (list neuron)))
          (ajustar-pesos-L (length lista-neuronas))
          neuron
          )
        ))
    ;;EL DINAMISMO
    (define/public proceso!
      (lambda (señales_aferentes)
        (set! input señales_aferentes)
        ;;procesa la propagación de la lista señales
        (señales->neuronas señales_aferentes)
        ;;procesa la competición y devuelve la ganadora
        (let* ((neuron_gana (proceso_competicion))
               )
          (if neuron_gana
              (begin
                (for-each
                 (lambda (n)
                   (send n set-salida 0))
                 lista-neuronas)
                (send neuron_gana set-salida 1)
                neuron_gana
                )
              (let ((new-neuron (add-una-neurona!))
                    )
                new-neuron
                )
              )
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;
(define n_0
  (make-object neuron_c% 0 ;;verdes
    ;;Pesos-w
    '(0 0 1/8 0 0 0 0)
    ;;Pesos-v
    '(0 0 1 0 0 0 0)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 -0.15285714285714286 1 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286)
    ))
(define n_1
  (make-object neuron_c% 1 ;;blancos
    ;;Pesos-w
    '(1/8 0 0 0 0 0 0)
    ;;Pesos-v
    '(1 0 0 0 0 0 0)
    ;;Pesos-l
    '(-0.15285714285714286 1 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286)
    ))
(define n_2
  (make-object neuron_c% 2 ;;amarillos
    ;;Pesos-w
    '(0 0 0 1/8 0 0 0)
    ;;Pesos-v
    '(0 0 0 1 0 0 0)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 1 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286)
    ))
(define n_3
  (make-object neuron_c% 3 ;;negros
    ;;Pesos-w
    '(0 0 0 0 1/8 0 0)
    ;;Pesos-v
    '(0 0 0 0 1 0 0)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 -0.15285714285714286 1 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286)
))
(define n_4
  (make-object neuron_c% 4 ;;rojos
    ;;Pesos-w
    '(0 0 0 0 0 1/8 0)
    ;;Pesos-v
    '(0 0 0 0 0 1 0)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 1 -0.15285714285714286 -0.15285714285714286)
))
(define n_5
  (make-object neuron_c% 5 ;;azules y marrones
    ;;Pesos-w
    '(0 0 0 0 0 0 1/8)
    ;;Pesos-v
    '(0 0 0 0 0 0 1)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 1 -0.15285714285714286)
))
(define n_6
  (make-object neuron_c% 6 ;;feromonas
    ;;Pesos-w
    '(0 1/8 0 0 0 0 0)
    ;;Pesos-v
    '(0 1 0 0 0 0 0)
    ;;Pesos-l
    '(-0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 -0.15285714285714286 1)
))
(define capa_s (make-object capa_c% (list n_0 n_1 n_2 n_3 n_4 n_5 n_6)))
;;LA CLASE RED
(define art%
  (class object%
    (init-field
     (capas '())
     (R 'neuron)
     (estimulo '())
     )
    (define/public get-capas
      (lambda ()
        capas))
    (define/public get-estimulo
      (lambda ()
        estimulo))
    (define/public get-salida_neuron
      (lambda (neuron_id)
        (filter-map
         (lambda (n)
           (if 
            (= neuron_id (send n get-id))
              (send n get-V);)
              #f
             )
           )
         (send (second capas) get-neuronas)
         )
        ))
    ;;PROCESO
    (define/public proceso!
      (lambda (input)
        (set! estimulo input)
        (send (second capas) reset-neuronas)
        (let go ()
          (let*-values
              ([(neuron)
                (send (second capas) proceso!
                      (send (first capas) propagar! estimulo))]
               [(esquema) (send neuron get-V)]
               [(RS booleano)
                (send R proceso! estimulo esquema)]
               [(union) 
                (map (lambda (s e) (* s e)) estimulo esquema)]
               )
            (if booleano
                (values union 
                        (send neuron get-id))
                (begin
                  (send neuron set-inhibicion)
                  (go)
                  )
                )
            )
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;
(define art-olfato (make-object art% (list capa_e capa_s) R))
;;;;;;;;;;;;;;;
(define art-olfativa%
  (class object%
    (init-field
     (lista_art '())
     )
    (define/public get-inversion
      (lambda (neuron_id)
        (send (first lista_art) get-salida_neuron neuron_id)
        ))
    (define/public proceso!
      (lambda (output_retina)
        (map
         (lambda (o l_a)
           (let-values
               ([(out clase)
                 (send l_a proceso! o)]
                )
             clase
             )
           )
         output_retina
         lista_art)
        ))
    (super-new)
    ))
;;;;;;;;;;
(define cortex_olfato
  (make-object art-olfativa%
    (list
     art-olfato
     art-olfato
     art-olfato
     art-olfato
     art-olfato
     art-olfato
     art-olfato
     art-olfato)
    ))
;;;;;;;;;;;;;
(provide cortex_olfato)
;;;;;;;;;;;;;;;;;;
;(define informe-red
;  (lambda (red)
;    (let* ((capas (send red get-capas))
;           (capa_e (first capas))
;           (capa_s (second capas))
;           )
;      (informe (send capa_e get-neuronas) informe-neurona_e)
;      (informe (send capa_s get-neuronas) informe-neurona_s)
;      )
;    ))
;(define informe
;  (lambda (lista-neuronas proc)
;    (printf "~nINFORME~n")
;    (for-each
;     (lambda (n)
;       (proc "" n))
;     lista-neuronas)
;    ))
;(define informe-neurona_s
;  (lambda (mensa neuron)
;    (printf mensa)
;    (printf "ID: ~a~n" (send neuron get-id))
;    (printf "W: ~a~n" (send neuron get-W))
;    (printf "V: ~a~n" (send neuron get-V))
;    (printf "A_L: ~a~n" (send neuron get-L))
;    (printf "Input: ~a~n" (send neuron get-input))
;    (printf "Propagacion: ~a~n" (send neuron get-propagacion))
;    (printf "Competicion: ~a~n" (send neuron get-competicion))
;    (printf "Salida: ~a~n" (send neuron get-salida))
;    (printf "inhibicion?: ~a~n" (send neuron get-inhibicion))
;    ))
;(define informe-neurona_e
;  (lambda (mensa neuron)
;    (printf mensa)
;    (printf "ID: ~a~n" (send neuron get-id))
;    (printf "Input: ~a~n" (send neuron get-input))
;    (printf "Activación: ~a~n" (send neuron get-activacion))
;    (printf "Salida: ~a~n" (send neuron get-salida))
;    ))
;;;;;;;;;;;;;;;;;;;;
;(define training_set
;  (list
;   '(0 0 1 0 0 0 0);;verde
;   '(1 0 0 0 0 0 0);;blanco
;   '(0 0 0 1 0 0 0);;amarillo
;   '(0 0 0 0 1 0 0);;negro
;   '(0 0 0 0 0 1 0);;rojo
;   '(0 0 0 0 0 0 1);;azul y marrón
;   '(0 1 0 0 0 0 0);;feromona
;   ))
;;;;
;(let go ((i 0)
;         (j (length training_set))
;         )
;  (if (= i j)
;      (informe-red art-olfato)
;      (let*-values ([(input) (list-ref training_set i)]
;                    [(salida categoria) (send art-olfato proceso! input)]
;                    )
;        (printf "~nInput: ~a Clasificado en la Categoría: ~a ~n" input categoria)
;        (go (add1 i) j)
;        )
;      )
;  )
