#lang scheme

;;árboles binarios de discriminación
;; predicado de tipo
(define arbol-bd?
  (lambda (arg)
    (and
     (list? arg)
     (= (length arg) 3) )
    ))
;;nudos terminales
(define-syntax nudo-terminal?
  (syntax-rules ()
    [(nudo-terminal? arg pred)
      (and
       (not (arbol-bd? arg))
       (pred arg))]
    ))
;;constructor
(define haz-arbol-bd
  (lambda (raiz suc-i suc-d)
    (list raiz suc-i suc-d)
    ))
;;extractores
(define raiz first)
(define suc-i second)
(define suc-d third)
;;operación de sustituir un ítem
(define sustituye
  (lambda (arbol item nuevo)
    (cond
      ((nudo-terminal? arbol symbol?)
       (if (eq? arbol item)
           nuevo
           arbol) )
      (else
       (haz-arbol-bd
        (if (equal? (raiz arbol) item)
            nuevo
            (raiz arbol))
        (sustituye (suc-i arbol) item nuevo)
        (sustituye (suc-d arbol) item nuevo) ) )
      )
    ))
(define reconstruye-arbol
  (lambda (arbol)
    (cond
      ((nudo-terminal? arbol symbol?) arbol)
      (else
       (haz-arbol-bd
        (raiz arbol)
        (reconstruye-arbol (suc-i arbol))
        (reconstruye-arbol (suc-d arbol)) ) )
      )
    ))
;;interfaz
(define print-pregunta
  (lambda (item)
    (if (nudo-terminal? item symbol?)
        (printf "Estabas pensando en un ~a: sí o no.~n" item)
        (printf "¿~a?~n" item) )
    ))
(define pregunta-si-no
  (lambda (item)
    (print-pregunta item)
    (let ((input (read)))
      (cond
        ((eq? input 'Sí) #t)
        ((eq? input 'Si) #t)
        ((eq? input 'S) #t)
        ((eq? input 's) #t)
        ((eq? input 'No) #f)
        ((eq? input 'no) #f)
        ((eq? input 'N) #f)
        ((eq? input 'n) #f)
        (else (pregunta-si-no item))
        )
      )
    ))
(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!!
(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") ))

;;procesos del programa
;;recursivamente se recorre el árbol mientras se hacen preguntas
(define recorre-arbol
  (lambda (arbol)
    (cond
      ((nudo-terminal? arbol symbol?) (solucion-o-aprende arbol))
      ((pregunta-si-no (raiz arbol))
       (recorre-arbol (suc-i arbol)) )
      (else
       (recorre-arbol (suc-d arbol)) )
      )
    ))

(define solucion-o-aprende
  (lambda (nudo)
    (cond
      ((pregunta-si-no nudo) 
       (mensaje-final #t) )
      (else
       (mensaje-final #f)
       (aprende nudo) )
      )
    (jugar-otra-vez)
    ))
    
(define aprende
  (lambda (nudo)
    (let* ((acertada (respuesta-acertada))
           (caracteristica (diferencia nudo acertada))
           )
      (set! bd 
            (sustituye bd nudo 
                       (haz-arbol-bd 
                        caracteristica acertada nudo)))
      )
    ))
;;
(define jugar-otra-vez
  (lambda ()
    (if (pregunta-si-no "Quieres jugar otra vez")
        (recorre-arbol bd)
        (begin
          (print-arbol archivo bd)
          'Adiós)
        )
    ))

(define juego-animales
  (lambda file-path
    (mensaje-inicial)
    (when (file-exists? (first file-path))
        (set! bd (read-arbol (first file-path))) )
    (recorre-arbol bd)
    ))
;;para almacenar el arbol en un fichero
;;path donde se encuentra el fichero con la base de datos
(define trabajo-dir "/Volumes/usuario/ZETA/")
;;; Establecemos el nombre del fichero
(define nombre-fichero "animales-arboles.txt")
;;; Construimos su path
(define archivo (build-path trabajo-dir nombre-fichero))
(define read-arbol
  (lambda (file)
    (let* ((in-port (open-input-file file))
           (arbol (read in-port))
           )
      (close-input-port in-port)
      arbol
      )
    ))
(define print-arbol
  (lambda (file obj)
    (let ((out-port (open-output-file file #:exists 'replace)))
      (print obj out-port)
      (close-output-port out-port)
      )
    ))
;;
(define bd (haz-arbol-bd "tiene un esqueleto cartilaginoso u óseo" 'vertebrado 'invertebrado))
;;
(juego-animales archivo)
