#lang racket

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (define-struct regla
    ;(struct regla
      (   
       (fuerza #:mutable)
       (antecedente #:mutable)
       (produccion #:mutable)
       (id #:mutable)
       )
      #:transparent
      )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define generar_reglas%
  (class object%
    ;;Técnica para generar una regla
    (define genera-antecedente
      (lambda (out_receptor)
        out_receptor ))
    ;;;;;;;;;;;;;;
    (define genera-accion
      (lambda (list_ordinales)
        (first list_ordinales)
        ))
    ;;;;;;;;;;;;;;
    (define/public generar-regla
      (lambda (out_receptor N)
        (let* ((antecedente (genera-antecedente out_receptor))
               (accion 
                (genera-accion (list 0 1 2 3 4 5 6 7)))
               )
          (make-regla 1 antecedente accion N)
          )
        ))
    ;;;;;;;;;;;;;;
    (define/public modificar-accion
      (lambda (lista_ordinales lista-acciones_realizadas)
        (let ((proc (if (= (random 2) 0) first last)) )
          (first
           (remove* lista-acciones_realizadas
                    lista_ordinales))
          )
        ))
    ;;Técnica para generalizar una regla
    (define/public generalizar-regla
      (lambda (regla)
        (let ((antecedente (regla-antecedente regla))
              (accion (regla-produccion regla))
              )
          (map
           (lambda (par ord)
             (if (= ord accion)
                 par
                 (if (= (car par) 0)
                     (cons 0 #\#);par
                     par)
                 )
             )
           antecedente '(0 1 2 3 4 5 6 7))
          )
        ))
    (super-new)
    ))
;;;;;;;
(define generar-reglas (make-object generar_reglas%))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define motor_inferencias%
  (class object%
    (field
     (M_set 'conjunto-reglas-activadas)
     )
    (define seleccion-de-M
      (lambda (output_receptor BC)
        (cond
          ((null? BC) '())
          ((match (regla-antecedente (first BC)) output_receptor)
           (cons
            (first BC)
            (seleccion-de-M output_receptor (rest BC))) )
          (else
           (seleccion-de-M output_receptor (rest BC)))
          )
        ))
    (define match-par?
      (lambda (par1 par2);antecedente-regla output_receptor
        (and
         (equal? (car par1) (car par2))
         (or
          (char? (cdr par1))
          (equal? (cdr par1) (cdr par2))
          ))
        ))
    (define match
      (lambda (lista1 lista2);antecedente-regla output_receptor
        (let go ((i 0)
                 (j (length lista1))
                 )
          (if (= i j)
              #t
              (if (match-par? (list-ref lista1 i) (list-ref lista2 i))
                  (go (add1 i) j)
                  #f)
              )
          )
        ))
    (define/public proceso!
      (lambda (output_receptor BC)
        (set! M_set
              (seleccion-de-M output_receptor BC))
        M_set
        ))
    (super-new)
    ))
;;;;;;
(define motor_inferencial (make-object motor_inferencias%))
;;;;;;;;;;;;;;;;;;;;;
(define probabilidad_reglas%
  (class object%
    (field
     )
    (define sumatorio-fuerzas
      (lambda (set-M)
        (if (null? set-M)
            0
            (+
             (regla-fuerza (first set-M))
             (sumatorio-fuerzas (rest set-M)))
            )
        ))
    (define probabilidad-uno
      (lambda (fuerza-uno sumatorio_fuerzas)
        (/ fuerza-uno sumatorio_fuerzas)
        ))
    (define lista-ordinales
      (lambda (M_set n)
        (if (null? M_set)
            '()
            (cons
             n
             (lista-ordinales (rest M_set) (add1 n)))
            )
        ))
    (define/public proceso!
      (lambda (set_M)
        (let* ((sumatorio (sumatorio-fuerzas set_M))
               (set-M-ordenado
                (sort    
                 (map
                  (lambda (una-r ordinal)
                    (cons
                     (probabilidad-uno (regla-fuerza una-r) sumatorio)
                     ordinal)
                    )
                  set_M (lista-ordinales set_M 0))
                 #:key car >));#:key car <
               (rule_order (cdr (first set-M-ordenado)))
               )
          (list-ref set_M rule_order)
          )
        ))
    (super-new)
    ))
;;;;;;;;
(define regla-mas-probable (make-object probabilidad_reglas%))
;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define procesar-recompensa%
  (class object%
    (define/public procesar-recompensa!
      (lambda (secuencia-actos)
        (difundir-recompensa-secuencia secuencia-actos 1)
        ))
    (define difundir-recompensa-secuencia
      (lambda (secuencia p)
        (cond
          ((null? secuencia) #t)
          (else
           (set! p
                 (refuerzo-un-acto (car secuencia) p))
           (difundir-recompensa-secuencia (cdr secuencia) p)
           )
          )
        ))
    (define refuerzo-un-acto
      (lambda (elemento-secuencia P)
        (let ((A-set (third elemento-secuencia))
              (next-p 0)
              )
          (letrec ((aux
                    (lambda (set-A p)
                      (if (null? set-A)
                          '()
                          (let ((fraccion_restada (reajuste-fuerza-por-recompensa (car set-A) 0.10 p (length A-set))))
                            (set! next-p (+ next-p fraccion_restada))
                            (cons
                             (car set-A)
                             (aux (cdr set-A) p)
                             )
                            )
                          )
                      ))
                   )
            (aux A-set P)
            next-p
            )
          )
        ))
    (define reajuste-fuerza-por-recompensa
      (lambda (regla epsilon p length-A-set)
        (let* ((fuerza_r (regla-fuerza regla))
               (recompensa (/ p length-A-set))
               (fraccion-restada (* epsilon fuerza_r))
               )
          (set-regla-fuerza!
           regla
           (+
            fuerza_r
            recompensa
            (- fraccion-restada)
            )
           )
          fraccion-restada
          )
        ))
    (super-new)
    ))
;;;;;;;
(define calculos-recompensa (make-object procesar-recompensa%))
;;;;;;;;;;;;;;;;;;;;;
(define consciencia%
  (class object%
    (field
     (historia-reglas-modificadas '())
     )
    ;;;;;;;;;;;;;;;;;;;;
    (define/public get-historia-reglas-modificadas
      (lambda ()
        historia-reglas-modificadas ))
    ;;;;;;;;;;;;;;;;;;;;
    (define analisis-item
      (lambda (item)
        (map
         (lambda (x)
           (if (symbol? (car x))
               (if (pair? (cdr x))
                   (list (cons 'simbolo (car x))
                         (cons 'valor (cdr x)))
                   (if (number? (cdr x))
                       (list (cons 'simbolo (car x))
                             (cons 'valor (cdr x)))
                       "no sé")
                   )
               "no car")
           )
         item)
        ))
    (define analisis-consciencia:busqueda-exitos-posibles
      (lambda (meta_R)
        (let* ((informacion-meta_R
                (map
                 (lambda (r)
                   (analisis-item r)
                   )
                 meta_R))
               (Exito
                (sort
                 (append-map
                  (lambda (info-r)
                    (filter-map
                     (lambda (x)
                       (if (equal? (cdr (assoc 'simbolo x)) 'exito)
                           (cons 'exito (cdr (assoc 'valor x)))
                           #f)
                       )
                     info-r)
                    )
                  informacion-meta_R)
                 #:key cdr <);;>
                )
               )
          Exito
          )
        ))
    (define analisis-consciencia:asociar-exito-tipo_obj
      (lambda (meta_R exitos-posibles)
        (append-map
         (lambda (e_p)
           (filter-map
            (lambda (m_r)
              (if (equal? (assoc (car e_p) m_r) e_p)
                  (append (list e_p) (remove (assoc (car e_p) m_r) m_r))
                  #f)
              )
            meta_R)
           )
         exitos-posibles)
        ))
    (define/public analisis-consciencia:exitos-posibles
      (lambda (meta_R)
        (let* ((exitos_posibles
                (analisis-consciencia:busqueda-exitos-posibles meta_R))
               (todos_exito-tipo_obj
                (analisis-consciencia:asociar-exito-tipo_obj meta_R exitos_posibles))
               )
          todos_exito-tipo_obj
          )
        ))
    (define reformular-regla
      (lambda (regla exito-posible)
        (let* ((fuerza (regla-fuerza regla))
               (id (regla-id regla))
               (accion (regla-produccion regla))
               (antecedente (regla-antecedente regla))
               (valor-exito (cdr (assoc 'exito exito-posible)))
               (valor-tipo_obj (cdr (assoc 'vec_tipo exito-posible)))
               (nueva-accion
                (ormap
                 (lambda (par ord)
                   (if (equal? par valor-tipo_obj)
                       ord
                       #f)
                   )
                 antecedente '(0 1 2 3 4 5 6 7))
                )
               )
          (if nueva-accion
              (make-regla 1 antecedente nueva-accion id)
              regla)
          )
        ))
    (define/public accion-consciencia:reformular-regla
      (lambda (regla exitos-posibles)
        (define r regla)
        (for-each
         (lambda (ex_pos)
           (set! regla
                 (reformular-regla regla ex_pos))
           )
         exitos-posibles)
        (unless (equal? r regla)
          (set! historia-reglas-modificadas (cons regla historia-reglas-modificadas)) )
        regla
        ))
    (define/public accion-consciencia:establecer-nueva_bc
      (lambda (bc exitos-posibles)
        (for-each
         (lambda (ex_pos)
           (set! bc
                 (map
                  (lambda (r)
                    (reformular-regla r ex_pos)
                    )
                  bc)
                 )
           )
         exitos-posibles)
        bc
        ))
    (define/public accion-consciencia:establecer-mejor-regla
      (lambda (m-set ex_pos)
        (set! m-set
              (map
               (lambda (r)
                 (accion-consciencia:reformular-regla r ex_pos)
                 )
               m-set))
        (ormap
         (lambda (r)
           (if (equal? '(1 . 1) (list-ref (regla-antecedente r) (regla-produccion r)))
               r
               #f)
           )
         m-set)
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
(define conciencia_reflexiva (make-object consciencia%))
;;;;;;;;;;;;;;;;;;;;;
(define control_central%
  (class object%
    ;;init-field: los subsistemas
    (init-field
     (Generador-reglas 'generar-reglas)
     (Interprete-reglas 'motor_inferencial)
     (Probabilidad-reglas 'regla-mas-probable)
     (Calcular-recompensa 'calculos-recompensa)
     (Aprendizaje_inductivo 'operacion_induccion)
     (Proto-Conciencia 'conciencia_reflexiva)
     )
    ;;field: propiedades estructurales
    (field
     (BC '())
     (M_set 'conjunto-de-reglas-activadas)
     (exito 0)
     (last-rule #f)
     (last-action '())
     (meta-reglas #f)
     (Exitos-posibles #f)
     ;;;
     (historia '())
     (Secuencia-actos '())
     (A_set '())
     (accion #f)
     )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (define/public get-historia-consciencia
      (lambda ()
        (send Proto-Conciencia get-historia-reglas-modificadas) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (define sustituir-regla
      (lambda (BC new-last-rule)
        (let ((V (if (null? BC)
                     (make-vector 1)
                     (list->vector BC)))
              )
          (vector-set! V (regla-id new-last-rule) new-last-rule)
          (set! BC
                (vector->list V))
          )
        BC
        ))
    (define set-secuencia_actos
      (lambda ()
        (set! Secuencia-actos (cons (list accion last-rule A_set) Secuencia-actos))
        ))
    (define inicializa-secuencia_actos
      (lambda ()
        (set! Secuencia-actos '())
        ))
    (define generalizada?
      (lambda (antecedente)
        (ormap
         (lambda (par)
           (char? (cdr par))
           )
         antecedente)
        ))
;;;;;;;;;;;;;;;;;;;;;;;;;
    (define M-set->A-set
      (lambda (M-set rule)
        (cond 
          ((null? M-set) '())
          ((= (length M-set) 1) M-set)
          ((= (regla-produccion rule) (regla-produccion (car M-set)))
           (cons (car M-set)
                 (M-set->A-set (cdr M-set) rule)) )
          (else
           (M-set->A-set (cdr M-set) rule))
          )
        ))
;;;;;;;;;;;;;;;;;;;;;;;;;
    (define/public get_bc
      (lambda ()
        (sort BC #:key regla-fuerza >) ))
    (define/public get-bc
      (lambda ()
        (map
         (lambda (o)
           (sort
           (filter-map
            (lambda (r)
              (if (= (regla-produccion r) o)
                  r
                  #f))
            BC) 
           #:key regla-fuerza >))
         '(0 1 2 3 4 5 6 7))
        ))
;;;;;;;;;;;;;;;;;;;;;;;;;
    (define/public set-meta-reglas
      (lambda (Historia)
        (let-values ([(Reglas Meta_reglas) (send Aprendizaje_inductivo proceso! Historia)])
          (set! meta-reglas Meta_reglas)
          (set! Exitos-posibles 
                (send Proto-Conciencia analisis-consciencia:exitos-posibles meta-reglas))
          (printf "Meta-reglas inducidas: ~a~nÉxitos posibles: ~a~n" meta-reglas Exitos-posibles)
          (set! BC
                (send Proto-Conciencia accion-consciencia:establecer-nueva_bc BC Exitos-posibles))
          )
        ))
    ;;;;;;;;;;;;;;;;;;;;
    (define/public set-exito
      (lambda (valor num_iter)
        (set! exito valor)
        (set! historia
              (cons
               (append (car historia) (list (cons 'exito valor)))
               (cdr historia)))
        (printf "Registro para Historia: ~a~n" (first historia))
        (printf "***Proceso de refuerzo***~n")
        (printf "La acción realizada ha tenido ~a~n" (if (< exito 0) "fracaso" (if (= exito 0) "éxito" "recompensa")))
        (cond
          ((negative? exito)
           (printf "Secuencia actos: ~a~nRegla: ~a~n" (length Secuencia-actos) last-rule)
           (set-regla-produccion! last-rule
                                  (send Generador-reglas modificar-accion (list 0 1 2 3 4 5 6 7) last-action) )
           (sustituir-regla BC last-rule)
           (printf "Regla modificada: ~a~n" last-rule) 
           )
          
          ((zero? exito)
           (set-secuencia_actos)
           (printf "Secuencia actos: ~a~n regla: ~a~n" (length Secuencia-actos) last-rule)
           (unless (generalizada? (regla-antecedente last-rule))
             (printf "Se generaliza el antecedente de la regla~a~n" last-rule)
             (set-regla-antecedente! last-rule
                                     (send Generador-reglas generalizar-regla last-rule))
             (printf "Regla modificada: ~a~n" last-rule) )
             (if Exitos-posibles;meta-reglas
                 (set! last-rule
                      (send Proto-Conciencia accion-consciencia:reformular-regla last-rule Exitos-posibles))
                 #f)
             (sustituir-regla BC last-rule)
           )
          
          ((= exito 1)
           (set-secuencia_actos)
           (printf "Secuencia actos: ~a~n regla: ~a~n" (length Secuencia-actos) last-rule)
           (unless (generalizada? (regla-antecedente last-rule))
             (printf "Se generaliza el antecedente de la regla~a~n" last-rule)
             (set-regla-antecedente! last-rule
                                     (send Generador-reglas generalizar-regla last-rule))
             (printf "Regla modificada: ~a~n" last-rule) )
           (send Calcular-recompensa procesar-recompensa! Secuencia-actos)
           (inicializa-secuencia_actos)
           )
          )
        (printf "***Fin del proceso de refuerzo***~n")
        ))
    ;;;;;;;;;;;;;;;;;;;;
    (define/public proceso!
      (lambda (output_receptor iter)
        (printf "***Proceso del cerebro***~n")
        (printf "Output_Receptor ~a~n" output_receptor)
        (when (= (length historia) 50);(= iter 100)
          (set-meta-reglas historia)
          )
;        (when (member iter '(100 150 200 250 300 350 400))
;          (set! BC
;                (send Proto-Conciencia accion-consciencia:establecer-nueva_bc BC Exitos-posibles))
;          )
        (printf "Tamaño BC: ~a ~n" (length BC))
        (set! M_set (send Interprete-reglas proceso! output_receptor BC))
        (printf "M-Set ~a~n" (length M_set))
        (cond
          ;;M-set está vacío. Se necesita una nueva regla
          ((null? M_set)
           (set! last-rule (send Generador-reglas generar-regla output_receptor (length BC)))
           (set! accion (regla-produccion last-rule))
           (set! last-action (cons accion '()))
           (printf "Regla generada: ~a~n" last-rule)
;           (if (ormap
;                (lambda (r)
;                  (equal? r last-rule))
;                BC)
;               #t
;               (set! BC (cons last-rule BC))
;               )
           (set! M_set (cons last-rule M_set))
           (set! BC (cons last-rule BC))
           )
          ;;M-set no está vacío
          (else
           (set! last-rule (if Exitos-posibles
                 (send Proto-Conciencia accion-consciencia:establecer-mejor-regla M_set Exitos-posibles)
                 #f))
           (printf "Conciencia Last-rule: ~a~n" last-rule)
           (unless last-rule
             (set! last-rule (send Probabilidad-reglas proceso! M_set)) )
           (set! accion (regla-produccion last-rule))
           (set! last-action (cons accion last-action))
           (printf "Regla de mayor probabilidad: ~a~n" last-rule)
           )
          )
        (set! A_set (M-set->A-set M_set last-rule))
        (set! historia 
              (cons 
               (list (cons 'accion accion) (cons 'vec_tipo (list-ref output_receptor accion))) 
               historia))
        (printf "***Fin proceso del cerebro***~n")
        (values accion)
        ))
    (super-new)
    ))
;;;;;;;;;;;
(require "ID3.rkt")
(define cerebro (make-object control_central% generar-reglas motor_inferencial regla-mas-probable calculos-recompensa operacion_induccion conciencia_reflexiva))


(provide cerebro regla)

