#lang scheme

;;Aprendizaje Redes Hopfield
;;Operaciones con matrices (aquí listas de listas)
(define extrae-fila
  (lambda (matriz num_orden)
    (list-ref matriz num_orden)
    ))
(define extrae-columna
  (lambda (matriz num_orden)
    (let go ((i 0)
             (j (length matriz))
             (columna '())
             )
      (if (= i j)
          (reverse columna)
          (go (add1 i) j 
              (cons
               (list-ref (extrae-fila matriz i) num_orden)
               columna))
          )
      )
    ))
(define todas-columnas
  (lambda (matriz)
    (let go ((i 0)
             (j (length (first matriz)))
             (columnas '())
             )
      (if (= i j)
          (reverse columnas)
          (go (add1 i) j
              (cons
               (extrae-columna matriz i)
               columnas))
          )
      )
    ))
(define elemento
  (lambda (fila columna)
    (if (null? fila)
        0
        (+
         (* (car fila) (car columna))
         (elemento (cdr fila) (cdr columna)))
        )
    ))
(define haz-fila
  (lambda (fila columnas)
    (if (null? columnas)
        '()
        (cons
         (elemento fila (car columnas))
         (haz-fila fila (cdr columnas)))
        )
    ))
    
(define producto-matrices
  (lambda (a b)
    (let go ((columnas_b (todas-columnas b))
             (i 0)
             (j (length a))
             (matriz '())
             )
      (if (= i j)
          (reverse matriz)
          (go 
           columnas_b (add1 i) j
           (cons
            (haz-fila (extrae-fila a i) columnas_b) matriz)
           )
          )
      )
    ))

(define suma-matrices
  (lambda (a b proc)
    (let go ((i 0)
             (j (length a))
             (matriz '())
             )
      (if (= i j)
          (reverse matriz)
          (let salta ((fila_a (list-ref a i))
                      (fila_b (list-ref b i))
                      (k 0)
                      (m (length (list-ref a i)))
                      (fila '())
                      )
            (if (= k m)
                (go (add1 i) j (cons (reverse fila) matriz))
                (salta 
                 fila_a
                 fila_b
                 (add1 k) 
                 m 
                 (cons
                  (proc (list-ref fila_a k) (list-ref fila_b k))
                  fila))
                )
            )
          )
      )
    ))
;;;;;;Entrenamiento
;;Transforma una lista de n estimulos en una matriz n filas
(define estimulo->matriz
  (lambda (lista)
    (if (null? lista)
        '()
        (cons
         (list (car lista))
         (estimulo->matriz (cdr lista)) )
        )
    ))
;;Matriz de pesos
(define matriz-pesos
  (lambda (estimulos matriz_inicial)
    (let* ((a (estimulo->matriz (list-ref estimulos 0)))
           (b (list (list-ref estimulos 0)))
           (c (producto-matrices a b))
           )
      (let go ((i 1)
               (j (length estimulos))
               (matriz_pesos (suma-matrices c matriz_inicial -))
               )
        (if (= i j)
            matriz_pesos
            (let* ((a (estimulo->matriz (list-ref estimulos i)))
                   (b (list (list-ref estimulos i)))
                   (c (producto-matrices a b))
                   )
              (go (add1 i) j
                  (suma-matrices
                   matriz_pesos
                   (suma-matrices c matriz_inicial -) +));matriz_pesos
              )
            )
        )
      )
    ))

(provide matriz-pesos)

