#lang scheme/gui

;;;;LOS TIPOS DE OBJETOS
;;;; Son objetos elementales las cifras, un signo y un carácter
;;;; Además existe el objeto especial empty o lista vacía
(define cifra?
  (lambda (arg)
    (if (and
         (number? arg)
         (positive? arg)
         (< arg 10))
        arg
        #f) ))
(define signo?
  (lambda (arg)
    (if (and
         (symbol? arg)
         (= (string-length (symbol->string arg)) 1))
        arg
        #f) ))
(define lista-vacia? empty?)
;;;;; Conversiones de tipo
(define make->signo
  (lambda (arg)
    (cond
      ((signo? arg) arg)
      ((cifra? arg) (string->symbol (number->string arg)))
      ((char? arg) (string->symbol (string arg)))
      (else (printf "~a no es convertible en un signo" arg))
      ) ))
(define make->char
  (lambda (arg)
    (cond
      ((signo? arg) (string-ref (symbol->string arg) 0))
      ((cifra? arg) (string-ref (number->string arg) 0))
      ((char? arg) arg)
      (else (printf "~a no es convertible en un char" arg))
      ) ))
;;;;; Tipos compuestos
(define natural?
  (lambda (arg)
    (and
     (number? arg)
     (positive? arg)) ))
(define literal? symbol?)
(define palabra? string?)
(define lista? list?)
;;; Números a partir de lista de cifras
(define make-numero
  (lambda (args)
    (letrec
        ((args->strings
          (lambda (lst)
            (cond
              ((null? lst) '())
              ((cifra? (car lst))
               (cons 
                (number->string (car lst))
                (args->strings (cdr lst))) )
              (else (args->strings (cdr lst)))
              ) ))
         (haz-numero
          (lambda (lst)
            (string->number
             (apply string-append (args->strings lst))) 
            ))
         )
      (haz-numero args)
      ) ))
;;; Literales a partir de lista de cifras, chars o signos
(define make-literal
  (lambda (args)
    (letrec
        ((args->signos
          (lambda (lst)
            (cond
              ((null? lst) '())
              ((cifra? (car lst))
               (cons 
                (make->signo (car lst))
                (args->signos (cdr lst))) )
              ((signo? (car lst))
               (cons 
                (car lst)
                (args->signos (cdr lst))) )
              ((char? (car lst))
               (cons 
                (make->signo (car lst))
                (args->signos (cdr lst))) )
              (else (args->signos (cdr lst)))
              ) ))
         (signos->string
          (lambda (lst)
            (if (null? lst)
                '()
                (cons
                 (symbol->string (car lst))
                 (signos->string (cdr lst)))
                )))
         (haz-literal
          (lambda (lst)
            (string->symbol
             (apply string-append (signos->string lst))) 
            ))
         )
      (haz-literal (args->signos args))
      ) ))
;;;;; Palabras a partir de lista de chars o signos
(define make-palabra
  (lambda (args)
    (letrec
        ((args->string
          (lambda (lst)
            (cond
              ((null? lst) '())
              ((signo? (car lst))
               (cons 
                (symbol->string (car lst))
                (args->string (cdr lst))) )
              ((char? (car lst))
               (cons 
                (string (car lst))
                (args->string (cdr lst))) )
              (else (args->string (cdr lst)))
              ) ))
         )
      (apply string-append (args->string args))
      ) ))
;;;;; Listas a partir cifras, signos o chars y empty
;(define make-lista
(define vacio?
  (lambda (s)
    (and
     (symbol? s)
     (char=? (string-ref (symbol->string s) 0) #\v)) ))
;;;; Clases de objetos
(define vacio%
  (class object%
    (field
     (elem (gensym "v"))
     (tipo vacio?)
     )
    (define/public get-obj
      (lambda ()
        (values elem tipo)
        ))
    (define/public muestra!
      (lambda (proc-write)
        (proc-write elem)))
    (super-new)
    ))
;;; Un objeto elemental es una cifra o un char o un signo
(define obj-elemental%
  (class object%
    (field
     (elem 'signo)
     (tipo 'pred-tipo?)
     )
    (define tipo?
      (lambda (arg)
        (cond
          ((cifra? arg) 
           (values arg cifra?) )
          ((char? arg) 
           (values arg char?) )
          ((signo? arg)
           (values arg signo?) )
          ((lista-vacia? arg)
           (values arg lista-vacia?) )
          (else 
           (values arg #f) )
          )
        ))
    (define/public set-obj!
      (lambda (arg)
        (let-values 
            ([(obj type) (tipo? arg)])
          (if type
              (begin
                (set! elem obj)
                (set! tipo type)
                )
              (printf "~a no es un dato elemental" elem)
              )
          )
        ))
    (define/public muestra!
      (lambda (proc-write)
        (proc-write elem)))
    (define/public get-obj
      (lambda ()
        (values elem tipo)
        ))
    (super-new)
    ))
;;;; Un objeto compuesto es un número o un literal o una palabra
(define obj-compuesto%
  (class object%
    (field
     (obj 'representacion)
     (tipo? 'pred-tipo?)
     )
    (define all-cifras?
      (lambda (args)
        (if (null? args)
            #t
            (let-values ([(obj type) (send (car args) get-obj)])
              (cond
                ((cifra? obj)
                 (all-cifras? (cdr args)) )
                (else #f)
                ))
            )
        ))
    (define all-signos?
      (lambda (args)
        (if (null? args)
            #t
            (let-values ([(obj type) (send (car args) get-obj)])
              (cond
                ((or
                  (cifra? obj)
                  (signo? obj)
                  (char? obj))
                 (all-signos? (cdr args)) )
                (else #f)
                ))
            )
        ))
    (define all-letras?
      (lambda (args)
        (if (null? args)
            #t
            (let-values ([(obj type) (send (car args) get-obj)])
              (cond
                ((or
                  (signo? obj)
                  (char? obj))
                 (all-letras? (cdr args)) )
                (else #f)
                ))
            )
        ))
    (define elemental+empty?
      (lambda (args)
        (if (and
             (is-a? (first args) obj-elemental%)
             (is-a? (second args) obj-elemental%))
            (let-values ([(obj2 type2) (send (second args) get-obj)]
                         )
              (equal? type2 lista-vacia?)
              )
            #f) ))
    (define all-obj
      (lambda (lst-obj)
        (if (null? lst-obj)
            '()
            (let-values ([(obj type) (send (car lst-obj) get-obj)])
              (cons obj
                    (all-obj (cdr lst-obj))))
            ) ))
;;un literal exige la presencia de una cifra
    (define composibles?
      (lambda (arg)
        (cond
          ((elemental+empty? arg)
           (let-values ([(obj1 type1) (send (first arg) get-obj)]
                        [(obj2 type2) (send (second arg) get-obj)]
                        )
             (set! obj (cons obj1 obj2))
             (set! tipo? lista?) ) )
          ((all-cifras? arg) 
           (set! obj (make-numero (all-obj arg)))
           (set! tipo? natural?) )
          ((all-letras? arg)
           (set! obj (make-palabra (all-obj arg)))
           (set! tipo? palabra?) )
          ((all-signos? arg)
           (set! obj (make-literal (all-obj arg)))
           (set! tipo? literal?) )
          (else (printf "~a tiene algo extraño" arg))
          ) ))
    (define/public composicion!
      (lambda args
        (composibles? args)
        ))
    (define/public muestra!
      (lambda (proc-write)
        (proc-write obj)))
    (define/public get-obj
      (lambda ()
        (values obj tipo?)
        ))
    (super-new)
    ))
;;;;;;Manejo de matrices
;;;;;;;;;;;;;;;;;;;;; Matrices
;matriz = vector de (* filas columnas) + 1 (= nº columnas) de elementos
;;Hay que hacer que las filas sean vectores con elementos distintos. De ahí gensym
(define make-matriz
  (lambda (filas columnas vacio)
    (letrec
        ((haz-matriz
          (lambda (filas columnas i)
            (if (= i filas)
                '()
                (cons
                 (list->vector (haz-fila columnas 0))
                 (haz-matriz filas columnas (add1 i)))
                ) ))
         (haz-fila
          (lambda (columnas i)
            (if (= i columnas)
                '()
                (cons
                 vacio;(gensym)
                 (haz-fila columnas (add1 i)))
                ) ))
         )
      (list->vector (haz-matriz filas columnas 0))
      ) ))
(define matriz-ref
  (lambda (nombre fila columna)
    (let ((row (vector-ref nombre fila))
          )
      (vector-ref row columna)) ))
(define matriz-set!
  (lambda (nombre fila columna new)
    (let* ((row (vector-ref nombre fila))
           (new-row (vector-set! row columna new))
           )
      nombre
      ) ))
;;;
(define set-objetos-matriz!
  (lambda (matriz objetos filas columnas)
    (if (null? objetos)
        matriz
        (let salta ((fila (random filas))
                    (col (random columnas))
                    )
          (let ((pos (matriz-ref matriz fila col)))
            (if (is-a? pos vacio%)
                (begin
                  (matriz-set! matriz fila col (car objetos))
                  (set-objetos-matriz! matriz (cdr objetos) filas columnas)
                  )
                (salta (random filas) (random columnas))
                )))
        ) ))


;;;;;;;;;;;;;;;;;;;;EL MUNDO
(define mundo%
  (class object%
    (field
     (filas 20)
     (columnas 20)
     (objetos '())
     (matriz-de-objetos '())
     )
    (define/public set-objetos
      (lambda cosas
        (set! objetos (append objetos cosas))
        (set! matriz-de-objetos
              (set-objetos-matriz! 
               (make-matriz 20 20 
                            (make-object vacio%)) 
               objetos 20 20))
        ))
    (define/public set-obj!
      (lambda (f c obj)
        (matriz-set! matriz-de-objetos f c obj)
        ))
    (define/public get-objetos;;
      (lambda ()
        objetos))
    (define/public get-matriz_uno
      (lambda (f c)
        (matriz-ref matriz-de-objetos f c)
        ))
    (define/public get-matriz;;
      (lambda ()
        matriz-de-objetos))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;EL AGENTE
;;;La vecindad de un agente. Lo que puede ver.
(define vecino-coord-n
  (lambda (fila columna n_orden_vec)
    (case n_orden_vec
      ((1) (values (- fila 1) (sub1 columna)))
      ((2) (values (- fila 1) columna))
      ((3) (values (- fila 1) (add1 columna)))
      (else "vecino-coord error")
      ) ))
(define vecino-coord-s
  (lambda (fila columna n_orden_vec)
    (case n_orden_vec
      ((1) (values (+ fila 1) (add1 columna)))
      ((2) (values (+ fila 1) columna))
      ((3) (values (+ fila 1) (sub1 columna)))
      (else "vecino-coord error")
      ) ))
(define vecino-coord-e
  (lambda (fila columna n_orden_vec)
    (case n_orden_vec
      ((1) (values (- fila 1) (+ columna 1)))
      ((2) (values fila (+ columna 1)))
      ((3) (values (+ fila 1) (+ columna 1)))
      (else "vecino-coord error")
      ) ))
(define vecino-coord-o
  (lambda (fila columna n_orden_vec)
    (case n_orden_vec
      ((1) (values (+ fila 1) (- columna 1)))
      ((2) (values fila (- columna 1)))
      ((3) (values (- fila 1) (- columna 1)))
      (else "vecino-coord error")
      ) ))

(define vecindad
  (lambda (fila columna direccion)
    (let ((proc #f))
      (cond
        ((eq? direccion 'n) (set! proc vecino-coord-n))
        ((eq? direccion 's) (set! proc vecino-coord-s))
        ((eq? direccion 'e) (set! proc vecino-coord-e))
        ((eq? direccion 'o) (set! proc vecino-coord-o)))
      (let-values ([(x_v1 y_v1) (proc fila columna 1)]
                   [(x_v2 y_v2) (proc fila columna 2)]
                   [(x_v3 y_v3) (proc  fila columna 3)])
        (let salta ((lst (list
                          (cons x_v1 y_v1)
                          (cons x_v2 y_v2)
                          (cons x_v3 y_v3)))
                    (resp '())
                    )
          (if (null? lst)
              (reverse resp)
              (if (and (>= (caar lst) 0)
                       (< (caar lst) 20)
                       (>= (cdar lst) 0)
                       (< (cdar lst) 20))
                  (salta (cdr lst) (cons (car lst) resp))
                  (salta (cdr lst) (cons #f resp))))
          ))
    ) ))

;;;;;;;;;;;;;;;;;;;;;
(define-struct mem_sensible
  (
   vista
   (tacto #:mutable)
   (in #:mutable);en la extensión especie última
;   fecha
   )
  #:transparent)
;; La idea es: como la vista da una representación externa, usarla como clave de acceso, mientras que el tacto es usado como información.
;; En el caso de objeto visto y no tocados, se apuntarán sin esa información.
(define-struct mem_universal 
  (
   representacion
   (superior #:mutable)
   (inferior #:mutable)
   (ext #:mutable)
   )
  #:transparent)
;;;;;;;;;;;;;;;;;;;;;
;;; El sistema denominado "agente"
(define agente%
  (class object%
    (field
     (x 0);coordenada x de situs
     (y 0);coordenada y de situs
     (direccion 'n);n(orte),o(este),s(ur),e(ste) 
     (vision (make-object vision%))
     (tacto (make-object tacto%))
     (memoria (make-object memoria%))
     (empeiria (make-object experiencia%))
     (pensamiento-particiones (make-object operacion-particiones%))
     (rec-formas '())
     (teoria '())
     (creencias (make-object creencias%))
     (motor (make-object movimiento%))
     )

    (define/public draw
      (lambda (dc)
        (draw-agente dc x y 30 direccion)
        ))
    
    (define/public set-dir
      (lambda (dir)
        (set! direccion dir) ))
    (define/public set-situs
      (lambda (a b)
        (set! x a)
        (set! y b) ))
    (define/public get-situacion
      (lambda ()
        (values x y direccion)
        ))
    
    (define percepcion
      (lambda (vision tacto)
        (let* ((v1 (first vision))
               (v2 (second vision))
               (v3 (third vision))
               (sentir_1 #f)
               (sentir_2 #f)
               (sentir_3 #f)
               )
          (unless (or 
                   (eq? (car tacto) 'sin_tacto) 
                   (eq? (car tacto) 'fuera_campo))
            (set! sentir_2
                  (list 
                   (car v2) 
                   (car tacto) 
                   (list (cdr tacto) (cdr v2)))) )
          (unless (or 
                   (eq? (car v1) 'vacio) 
                   (eq? (car v1) 'fuera_campo))
            (set! sentir_1
                  (list 
                   (car v1) 
                   'sin_tacto 
                   (list (cdr v1)))) )
          (unless (or 
                   (eq? (car v3) 'vacio) 
                   (eq? (car v3) 'fuera_campo))
            (set! sentir_3
                  (list 
                   (car v3) 
                   'sin_tacto 
                   (list (cdr v3)))) )
          (list sentir_1 sentir_2 sentir_3)
          )
        ))
    
    (define/public sensacion
      (lambda (mundo)
        (send memoria set-memoria!
              (percepcion
               (send vision vista mundo x y direccion)
               (send tacto contacto mundo x y direccion)))
        ))
    (define/public experiencia
      (lambda ()
        (let* ((mem (send memoria get-memoria))
               (m_cp (send empeiria extraccion-aspectos mem))
               (formas 
                (send empeiria universales->memoria m_cp mem))
               )
          (send memoria set-memoria! formas)
          )
        ))

    (define/public set-creencias
      (lambda ()
        (send memoria upgrade-creencias
              (send creencias son-creencias))
        ))
    (define/public get-creencias
      (lambda ()
        (let go ((mem (send memoria get-memoria))
                 (i 0)
                 (j (hash-count (send memoria get-memoria)))
                 )
          (if (= i j)
              #f
              (if (hash? (hash-ref mem i))
                  (hash-ref mem i)
                  (go mem (add1 i) j)
                  )
              )
          )
        ))
    
    (define/public hacer-particiones
      (lambda ()
        (let ((new-uni
               (send pensamiento-particiones oper-particiones)))
          (send memoria set-memoria! new-uni)
          (send pensamiento-particiones modifica-uni)
          )
        ))
    
    (define print-mem_sensible
      (lambda (reg i)
        (printf "~a lo visto: ~a lo tocado: ~a formas: ~a~n"
                i
                (mem_sensible-vista reg)
                (mem_sensible-tacto reg)
                (mem_sensible-in reg))
        ))
    (define print-mem_universal
      (lambda (reg i)
        (printf "~a la idea: ~a del género: ~a con especies: ~a y extensión: ~a~n"
                i
                (mem_universal-representacion reg)
                (mem_universal-superior reg)
                (mem_universal-inferior reg)
                (mem_universal-ext reg))
        ))
    
    (define print-creencia
      (lambda (reg i h)
        (printf "~a.~a existe ~a razón: ~a vinculada con: ~a y con: ~a~n"
                i h
                (nodo-id reg)
                (nodo-caracteristicas reg)
                (nodo-concepto-superior reg)
                (nodo-concepto-inferior reg))
        ))
    (define/public informe
      (lambda ()
        (let ((mem (send memoria get-memoria)))
          (let salta ((i 0)
                      (j (hash-count mem))
                      )
            (if (= i j)
                'done
                (cond
                  ((mem_sensible? (hash-ref mem i))
                   (print-mem_sensible (hash-ref mem i) i) 
                   (salta (add1 i) j) )
                  ((mem_universal? (hash-ref mem i))
                   (print-mem_universal (hash-ref mem i) i)
                   (salta (add1 i) j) )
                  ((hash? (hash-ref mem i))
                   (let go ((h 0)
                            (k (hash-count (hash-ref mem i)))
                            )
                     (if (= h k)
                         (salta (add1 i) j)
                         (begin
                           (print-creencia (hash-ref (hash-ref mem i) h) i h)
                           (go (add1 h) k))
                         )
                     ) )
                  (else (printf "~a~n" (hash-ref mem i))
                        (salta (add1 i) j))
                  )
                )
            )
          )
        ))
    (define/public get-memoria
      (lambda ()
        (send memoria get-memoria)))
    
    (define/public dinamismo
      (lambda ()
        (let* ((mundo m)
               (perceptos
                (percepcion
                 (send vision vista mundo x y direccion)
                 (send tacto contacto mundo x y direccion)))
               )
          (send memoria set-memoria! perceptos)
          (send motor mueve perceptos)
          (draw-agente dc x y 30 direccion)
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;LOS MÓDULOS
(define vision%
  (class object%
    (field
     (vision_1 '())
     (vision_2 '())
     (vision_3 '())
     )
    (define reconocimiento-formas
      (lambda (objectum)
        (cond
          ((number? objectum)
           (cons objectum number?))
          ((symbol? objectum)
           (cons objectum symbol?))
          ((list? objectum)
           (cons objectum list?))
          (else 
           (cons (if objectum objectum 'vacio) empty))
          )
        ))
    (define procesar-singular
      (lambda (obj)
        (let-values ([(item type) (send obj get-obj)])
          (cond
            ;objetos de la clase obj-elemental%
            ((equal? type lista-vacia?) #f)
            ((equal? type cifra?) item)
            ((equal? type char?) (string->symbol (string item)))
            ((equal? type signo?) item)
            ;objetos de la clase obj-compuesto%
            ((equal? type natural?) item)
            ((equal? type literal?) item)
            ((equal? type palabra?) (string->symbol item))
            ((equal? type lista?) item)
            ;objetos de la clase vacio%
            ((equal? type vacio?) #f)
            (else 
             (printf "rareza en vision ~a ~a ~n" item type))
            )) ))
    (define/public vista
      (lambda (mundo x y d)
        (let* ((campo-vision (vecindad x y d))
               (v_1 (first campo-vision))
               (v_2 (second campo-vision))
               (v_3 (third campo-vision))
               )
          (if v_1
              (set! vision_1
                    (reconocimiento-formas
                     (procesar-singular
                      (send mundo 
                            get-matriz_uno (car v_1) (cdr v_1)))))
              (set! vision_1 (cons 'fuera_campo empty)))
          (if v_2
              (set! vision_2
                    (reconocimiento-formas
                     (procesar-singular
                      (send mundo 
                            get-matriz_uno (car v_2) (cdr v_2)))))
              (set! vision_2 (cons 'fuera_campo empty)))
          (if v_3
              (set! vision_3
                    (reconocimiento-formas
                     (procesar-singular
                      (send mundo 
                            get-matriz_uno (car v_3) (cdr v_3)))))
              (set! vision_3 (cons 'fuera_campo empty)))
          (list vision_1 vision_2 vision_3)
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
(define tacto%
  (class object%
    (field
     (tocar '())
     )
    (define compuesto?
      (lambda (obj)
        (is-a? obj obj-compuesto%)
        ))
    (define elemental?
      (lambda (obj)
        (is-a? obj obj-elemental%)
        ))

    (define reconocimiento-formas
      (lambda (objectum)
        (cond
          ((and
            (not (eq? objectum 'sin_tacto))
            (> objectum 1))
           (cons objectum compuesto?))
          ((and
            (not (eq? objectum 'sin_tacto))
            (= objectum 1))
           (cons objectum elemental?))
          (else (cons objectum empty))
          )
        ))

    (define preprocesar-singular
      (lambda (obj)
        (let-values ([(item type) (send obj get-obj)])
          (cond
            ;objetos de la clase obj-elemental%
            ((equal? type lista-vacia?) 'vacio)
            ((equal? type cifra?) item)
            ((equal? type char?) (string->symbol (string item)))
            ((equal? type signo?) item)
            ;objetos de la clase obj-compuesto%
            ((equal? type natural?) item)
            ((equal? type literal?) item)
            ((equal? type palabra?) (string->symbol item))
            ((equal? type lista?) item)
            ;objetos de la clase vacio%
            ((equal? type vacio?) 'vacio)
            (else 
             (printf "rareza en vision ~a ~a ~n" item type))
            )) ))
    (define procesar-singular
      (lambda (item)
        (cond
          ((equal? item 'vacio) 'sin_tacto)
          ((list? item) (length item))
          ((number? item) (string-length (number->string item)))
          ((symbol? item) (string-length (symbol->string item)))
          (else "raro procesamiento-formas%") 
          )
        ))
    (define/public contacto
      (lambda (mundo x y d)
        (let* ((campo-tactil (vecindad x y d))
               (v_2 (second campo-tactil))
               (obj_tocado #f)
               )
          (set! tocar 
                (cond
                  (v_2
                   (set! obj_tocado
                         (send mundo get-matriz_uno (car v_2) (cdr v_2)))
                   (reconocimiento-formas
                    (procesar-singular 
                     (preprocesar-singular obj_tocado))))
                   (else (cons 'fuera_campo empty))
                   ))
          tocar
          ) ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
(define memoria%
  (class object%
    (field
     (memoria (make-hash))
     ;;clave numerica . información = estructura
     )
    (define listas=?
      (lambda (l1 l2)
        (andmap
         (lambda (item)
           (member item l2))
         l1)
        ))
    (define mas-long
      (lambda (l1 l2)
        (cond
          ((> (length l1) (length l2)) l1)
          ((> (length l2) (length l1)) l2)
          (else l2))
        ))
;;;;;;;;    
    (define upgrade-mem_uni
      (lambda (reg hash)
        (let ((repr (mem_universal-representacion reg))
              (sup (mem_universal-superior reg))
              (inf (mem_universal-inferior reg))
              (ext (mem_universal-ext reg))
              )
          (let salta ((i 0)
                      (j (hash-count hash))
                      )
            (if (= i j)
                (begin
                  (hash-set! hash i reg)
                  hash
                  )
                (let* ((mem (hash-ref hash i))
                       )
                  (if (mem_universal? mem)
                      (let ((mem_r (mem_universal-representacion mem))
                            (mem_s (mem_universal-superior mem))
                            (mem_i (mem_universal-inferior mem))
                            (mem_e (mem_universal-ext mem))
                            )
                        (if (equal? repr mem_r)
                            (hash-set!
                             hash i
                             (make-mem_universal
                              repr
                              (matcher sup mem_s)
                              (matcher inf mem_i)
                              (matcher ext mem_e)
                              ))
                            (salta (add1 i) j)
                            )
                        )
                      (salta (add1 i) j)
                      )
                  )
                )
            )
          )
        ))
    (define matcher
      (lambda (lst1 lst2)
        (append
         (filter-map
          (lambda (item)
            (if (member item lst2)
                #f
                item))
          lst1)
         lst2)
        ))
;;;;;;;;    
    (define upgrade-mem
      (lambda (reg hash)
        (let ((item (apply make-mem_sensible reg)));;;;;FALLA aquí
          (if (= (hash-count hash) 0)
              (hash-set! hash 0 item)
              (let salta ((i 0)
                          (j (hash-count hash))
                          )
                (if (= i j)
                    (begin
                      (hash-set! hash i item)
                      hash
                      )
                    (if (mem_sensible? (hash-ref hash i))
                        (let* ((mem (hash-ref hash i))
                               (vista-mem (mem_sensible-vista mem))
                               (tacto-mem (mem_sensible-tacto mem))
                               (in-mem (mem_sensible-in mem))
                               )
                          (if (equal? vista-mem (first reg))
                              (if (eq? tacto-mem 'sin_tacto)
                                  (hash-set! hash i item)
                                  (if (listas=? (third reg) in-mem)
                                      #t;;
                                      (hash-set! 
                                       hash i 
                                       (make-mem_sensible ;list
                                        vista-mem
                                        tacto-mem
                                        (mas-long (third reg) in-mem)));;
                                      )
                                  )
                              (salta (add1 i) j)
                              )
                          )
                        (salta (add1 i) j)
                        )
                    )
                )
              )
          )
        ))

    (define/public set-memoria!
      (lambda (lista)
          (if (null? lista)
              #t
              (begin
                (when (first lista)
                  (cond
                    ((mem_universal? (first lista)) 
                     (upgrade-mem_uni (first lista) memoria))
                    (else (upgrade-mem (first lista) memoria))
                    )
                  )
                (set-memoria! (cdr lista))
                )
              )
        ))
    (define/public upgrade-creencias
      (lambda (sistema)
        (let salta ((i 0)
                    (j (hash-count memoria))
                    )
          (if (= i j)
              (hash-set! memoria i sistema)
              (if (hash? (hash-ref memoria i))
                  (hash-set! memoria i sistema)
                  (salta (add1 i) j)
                  )
              )
          )
        ))
    (define/public get-memoria
      (lambda ()
        memoria))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
(define experiencia%
  (class object%
    (field
     (memoria_cp '())
     )
    (define/public extraccion-aspectos
      (lambda (memoria)
(set! memoria_cp '())
        (let salta
          ((i 0)
           (j (hash-count memoria))
           )
          (if (= i j)
              memoria_cp
              (let ((registro (hash-ref memoria i))
                    )
                (if (mem_sensible? registro)
                    (begin
                      (aspectos->universales 
                       (mem_sensible-in registro) memoria)
                      (salta (add1 i) j)
                      )
                    (salta (add1 i) j)
                    )
                )
              )
          )
        ))
    (define aspectos->universales
      (lambda (aspectos memoria)
        (if (null? aspectos)
            #t
            (if (assoc (car aspectos) memoria_cp)
                (aspectos->universales (cdr aspectos) memoria)
                (begin
                  (set! memoria_cp
                        (cons
                         (aspecto->universal (car aspectos) memoria)
                         memoria_cp))
                  (aspectos->universales (cdr aspectos) memoria)
                  )
                )
            )
        ))
    (define aspecto->universal
      (lambda (aspecto hash-mem)
       (let salta
         ((i 0)
          (j (hash-count hash-mem))
          (ext '())
          )
         (if (= i j)
             (list aspecto empty empty ext)
             (let ((registro (hash-ref hash-mem i))
                   )
               (if (mem_sensible? registro)
                   (begin
                     (when 
                         (member aspecto (mem_sensible-in registro))
                       (set! ext (cons i ext)))
                     (salta (add1 i) j ext)
                     )
                   (salta (add1 i) j ext)
                   )
               )
             )
         )
       ))
    (define set-universal
      (lambda (universal rest-mem)
        (if (null? rest-mem)
            universal
            (if (equal? (first universal) (first (car rest-mem)))
                (begin
                  (set! universal
                        (list
                         (first universal)
                         (second universal)
                         (third universal)
                         (mezcla (fourth universal) (fourth (car rest-mem)))))
                  (set-universal universal (cdr rest-mem))
                  )
                (set-universal universal (cdr rest-mem))
                )
            )
        ))
    (define set-universales
      (lambda (mem_cp copia-mem_cp)
        (if (null? mem_cp)
            '()
            (cons
             (set-universal (car mem_cp) copia-mem_cp)
             (set-universales (cdr mem_cp) copia-mem_cp))
            )
        ))
    (define mezcla
      (lambda (l1 l2)
        (if (null? l1)
            l2
            (if (member (car l1) l2)
                (mezcla (cdr l1) l2)
                (mezcla (cdr l1) (cons (car l1) l2))
                )
            )
        ))
    (define equal-forma?
      (lambda (registro forma)
        (if 
         (equal? (mem_universal-representacion registro) (first forma));forma);
         (andmap
          (lambda (item)
            (member item (fourth forma)))
          (mem_universal-ext registro))
         #f)
        ))
(define/public universales->memoria
  (lambda (formas memoria)
    (if (null? formas)
        '()
        (let salta
          ((i 0)
           (j (hash-count memoria))
           )
          (if (= i j)
              (cons
               (apply make-mem_universal (car formas))
               (universales->memoria (cdr formas) memoria))
              
              (if (mem_universal? (hash-ref memoria i))
                  (if 
                   (equal-forma?
                    (hash-ref memoria i)
                    (car formas)); ojo!! la extensión(first (car formas))
                   (salta (add1 i) j)
                   (begin
                     (cons
                      (apply make-mem_universal (car formas))
                      (universales->memoria (cdr formas) memoria))
                     )
                   )
                  (salta (add1 i) j)
                  )
              )
          )
        )
    ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
;;SISTEMA DE CREENCIAS
(define-struct nodo
  (;field
   id
   (caracteristicas #:mutable)
   (concepto-superior #:mutable)
   (concepto-inferior #:mutable)
   )
  #:transparent
  )
;;;EL MÓDULO
(define creencias%
  (class object%
    (field
     (sistema (make-hash))
     )
    (define porque-existe
      (lambda (indice-hash hash)
        (mem_sensible-vista (hash-ref hash indice-hash))
        ))
    (define porque-existen
      (lambda (lista-indices hash)
        (if (null? lista-indices)
            '()
            (cons
             (porque-existe (car lista-indices) hash)
             (porque-existen (cdr lista-indices) hash))
            )
        ))
    (define extrae-creencias
      (lambda (hash)
        (let salta ((i 0)
                    (j (hash-count hash))
                    (individuos '())
                    (formas '())
                    )
          (if (= i j)
              (append
               (reverse individuos)
               (reverse formas))
              (cond
                ((mem_sensible? (hash-ref hash i))
                 (let* ((vista (mem_sensible-vista (hash-ref hash i)))
                        (tacto (mem_sensible-tacto (hash-ref hash i)))
                        (in (mem_sensible-in (hash-ref hash i)))
                        (de-tacto (cons "de tamaño" tacto))
                        (reg (make-nodo vista de-tacto in empty))
                        )
                   (salta (add1 i) j (cons reg individuos) formas)
                   ) )
                ((mem_universal? (hash-ref hash i))
                 (let* ((repr (mem_universal-representacion (hash-ref hash i)))
                        (sup (mem_universal-superior (hash-ref hash i)))
                        (inf (mem_universal-inferior (hash-ref hash i)))
                        (ext (mem_universal-ext (hash-ref hash i)))
                        (razon (cons "porque existen" (porque-existen ext hash)))
                        (idea (make-nodo repr razon sup ext))
                        )
                   (salta (add1 i) j individuos (cons idea formas))
                   ) )
                (else
                 (salta (add1 i) j individuos formas) )
                )
              )
          )
        ))
    (define creencias
      (lambda (lista-nodos i)
        (if (null? lista-nodos)
            'done
            (begin
              (hash-set! sistema i (car lista-nodos))
              (creencias (cdr lista-nodos) (add1 i)))
            )
        ))
    (define set-links
      (lambda (sistema)
        (let salta ((i 0)
                    (j (hash-count sistema))
                    )
          (if (= i j)
              'done
              (cond
                ((null? (nodo-concepto-inferior (hash-ref sistema i)))
                 (es-un (hash-ref sistema i) sistema)
                 (salta (add1 i) j) )
                (else
                 (ext-de (hash-ref sistema i) i sistema)
                 (salta (add1 i) j) )
                )
              )
          )
        ))
    (define ext-de
      (lambda (nodo-forma indice-nodo sistema)
        (let salta ((i 0)
                    (j (hash-count sistema))
                    (new '())
                    )
          (if (= i j)
              (set-nodo-concepto-inferior! nodo-forma (reverse new))
              (if (member indice-nodo (nodo-concepto-superior (hash-ref sistema i)))
                  (salta (add1 i) j (cons i new))
                  (salta (add1 i) j new)
                  )
              )
          )
        ))
    (define es-un
      (lambda (nodo-individuo sistema)
        (let* ((id (nodo-id nodo-individuo))
               (caracteristicas (nodo-caracteristicas nodo-individuo))
               (sup (nodo-concepto-superior nodo-individuo))
               (inf (nodo-concepto-inferior nodo-individuo))
               )
          (let salta ((i 0)
                      (j (hash-count sistema))
                      (new '())
                      )
            (if (= i j)
                (set-nodo-concepto-superior! nodo-individuo (reverse new))
                (if (member (nodo-id (hash-ref sistema i)) sup)
                    (salta (add1 i) j (cons i new))
                    (salta (add1 i) j new))
                )
            )
          )
        ))
    (define/public son-creencias
      (lambda ()
        (creencias (extrae-creencias (send agente get-memoria)) 0);agente/memoria
        (set-links sistema)
        sistema))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;;;;
(define operacion-particiones%
  (class object%
    (field
     (mem_cp #f)
     (dom '())
     (universales '())
     (combinaciones '())
     (particiones '())
     )
    (define combinar
      (lambda (lista)
        (letrec
            ((son-combinaciones
              (lambda (lista)
                (let salta ((lst lista)
                            (resp '())
                            )
                  (if (null? lst)
                      (reverse (remove-duplicates resp))
                      (let go ((item (first lst))
                               (ls lista)
                               )
                        (if (null? ls)
                            (salta (cdr lst) (cons item resp))
                            (cond
                              ((compara-dos (car lst) (car ls))
                               (go (reverse(car ls)) (cdr ls))
                               )
                              (else
                               (go item (cdr ls)) )
                              )
                            )
                        )
                      )
                  )
                ))
             (compara-dos
              (lambda (uno dos)
                (letrec
                    ((aux
                      (lambda (uno dos)
                        (if (null? uno)
                            #t
                            (and
                             (if (member (car uno) dos)
                                 #t
                                 #f
                                 )
                             (aux (cdr uno) dos)
                             )
                            )
                        ))
                     )
                  (if (= (length uno) (length dos))
                      (aux uno dos)
                      #f)
                  )
                ))
             (asignando
              (lambda (lista)
                (let ((genera-asig
                       (lambda (lista-subcombi)
                         (append-map 
                          (lambda (subcombi)
                            (map
                             (lambda (val-verdad)
                               (if (list? subcombi)
                                   (append subcombi (list val-verdad))
                                   (list subcombi val-verdad))) 
                             lista))
                          lista-subcombi) ))
                      )
                  (let go ((x (sub1 (length lista)))
                           (temp lista))
                    (cond
                      ((= x 0) temp)
                      (else
                       (go (sub1 x) (genera-asig temp))))
                    ) 
                  )
                ))
             (combi
              (lambda (lista)
                (if (null? lista)
                    '()
                    (cons
                     (remove-duplicates (car lista))
                     (combi (cdr lista))
                     )
                    )
                ))
             (aux
              (lambda (lista)
                (if (null? lista)
                    '()
                    (if (= (length (car lista)) 1)
                        (aux (cdr lista))
                        (cons (car lista)
                              (aux (cdr lista)))
                        )
                    )
                ))
             (para-combinar
              (lambda (lista)
                (let ((lst (remove-duplicates
                            (sort 
                             (aux 
                              (combi (asignando lista)))
                             (lambda (a b) (< (length a) (length b))))) )
                      )
                  lst
                  )
                ))
             )
          (son-combinaciones
           (para-combinar lista))
          )
        ))
    (define dominio
      (lambda (hash)
        (let salta ((i 0)
                    (j (hash-count hash))
                    (u_d '())
                    )
          (if (= i j)
              u_d
              (if (mem_sensible? (hash-ref hash i))
                  (salta (add1 i) j (cons i u_d))
                  (salta (add1 i) j u_d)
                  )
              )
          )
        ))
    (define son-universales
      (lambda (hash)
        (let salta ((i 0)
                    (j (hash-count hash))
                    (reg-uni '())
                    )
          (if (= i j)
              reg-uni
              (if (mem_universal? (hash-ref hash i))
                  (salta (add1 i) j (cons (hash-ref hash i) reg-uni))
                  (salta (add1 i) j reg-uni)
                  )
              )
          )
        ))

    (define union-ext
      (lambda (universales-reg)
        (if (null? universales-reg)
            '()
            (append
             (mem_universal-ext (car universales-reg))
             (union-ext (cdr universales-reg)))
            )
        ))
    
    (define equal-ext?
      (lambda (e1 e2)
        (letrec
            ((aux
              (lambda (ext1 ext2)
                (if (null? ext1)
                    #t
                    (if (member (car ext1) ext2)
                        (aux (cdr ext1) ext2)
                        #f)
                    )
                ))
             )
          (if (= (length e1) (length e2))
              (aux e1 e2)
              #f)
          )
        ))
    
    (define nuevo-universal
      (lambda (combi)
        (let salta ((lst combi)
                    (repr '())
                    (inf '())
                    )
          (if (null? lst)
              (values (genero repr) '() inf dom)
              (salta
               (cdr lst)
               (cons (mem_universal-representacion (car lst)) repr)
               (cons 
                (make-universal 
                 (mem_universal-representacion (car lst)) 
                 mem_cp) inf)
;                 (send agente get-memoria)) inf)
               )
              )
          )
        ))
    (define make-universal
      (lambda (inferior hash)
        (let salta ((i 0)
                    (j (hash-count hash))
                    )
          (if (= i j)
              'fallo
              (if (mem_universal? (hash-ref hash i))
                  (if (equal? (mem_universal-representacion (hash-ref hash i))
                              inferior)
                      i
                      (salta (add1 i) j)
                      )
                  (salta (add1 i) j)
                  )
              )
          )
        ))
    (define-syntax genero
      (syntax-rules ()
        [(genero arg ...)
         (lambda (a)
           (ormap
            (lambda (pred)
              (pred a))
            (list arg ...)) )
         ]
        ))
    
    (define print-particiones
      (lambda (combi)
        (if (null? combi)
            (newline)
            (begin
              (printf "~a " (mem_universal-representacion (car combi)))
              (print-particiones (cdr combi))
              )
            )
        ))
    (define son-particiones
      (lambda (combinaciones)
        (if (null? combinaciones)
            '()
            (cond
              ((equal-ext? dom (union-ext (car combinaciones)))
;               (print-particiones (car combinaciones))
               (let-values 
                   ([(repr sup inf ext) (nuevo-universal (car combinaciones))])
                 (cons
                  (make-mem_universal repr sup inf ext)
                  (son-particiones (cdr combinaciones)))
                 ) )
              ((equal-ext? 
                (mem_universal-ext (first (car combinaciones))) 
                (rest (car combinaciones)))
               (print-particiones (car combinaciones))
               (son-particiones (cdr combinaciones)) )
              (else (son-particiones (cdr combinaciones)) )
              )
            )
        ))
    (define/public oper-particiones
      (lambda ()
        (set! mem_cp (send agente get-memoria))
        (set! dom (dominio mem_cp))
        (set! universales (son-universales mem_cp))
        (set! combinaciones (combinar universales))
        (set! particiones (son-particiones combinaciones))
        particiones
        ))
    (define indices-generos
      (lambda (generos hash)
        (let salta ((i 0)
                    (j (hash-count hash))
                    (resp '())
                    )
          (if (= i j)
              resp
              (if (mem_universal? (hash-ref hash i))
                  (if (member (hash-ref hash i) generos)
                      (salta 
                       (add1 i) 
                       j
                       (append
                        (append-map
                         (lambda (genus)
                           (if 
                            (equal? (mem_universal-representacion genus)
                                    (mem_universal-representacion (hash-ref hash i)))
                            (list (cons i genus))
                            '()) )
                         generos)
                        resp))
                      (salta (add1 i) j resp)
                      )
                  (salta (add1 i) j resp)
                  )
              )
          )
        ))
    (define upgrade-uni
      (lambda (indices_generos hash)
        (if (null? indices_generos)
            #t
            (begin
              (upgrade-especies 
               (mem_universal-inferior (cdar indices_generos))
               (caar indices_generos)
               hash)
              (upgrade-uni (cdr indices_generos) hash)
              )
            )
        ))
    (define upgrade-especies
      (lambda (indices genus-indice hash)
        (if (null? indices)
            #t
            (begin
              (set-mem_universal-superior! 
               (hash-ref hash (car indices)) 
               (list genus-indice))
              (upgrade-especies (cdr indices) genus-indice hash)
              )
            )
        ))
    (define/public modifica-uni
      (lambda ()
        (set! mem_cp (send agente get-memoria))
        (let ((index (indices-generos particiones mem_cp))
              )
          (upgrade-uni index mem_cp)
          )
        ))
    (super-new)
    ))
;;;;;;;;;;;;;;;;;;;;;
(define movimiento%
  (class object%
    (field
     (giro 'dcha)
     )
    (define reglas-movimiento
      (lambda (percepcion)
        (let*-values ([(x y dir) (send agente get-situacion)]
                      [(perceptos) percepcion]
                      [(v_1) (first perceptos)]
                      [(v_2) (second perceptos)]
                      [(v_3) (third perceptos)]
                      [(coord-vec) (vecindad x y dir)]
                      [(coord_v1) (first coord-vec)]
                      [(coord_v2) (second coord-vec)]
                      [(coord_v3) (third coord-vec)]
                      )
          (printf "situado en: ~a ~a con orientación: ~a~n" x y dir)
          (printf "perceptos: ~a ~n" perceptos)
          
          (cond
            ((and ;;Avanza
              (not v_2);enfrente está vacío 
              coord_v2);coordenadas dentro de rango
             (avanza (car coord_v2) (cdr coord_v2) dir) )
            ((and
              (not v_1)
              coord_v1
              (not v_3)
              coord_v3)
             (values x y 
                     (if (< (random 10) 5)
                       (begin
                         (set! giro 'izqda)
                         (gira-izqda dir)
                         )
                       (begin
                         (set! giro 'dcha)
                         (gira-dcha dir))) )
             )
            ((and
              (not v_1)
              coord_v1)
             (set! giro 'izqda)
             (values x y (gira-izqda dir)) )
            ((and
              (not v_3)
              coord_v3)
             (set! giro 'dcha)
             (values x y (gira-dcha dir))
             )
            ((and;v1 está vacío y v3 fuera de rango
              (not v_1)
              coord_v1
              (not coord_v3))
             (set! giro 'izqda)
             (values x y (gira-izqda dir)) )            
            ((and;v3 está vacío y v1 fuera de rango
              (not v_3)
              coord_v3
              (not coord_v1))
             (set! giro 'dcha)
             (values x y (gira-dcha dir)) )            
            ((and
              (not coord_v1)
              (not coord_v2)
              (not coord_v3)
              (and (= x 0) (= y 0))
              )
             (cond
               ((eq? dir 'n)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 's)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               ((eq? dir 'e)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'o)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               )
             )
            ((and
              (not coord_v1)
              (not coord_v2)
              (not coord_v3)
              (and (= x 0) (= y 19))
              )
             (cond
               ((eq? dir 's)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'n)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               ((eq? dir 'e)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'o)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               )
             )
            ((and
              (not coord_v1)
              (not coord_v2)
              (not coord_v3)
              (and (= x 19) (= y 0))
              )
             (cond
               ((eq? dir 'n)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 's)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               ((eq? dir 'o)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'e)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               )
             )
            ((and
              (not coord_v1)
              (not coord_v2)
              (not coord_v3)
              (and (= x 19) (= y 19))
              )
             (cond
               ((eq? dir 's)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'n)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               ((eq? dir 'o)
                (set! giro 'dcha)
                (values x y (gira-dcha dir)))
               ((eq? dir 'e)
                (set! giro 'izqda)
                (values x y (gira-izqda dir)))
               )
             )
            ((and
              (not coord_v1)
              (not coord_v2)
              (not coord_v3))
             (if (< (random 10) 5)
                 (begin
                   (set! giro 'izqda)
                   (values x y (gira-izqda dir)))
                 (begin
                   (set! giro 'dcha)
                   (values x y (gira-dcha dir))) )
             )
            (else ;;Gira
             (values x y 
                     (if (eq? giro 'dcha) 
                         (begin
                           (set! giro 'izqda)
                           (gira-izqda dir) )
                         (begin
                           (set! giro 'dcha)
                           (gira-dcha dir) ))) )
            )
          )
        ))
    (define gira-izqda
      (lambda (dir)
        (cond
          ((eq? dir 'n) (printf "Giro hacia el Oeste~n") 'o)
          ((eq? dir 'o) (printf "Giro hacia el Sur~n") 's)
          ((eq? dir 's) (printf "Giro hacia el Este~n") 'e)
          ((eq? dir 'e) (printf "Giro hacia el Norte~n") 'n)
          ) ))
    (define gira-dcha
      (lambda (dir)
        (cond
          ((eq? dir 'n) (printf "Giro hacia el Este~n") 'e)
          ((eq? dir 'o) (printf "Giro hacia el Norte~n") 'n)
          ((eq? dir 's) (printf "Giro hacia el Oeste~n") 'o)
          ((eq? dir 'e) (printf "Giro hacia el Sur~n") 's)
          ) ))
    (define avanza
      (lambda (x y dir)
        (printf "Avanzo un cuadrado~n")
        (values x y dir)
        ))
    (define/public mueve
      (lambda (percepcion)
        (let-values ([(x y dir) (reglas-movimiento percepcion)]
                     )
          (send agente set-situs x y)
          (send agente set-dir dir)
          )
        ))
    (super-new)
    ))
;;;;;;;;;;PARA HACER DIBUJOS
(define ventana
  (make-object frame% 
    "MUNDO" 
    #f 
    610 665 
    1300 0))

(define lienzo
  (instantiate canvas% 
    (ventana) 
    (style '(border)) ))

(define dc (send lienzo get-dc))
;;;;;;;;;;;
(define grid
  (lambda (dc)
    (letrec
        ((grid-vertical
          (lambda (num x y1 y2 xoffset dc)
            (if (= num 0)
                #t
                (begin
                  (send dc draw-line (* x xoffset) y1 (* x xoffset) y2)
                  (grid-vertical (sub1 num) (add1 x) y1 y2 xoffset dc)
                  )
                ) ))
         (grid-horizontal
          (lambda (num x1 x2 y yoffset dc)
            (if (= num 0)
                #t
                (begin
                  (send dc draw-line x1 (* y yoffset) x2 (* y yoffset))
                  (grid-horizontal (sub1 num) x1 x2 (add1 y) yoffset dc)
                  )
                ) ))
         )
      (grid-vertical 20 1 0 600 30 dc)
      (grid-horizontal 20 0 600 1 30 dc)
      ) ))
;;;;;;;;;
(define draw-agente
  (lambda (dc fila columna offset dir)
    (cond
      ((eq? dir 'n) (linea-agente-n/s dc fila columna offset dir))
      ((eq? dir 's) (linea-agente-n/s dc fila columna offset dir))
      ((eq? dir 'e) (linea-agente-e/o dc fila columna offset dir))
      ((eq? dir 'o) (linea-agente-e/o dc fila columna offset dir))
      )
    (send dc draw-text "AG" (+ (* columna offset) 5) (+ (* fila offset) 5))
    ))
(define linea-agente-n/s
  (lambda (dc x y offset dir)
    (let* ((x1 (+ (* y offset) (/ offset 2)))
           (y1 (+ (* x offset) (- offset 28)))
           (x2 x1)
           (y2 (+ (* x offset) (- offset 2)))
           (x3 (- x1 5))
           (x4 (+ x1 5))
           (y3 (if (eq? dir 'n) (+ y1 5) (- y2 5)))
           (y4 y3)
           )
      (send dc draw-line x1 y1 x2 y2)
      (cond
        ((eq? dir 'n)
         (send dc draw-line x1 y1 x3 y3)
         (send dc draw-line x1 y1 x4 y4))
        (else
         (send dc draw-line x2 y2 x3 y3)
         (send dc draw-line x2 y2 x4 y4))
        )
      )
    ))
(define linea-agente-e/o
  (lambda (dc x y offset dir)
    (let* ((x1 (+ (* y offset) (- offset 28)))
           (y1 (+ (* x offset) (/ offset 2)))
           (x2 (+ (* y offset) (- offset 2)))
           (y2 y1)
           (x3 (if (eq? dir 'o) (+ x1 5) (- x2 5)))
           (x4 x3)
           (y3 (- y1 5))
           (y4 (+ y1 5))
           )
      (send dc draw-line x1 y1 x2 y2)
      (cond
        ((eq? dir 'e)
         (send dc draw-line x2 y2 x3 y3)
         (send dc draw-line x2 y2 x4 y4))
        (else
         (send dc draw-line x1 y1 x3 y3)
         (send dc draw-line x1 y1 x4 y4))
        )
      )
    ))
(define draw-obj-elemental
  (lambda (fila columna obj dc offset)
    (let-values ([(elem type) (send obj get-obj)])
      (send dc draw-text
            (cond
              ((equal? type vacio?) "")
              ((equal? type cifra?) 
               (number->string elem))
              ((equal? type char?) 
               (string 
                (integer->char 35) (integer->char 92) elem))
              ((equal? type signo?) 
               (symbol->string elem))
              ((equal? type lista-vacia?) 
               (string #\( #\)))
              )
            ;(+ (* fila offset) 5) (+ (* columna offset) 5)
             (+ (* columna offset) 5) (+ (* fila offset) 5)
            )
      ) ))

(define draw-obj-compuesto
  (lambda (fila columna obj dc offset)
    (let-values ([(elem type) (send obj get-obj)])
      (send dc draw-text
            (cond
              ((equal? type natural?) 
               (number->string elem))
              ((equal? type palabra?) 
               (string-append 
                (string (integer->char 34))
                elem
                (string (integer->char 34))) )
              ((equal? type literal?) 
               (symbol->string elem))
              ((equal? type lista?) 
               (lista->string elem))
              )
            ;(+ (* fila offset) 5) (+ (* columna offset) 5)
             (+ (* columna offset) 5) (+ (* fila offset) 5)
            )
      ) ))
(define lista->string
  (lambda (lst)
    (letrec
        ((aux1
          (lambda (item)
                 (cond
                   ((number? item)
                    (number->string item))
                   ((symbol? item)
                    (symbol->string item))
                   ((char? item)
                    (let ((sig (string item))
                          (rep (string (integer->char 35) (integer->char 92)))
                          )
                     (string-append rep sig) ))
                   ((string? item)
                    item)
                   )
            ))
         (aux2
          (lambda (lista)
            (if (null? lista)
                ""
                (if (list? (car lista))
                    (string-append
                     "("
                     (aux2 (car lista))
                     ") "
                     (aux2 (cdr lista)))
                    (string-append
                     (aux1 (car lista))
                     (aux2 (cdr lista)))
                    )
                )
            ))
         (str "")
         )
      (set! str (aux2 lst))
;      str
      (string-append
       "("
       (if (= (string-length str) 0) str (substring str 0 (string-length str)))
       ")")
      ) ))
(define draw-mundo
  (lambda (mundo dc)
    (send dc clear)
    (grid dc)
    (let salta ((fila 0)
                (j 20)
                )
      (if (= fila j)
          #t
          (let go ((columna 0)
                   (k 20)
                   )
            (if (= columna k)
                (salta (add1 fila) j)
                (let ((item (send mundo get-matriz_uno fila columna)))
                  (cond
                    ((is-a? item obj-elemental%)
                     (draw-obj-elemental fila columna item dc 30)
                     (go (add1 columna) k))
                    ((is-a? item obj-compuesto%)
                     (draw-obj-compuesto fila columna item dc 30)
                     (go (add1 columna) k))
                    (else 
                     (go (add1 columna) k))
                    )))
            )
          ))
    ))
;;;;;;;;;;;;;;;;;
(define cuenta-objetos
  (lambda (matriz)
    (let salta ((i 0)
                (j 20)
                (n 0)
                )
      (if (= i j)
          n
          (let go ((h 0)
                   (k 20)
                   )
            (if (= h k)
                (salta (add1 i) j n)
                (let ((item (matriz-ref matriz i h)))
                  (cond
                    ((is-a? item obj-elemental%)
                     (set! n (add1 n))
                     (go (add1 h) k))
                    ((is-a? item obj-compuesto%)
                     (set! n (add1 n))
                     (go (add1 h) k))
                    (else 
                     (go (add1 h) k))
                    )))
            )
          ))
    ))
(define inicia-agente
  (lambda ()
    (let go ((x (random 20))
             (y (random 20))
             (obj #f)
             )
      (set! obj (send m get-matriz_uno x y))
      (if (is-a? obj vacio%)
          (send agente set-situs x y)
          (go (random 20) (random 20) obj)
          )
      )
    ))
(define muestra-mundo
  (lambda (mundo dc)
    (printf "~a ~n" (cuenta-objetos (send mundo get-matriz)))
    (let salta ((i 1)
                (j 2);1000)
                )
      (if (= i j)
          (print (send agente get-memoria))
          (begin
            (send dc clear)
            (draw-mundo m dc)
            (inicia-agente)
            (send agente draw dc)
            (let go ((h 0)
                     (k 200)
                     )
              (if (= h k)
                  (salta (add1 i) j)
                  (begin
                    (send agente dinamismo)
                    (sleep/yield 0.5)
                    (go (add1 h) k)
                    )
                  )
              )
            )
          )
      )
;    (printf "~a ~n" (cuenta-objetos (send mundo get-matriz)))
    ))
;;;;;;;;;;;;;;;
(define run-button (instantiate button% ("&Run" ventana)
                     (callback (lambda (b e)
                                 (muestra-mundo m dc)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;LOS DATOS
;;;;;Objetos elementales
(define v1 (make-object obj-elemental%))
(send v1 set-obj! 'a)
(define v2 (make-object obj-elemental%))
(send v2 set-obj! 'e)
(define v3 (make-object obj-elemental%))
(send v3 set-obj! 'i)
(define v4 (make-object obj-elemental%))
(send v4 set-obj! 'o)
(define v5 (make-object obj-elemental%))
(send v5 set-obj! 'u)

(define c1 (make-object obj-elemental%))
(send c1 set-obj! #\a)
(define c2 (make-object obj-elemental%))
(send c2 set-obj! #\e)
(define c3 (make-object obj-elemental%))
(send c3 set-obj! #\i)
(define c4 (make-object obj-elemental%))
(send c4 set-obj! #\o)
(define c5 (make-object obj-elemental%))
(send c5 set-obj! #\u)

(define n1 (make-object obj-elemental%))
(send n1 set-obj! 1)
(define n2 (make-object obj-elemental%))
(send n2 set-obj! 2)
(define n3 (make-object obj-elemental%))
(send n3 set-obj! 3)
(define n4 (make-object obj-elemental%))
(send n4 set-obj! 4)
(define n5 (make-object obj-elemental%))
(send n5 set-obj! 5)

(define l1 (make-object obj-elemental%))
(send l1 set-obj! empty)
(define l2 (make-object obj-elemental%))
(send l2 set-obj! 'b)
(define l3 (make-object obj-elemental%))
(send l3 set-obj! 'c)
(define l4 (make-object obj-elemental%))
(send l4 set-obj! '_)

(define w1 (make-object obj-compuesto%))
(send w1 composicion! v1 l2 l3)
(define w2 (make-object obj-compuesto%))
(send w2 composicion! n1 n3 n5)
(define w3 (make-object obj-compuesto%))
(send w3 composicion! v1 l2 l4 n1)
(define w4 (make-object obj-compuesto%))
(send w4 composicion! c5 l1 l4 n1)
;;;;;El agente
(define agente (make-object agente%))
;;;;;El mundo
(define m (make-object mundo%))
(send m set-objetos 
      v1 v2 v3 v4 v5 c1 c2 c3 c4 c5
      n1 n2 n3 n4 n5 l1 l2 l3 l4 w1 w2 w3 w4); agente)
;;;;
(send ventana show #t)
(sleep/yield 1)



(define oper-mentales
  (lambda ()
    (printf "Estado de la memoria:: ~n")
    (send agente informe)
    (newline)
    (printf "Haciendo experiencias~n")
    (send agente experiencia)
    (printf "Estableciendo el sistema de creencias~n")
    (send agente set-creencias)
    (printf "Haciendo operaciones de relación entre conceptos~n")
    (send agente hacer-particiones)
    (newline)
    (printf "Estado de la memoria:: ~n")
    (send agente informe)
    ))