#lang scheme

;;Una regla
(define-struct regla
  (
   genero
   dif-esp
   especie
   infima
   )
  #:prefab
  )
;;Parámetros
(define-struct parametro
  (
   id
   (valor #:mutable)
   )
  #:transparent
  )
;;Variables de estado
(define gen/spc (make-parametro 'gen/spc 'symbol))
(define meta (make-parametro 'meta #f))
(define historia (make-parametro 'historia empty))
;;Intérprete
(define interprete
  (lambda (bc)
    (let go ((genus (parametro-valor gen/spc))
             (goal (parametro-valor meta))
             (history (parametro-valor historia))
             )
      (cond
        (goal 
         (solucion-o-aprende meta #t)
         (printf "rastro ~a~n" (parametro-valor historia))
         (jugar-otra-vez))
        ((eval-reglas bc)
         (go (parametro-valor gen/spc) 
             (parametro-valor meta) 
             (parametro-valor historia)))
        (else
         (printf "rastro ~a~n" (parametro-valor historia))
         (printf "Hay que ampliar las especies de ~a~n" (parametro-valor gen/spc))
         (aprende-regla-especie bc)
         (jugar-otra-vez)
         )
        )
      )
    )
  )
;;Evaluación de reglas
(define eval-una-regla
  (lambda (rule)
    (let* ((genero (regla-genero rule))
           (dif-esp (regla-dif-esp rule))
           (especie (regla-especie rule))
           (infima (regla-infima rule))
           )
      (if (and (eq? (parametro-valor gen/spc) genero)
               (pregunta-si-o-no dif-esp))
          (if infima
              (begin
                (set-parametro-valor! meta especie)
                (set-parametro-valor! 
                 historia 
                 (cons especie (parametro-valor historia))))
              (begin
                (set-parametro-valor! gen/spc especie)
                (set-parametro-valor! 
                 historia 
                 (cons especie (parametro-valor historia))))
              )
          #f)
      )
    )
  )
(define eval-reglas
  (lambda (bc)
    (cond
      ((null? bc) #f)
      ((eval-una-regla (first bc)) )
      (else (eval-reglas (rest bc)))
      )
    )
  )
;;;
(define pregunta-si-o-no
  (lambda (mensaje)
    (printf "¿~a?~n" mensaje)
    (let ((leido (read)) )
      (if (or (eq? leido 's) (eq? leido 'S) 
              (eq? leido 'si)(eq? leido 'Si)
              (eq? leido 'sí)(eq? leido 'Sí))
          #t
          #f) 
      )
    ))
;;
(define BC
  (list
   (make-regla 'ser-vivo "ser vivo semoviente" 'animal #f)
   (make-regla 'animal "tiene un esqueleto cartilaginoso u óseo" 'vertebrado #f)
   (make-regla 'vertebrado "tiene alas" 'ave #f)
   (make-regla 'ave "su hábitat es urbano y está muy acostumbrado a vivir cerca del hombre" 'gorrión #t)
   (make-regla  'vertebrado "amamanta sus crías" 'mamifero #f)
   (make-regla 'vertebrado "vive en el agua" 'pez #f)
   (make-regla  'pez "tiene un esqueleto hecho de cartílago en vez de hueso" 'tiburón #t)
   (make-regla  'mamifero "come carne" 'carnivoro #f)
   (make-regla  'carnivoro "es salvaje y puede vivir en manada" 'lobo #t)
   (make-regla  'carnivoro "es domestico" 'perro #t)
   (make-regla  'mamifero "es un primate" 'primate #f)
   (make-regla  'primate "tiene una cola prensil" 'mono #t)
   (make-regla  'primate "es un simio" 'chimpance #t)
   (make-regla  'primate "es inteligente" 'hombre #t)
   (make-regla  'mamifero "vive en el agua" 'cetaceo #f)
   (make-regla  'cetaceo "tiene barbas" 'ballena #t)
   (make-regla  'cetaceo "tiene dientes" 'delfin #t)
   (make-regla  'animal "carece de esqueleto" 'invertebrado #f)
   (make-regla  'invertebrado "tiene apéndices articulados y un cuerpo segmentado" 'artropodo #f)
   (make-regla  'artropodo "tiene un par de antenas, tres pares de patas y dos pares de alas" 'insecto #f)
   (make-regla  'insecto "tiene sólo dos alas" 'mosca #t)
   (make-regla  'insecto "es un insecto social" 'abeja #t)
   (make-regla  'artropodo "su cuerpo posee dos regiones y tiene cuatro pares de extremidades" 'aracnido #f)
   (make-regla  'aracnido "Producen seda, llamada tela de araña" 'araña #t)
   (make-regla  'artropodo "tiene dos ojos compuestos y dos pares de antenas" 'crustaceo #f)
   (make-regla  'crustaceo "Posee cinco pares de patas y el primer par de patas no termina en dos grandes pinzas" 'langosta #t)
   (make-regla  'artropodo "tiene cabeza y su tronco está formado por muchos segmentos y multitud de pares de patas" 'miriapodo #f)
   (make-regla  'miriapodo "Son carnívoros y segregan veneno" 'ciempies #t)
   (make-regla  'invertebrado "tiene un cuerpo blando, desnudo o protegido por una concha" 'molusco #f)
   (make-regla  'molusco "tiene cabeza, un pie musculoso ventral y una concha dorsal" 'gasteropodo #f)
   (make-regla  'gasteropodo "tiene una concha en espiral" 'caracol #t)
   (make-regla  'molusco "está protegido por dos valvas" 'bivalvo #f)
   (make-regla  'bivalvo "posee dos valvas casi circulares y desiguales" 'ostra #t)
   (make-regla  'molusco "tiene una cabeza y varios tentáculos" 'cefalopodo #f)
   (make-regla  'cefalopodo  "posee ocho tentáculos y es carnívoro" 'pulpo #t)
   ))
;;Aprendizajes
(define mensaje-inicial
  (lambda ()
  (printf "Piensa en un animal. Intentaré adivinar su nombre~n")
  (printf "Te haré preguntas. Contesta, por favor, S(í) o N(o)~n") ))

(define mensaje-final
  (lambda (valor)
    (if valor
        (printf "He tenido suerte!!~n")
        (printf "Lo siento, me equivoque.~n") )
    ))
(define respuesta-acertada
  (lambda ()
    (printf "Dime, por favor, en qué animal estabas pensando~n")
    (read) ))
(define diferencia
  (lambda (item nuevo)
    (printf "Si me dices algo que diferencie a ~a de ~a, puedo aprender~n" nuevo item)
    (read-char)
    (read-line) ));;ojo!!
;;aprendizaje especie ínfima
(define solucion-o-aprende
  (lambda (parameter booleano)
    (cond
      ((pregunta-si-o-no (parametro-valor parameter)) 
       (mensaje-final #t) )
      (else
       (mensaje-final #f)
       (aprende-regla-infima booleano) )
      )
    ;(driver)
    ))
;;
(define aprende-regla-infima
  (lambda (val)
    (let* ((genero (parametro-valor gen/spc))
           (esp-inf (respuesta-acertada))
           (dif-esp (diferencia (parametro-valor meta) esp-inf))
           (infima val)
           )
      (printf "regla-infima nueva: ~a ~a ~a ~a ~n" genero dif-esp esp-inf infima)
      (set! BC
            (cons
             (make-regla genero dif-esp esp-inf infima)
             BC))
      )
    ))
(define aprende-regla-especie
  (lambda (bc)
    (let* ((genero (parametro-valor gen/spc))
           (especies (especies-de-genero genero bc empty))
           (new-especie #f)
           (dif-esp #f)
           (infima #f)
           )
      (printf "Dime una especie de ~a diferente de ~a ~n" genero especies)
      (set! new-especie (read))
      (printf "Dime una característica específica de ~a " new-especie)
      (read-char)
      (set! dif-esp (read-line))
      (set! BC
            (cons
             (make-regla genero dif-esp new-especie #f)
             BC))
      (printf "Dime el nombre de un ~a que sea una solución del juego " new-especie)
      (set! infima (read))
      (printf "Dime una característica específica de ~a " infima)
      (read-char)
      (set! dif-esp (read-line))
      (set! BC
            (cons
             (make-regla new-especie dif-esp infima #t)
             BC))
      )
    ))
      
(define especies-de-genero
  (lambda (genero bc temp)
    (cond
      ((null? bc) temp)
      ((eq? (regla-genero (first bc)) genero)
       (especies-de-genero
        genero (rest bc) (cons (regla-especie (first bc)) temp)) )
      (else
       (especies-de-genero
        genero (rest bc) temp))
      )
    ))
;;
(define jugar-otra-vez
  (lambda ()
    (if (pregunta-si-o-no "Quieres jugar otra vez")
        (driver)
        (begin
          (print-bc archivo BC)
          'Adiós)
        )
    ))
;;para almacenar la red en un fichero
(define archivo
  "/Volumes/usuario/ZETA/animales-SE.txt")
(define read-bc
  (lambda (file)
    (let* ((in-port (open-input-file file))
           (lista (read in-port))
           )
      (close-input-port in-port)
      lista
      )
    ))
(define print-bc
  (lambda (file obj)
    (let ((out-port 
           (open-output-file file #:exists 'replace)))
      (print obj out-port)
      (close-output-port out-port)
      )
    ))
;;
;;
(define driver
  (lambda ()
    (set-parametro-valor! gen/spc 'ser-vivo)
    (set-parametro-valor! meta #f)
    (set-parametro-valor! historia empty)
    (mensaje-inicial)
    (when (file-exists? archivo)
        (set! BC 
              (read-bc archivo)) )
    (interprete BC)
    )
  )

(driver)