#lang scheme

;;;;;Funciones;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;de propagación
(define propagacion_lineal_aux
  (lambda (lista-señales lista-pesos);igual length
    (if (null? lista-señales)
        0
        (+
         (* (first lista-señales)
            (first lista-pesos))
         (propagacion_lineal_aux 
          (cdr lista-señales) (cdr lista-pesos)))
        )
    ))
(define propagacion_lineal
  (lambda (lista-señales lista-pesos umbral)
    (- 
     (propagacion_lineal_aux lista-señales lista-pesos)
     umbral)
    ))
;;para usar con sigmoidea_log
(define propagacion_lineal_sigm
  (lambda (lista-señales lista-pesos umbral)
    (+ ;<--- ??
     (propagacion_lineal_aux lista-señales lista-pesos)
     umbral)
    ))
(define propagacion_euclidea_aux
  (lambda (lista-señales lista-pesos);igual length
    (if (null? lista-señales)
        0
        (+
         (expt (- (first lista-señales)
                  (first lista-pesos)) 2)
         (propagacion_euclidea_aux
          (cdr lista-señales) (cdr lista-pesos)))
        )
    ))
(define propagacion_euclidea
  (lambda (lista-señales lista-pesos umbral)
    (- 
     (propagacion_euclidea_aux lista-señales lista-pesos)
     umbral)
    ))
;;;de activación
;;considerando o no el estado anterior
(define suma-estado
  (lambda (valor_propagacion . estado)
    (if (null? estado)
        valor_propagacion
        (+ valor_propagacion (car estado)) )
    ))
;;;de salida
;;de escalón, sigmoidea, gaussiana y sinusoidal
(define lineal
  (lambda (valor_activacion)
    valor_activacion ))

(define escalon_1
  (lambda (valor_activacion)
    (if (< valor_activacion 0)
        0
        1)
    ))

(define escalon_2
  (lambda (valor_activacion)
    (if (< valor_activacion 0)
        -1
        1)
    ))

(define escalon_3
  (lambda (valor_activacion)
    (if (< valor_activacion 0)
        -1
        (if (> valor_activacion 1)
            1
            valor_activacion)
        )
    ))

(define escalon_4
  (lambda (valor_activacion)
    (if (< valor_activacion -1)
        -1
        (if (> valor_activacion 1)
            1
            valor_activacion)
        )
    ))

(define sigmoidea_log
  (lambda (valor_activacion)
    (/ 1 (+ 1 (expt 2.71828 (- valor_activacion)))) 
    ))

(define sigmoidea_hiper
  (lambda (valor_activacion)
    (/ (- 
        (expt 2.71828 valor_activacion) 
        (expt 2.71828 (- valor_activacion)))
       (+ 
        (expt 2.71828 valor_activacion) 
        (expt 2.71828 (- valor_activacion))))
    ))


;;;;;LA CLASE NEURONA
(define neuron_hopfield%
  (class object%
    (init-field
     id
     (con-pesos '())
     (func_net 'proc)
     (func_act 'proc)
     (func_sal 'proc)
     )
    (field
     (umbral 0)
     (input 0)
     (propagacion 0)
     (activacion 0);estado interno
     (salida 0)
     )
    ;;para función energía
    (define/public get-id
      (lambda ()
        id ))
    (define/public get-umbral
      (lambda ()
        umbral ))
    (define/public get-pesos
      (lambda ()
        con-pesos ))
    ;;Hopfield
    (define/public get-salida
      (lambda ()
        salida))
    (define set-umbral
      (lambda ()
        (letrec
            ((suma-pesos
              (lambda (pesos)
                (if (null? pesos)
                    0
                    (+ (car pesos)
                       (suma-pesos (cdr pesos)))
                    ) ))
             (k (/ 1 8));0);(/ 1 2)
             )
          (* k (suma-pesos con-pesos))
          ) ))
    ;;En aprendizaje
    (define son-pesos
      (lambda (lista num-id)
        (let go ((i 0)
                 (j (length lista))
                 (pesos '())
                 )
          (if (= i j)
              (reverse pesos)
              (if (= i num-id)
                  (go (add1 i) j pesos)
                  (go (add1 i) j 
                      (cons
                       (list-ref lista i)
                       pesos))
                  )
              )
          )
        ))
    (define/public set-pesos
      (lambda (lista)
        (set! con-pesos (son-pesos lista id))
        (set! umbral (set-umbral));;??
        ))
    ;;;Cálculos
    (define/public inicializa!
      (lambda (estimulo)
        (set! input estimulo)
        (set! activacion input)
        (set! salida activacion)
        (set! umbral (set-umbral))
        ))
    (define/public proceso!
      (lambda (señales)
        (set! propagacion (func_net señales con-pesos umbral))
        (set! activacion (func_act propagacion))
        (set! salida (func_sal activacion))
        salida
        ))
    (super-new) 
    ))
;;;;;;;;;;;;EJEMPLARES DE NEURONAS
(define n_0
  (make-object neuron_hopfield% 0
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal;suma-estado 
    escalon_2))
(define n_1
  (make-object neuron_hopfield% 1
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_2
  (make-object neuron_hopfield% 2
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_3
  (make-object neuron_hopfield% 3
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_4
  (make-object neuron_hopfield% 4
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_5
  (make-object neuron_hopfield% 5
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_6
  (make-object neuron_hopfield% 6
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_7
  (make-object neuron_hopfield% 7
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
(define n_8
  (make-object neuron_hopfield% 8
    (list 0 0 0 0 0 0 0 0)
    propagacion_lineal 
    lineal 
    escalon_2))
;;;;;;;;;;;;;;;;;;;
;;;;;LA CLASE RED
(define red%
  (class object%
    (init-field
     (lista-neuronas '())
     (proc-draw 'proc)
     (dc-ventana 'dc)
     (diametro 0)
     )
    ;;Hopfield
    (define/public set-datos-draw
      (lambda (proc dc 2r)
        (set! proc-draw proc)
        (set! dc-ventana dc) 
        (set! diametro 2r)
        ))
    (define/public get-neuronas
      (lambda ()
        lista-neuronas ))
    (define inicializa-red
      (lambda (neuronas inputs)
        (if (null? neuronas)
            'hecho
            (begin
              (send (car neuronas) inicializa! (car inputs))
              (inicializa-red (cdr neuronas) (cdr inputs))
              )
            )
        ))
    (define get-salidas
      (lambda (neuronas)
        (if (null? neuronas)
            '()
            (cons
             (send (car neuronas) get-salida)
             (get-salidas (cdr neuronas))
             )
            )
        ))
    (define lista-sin-elem_n
      (lambda (lista n)
        (append
         (take lista n)
         (list-tail lista (add1 n))
         )
        ))
    (define lista-señales
      (lambda (salidas)
        (let go ((i 0)
                 (j (length salidas))
                 (lst-señales '())
                 )
          (if (= i j)
              (reverse lst-señales)
              (go
               (add1 i) j
               (cons
                (lista-sin-elem_n salidas i)
                lst-señales))
              )
          )
        ))
    (define difunde-señales
      (lambda (neuronas lst-señales)
        (if (null? neuronas)
            '()
            (cons
             (send (car neuronas) proceso! (car lst-señales))
             (difunde-señales (cdr neuronas) (cdr lst-señales)))
            )
        ))
    ;;Función energía
    (define suma-umbrales;ok
      (lambda (neuronas)
        (if (null? neuronas)
            0
            (+
             (*
              (send (car neuronas) get-umbral)
              (send (car neuronas) get-salida))
             (suma-umbrales (cdr neuronas)))
            )
        ))

    (define una-peso-por-señales;ok
      (lambda (neuron neuronas)
        (let go ((salida (send neuron get-salida))
                 (pesos (send neuron get-pesos))
                 (neurons (lista-sin-elem_n neuronas (send neuron get-id)))
                 (suma 0)
                 )
          (if (null? pesos)
              suma
              (go salida (cdr pesos) (cdr neurons)
                  (* salida (car pesos) (send (car neurons) get-salida)))
              )
          )
        ))

    (define sumatorio-energia;ok
      (lambda (neuronas)
        (let go ((neurons neuronas)
                 (suma 0)
                 )
          (if (null? neurons)
              suma
              (go (cdr neurons)
                  (+
                   (una-peso-por-señales (car neurons) neuronas)
                   (suma-umbrales neuronas))
                  )
              )
          )
        ))
    (define funcion-energia
      (lambda (neuronas)
        (- (/ 1 2) (sumatorio-energia neuronas)) ))
    ;;el método público
    (define/public proceso!
      (lambda (estimulos)
        (inicializa-red lista-neuronas estimulos)
        (let* ((salidas (get-salidas lista-neuronas))
               (lista_señales (lista-señales salidas))
               )
          (send dc-ventana clear)
          (proc-draw salidas 1 0 diametro dc-ventana)
          (let go ((resp_1 
                    (difunde-señales lista-neuronas lista_señales))
                   (y1 (* 2 diametro))
                   (i 1)
                   (j 101)
                   )
            (if (= i j)
                resp_1
                (let* ((energ_1 (funcion-energia lista-neuronas))
                       (y2 (+ y1 diametro))
                       (salidas (get-salidas lista-neuronas))
                       (lista_señales (lista-señales salidas))
                       (resp_2 
                        (difunde-señales 
                         lista-neuronas lista_señales))
                       (energ_2 (funcion-energia lista-neuronas))
                       )
                  ;(printf "Energ_1 ~a Energ_2 ~a~n" energ_1 energ_2)
                  (proc-draw resp_2 1 y1 diametro dc-ventana)
                  (if (<= energ_2 energ_1);8 o 7estimulos
                      (go resp_2 (+ y1 diametro) (add1 i) j)
                      (go resp_1 (+ y1 diametro) (add1 i) j)
                      )
                  )
                )
            )
          )
        ))
    (super-new)
    ))

;(define hopfield 
;  (make-object red% (list n_0 n_1 n_2 n_3 n_4 n_5 n_6 n_7 n_8)))



(provide n_0 n_1 n_2 n_3 n_4 n_5 n_6 n_7 n_8 red%)