;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa   ;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;            Pedro R. Muro & Jose L. Villarroel
;;;
;;;       creado:        20-2-1991
;;;       modificado: 20-5-1993
;;;
;;;      IERL: iaaa experimental representation language
;;;
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa  iaaa   ;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; FORM :: valor
;;; Modifica los valors de una form y la crea en caso de que no exista.
;;;
(defun form (&key name is-a slots)
  (let* ((la-form (if (get name 'is-a)
                    name
                    (progn (setf (get name 'is-a) is-a) name)))
         )
    (dolist (slot-conten slots)
      (funcall #'set-aspect la-form 
               (car slot-conten)
               (cadr slot-conten)
               (cadr(cdr slot-conten))))
    la-form))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;(SET-ASPECT form slot aspecto valor) :: valor
;;; Guarda el valor del aspecto del slot de la form.
;;;
;;; Cada slot corresponde con una propiedad del simbolo.
;;; El contenido del slot esta formado por listas de aspectos compuestas
;;;  por un simpbolo identificador del aspecto y su contenido:
;;;          =  para el valor
;;;  IF-NEEDED  para el metodo de acceso
;;;
(defun set-aspect (form slot &optional aspecto valor)
  (let* ((contenido (get form slot)))
    (cond ((and contenido aspecto)
           (if (assoc aspecto contenido)
             (rplacd (assoc aspecto contenido) (list valor))
             (setq contenido (cons (list aspecto valor) contenido))))
          (aspecto
           (setq contenido (cons (list aspecto valor) contenido))))
    (setf (get form slot) contenido)))


;;; SET-VALUE esta especializado en el aspecto =
;;;
(defun set-value (form slot valor)
  (set-aspect form slot '= valor))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Aqui comienzan las definiciones del vocabulario de acceso y
;;;  manipulacion de datos
;;;
;;;(GET-ASPECT form slot aspecto) :: valor
;;; Devuelve el valor del aspecto del slot de la form
;;;


;;;
;;; FIND-SIMPLE-ASPECT-FORM toma un aspecto de un slot sin acceder por la
;;;  jerarquia.
;;;
(defun find-simple-aspect-form (form slot aspecto)
  (cadr (assoc aspecto (get form slot))))


;;;
;;; Toma un aspecto de un slot accediendo por la jerarquia.
;;;
(defun find-aspect-from-supers (form slot aspecto)
  (let* ((value (assoc aspecto (get form slot))))
    (if value 
      (cadr value)
      (if (get form 'is-a)
        (find-aspect-from-supers (get form 'is-a) slot aspecto)
        ))))

;;;
;;; Toma el aspecto = de un slot accediendo por la jerarquia.
;;; Amplia el vocabulario para el aspecto = pues es muy utilizado.
;;;
(defun find-slot-value-form (form slot)
  (find-aspect-from-supers form slot '=))


;;;
;;; Obtiene el valor del aspecto = de un slot con herencia
;;;  y aplicando ademas el demond en el aspecto IF-NEEDED.
;;;
(defun get-value (form slot)
  (let ((needed (find-aspect-from-supers form slot 'if-needed)))
    (if needed
      (funcall needed form slot)
      (find-slot-value-form form slot))))

;;;
;;; FIND-SLOT-FROM-SUPERS toma el contenido entero de un slot accediendo por la 
;;;  jerarquia.
;;; Puede ser utilizado para heredar mensajes en el estilo orientado a objeto
;;;
(defun find-slot-from-supers (form slot)
  (let* ((value (get form slot)))
    (if value 
      value
      (if (get form 'is-a)
        (find-slot-from-supers (get form 'is-a) slot)
        ))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Creacion de la estructura de conocimiento para el problema de
;;;  los apartamentos.
;;; El objetivo es disponer de una representacion del conocimiento
;;;  que permita obtener informacion a una empresa inmobiliaria.
;;;  Para ello se crea una base de datos de forms con algunos metodos.
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Generacion de funciones para los demonds
;;;


;;; CALCULA-RUIDO es una funcion IF-NEEDED que calcula el nivel de ruido
;;;  de un apartamento. 
;;; Si existe un valor = lo toma, si no lo calcula dependiendo de
;;;  la altura del piso.
;;;
;;; CALCULA-RUIDO-EN-CASA lo calcula en base a la distancia 
;;;  de la casa a la carretera.
;;;
(defun calcula-ruido (form slot)
  (let* ((valor (find-aspect-from-supers form 'ruido-calle '=))
         piso)
    (cond (valor valor)
          (t (setq piso (get-value form 'piso))
             (cond ((> piso 15) 'muy-bajo)
                   ((> piso 8) 'bajo)
                   ((> piso 4) 'medio)
                   ((> piso 1) 'alto)
                   (t 'muy-alto))))))

(defun calcula-ruido-en-casa (form slot)
  (let* ((valor (find-aspect-from-supers form 'ruido-calle '=))
         distancia)
    (cond (valor valor)
          (t (setq distancia (get-value form 'distancia-carretera))
             (cond ((> distancia 1000) 'muy-bajo)
                   ((> distancia 100) 'bajo)
                   ((> distancia 30) 'medio)
                   ((> distancia 10) 'alto)
                   (t 'muy-alto))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Generacion de la jerarquia de forms
;;;
;;;   La funcion GBD genera la base de datos de las forms
;;;
(defun gbd ()
  (let ()
    (form :is-a nil :name 'object)
    (form :name 'cosa 
          :is-a 'object)
    (form :name 'vivienda
          :is-a 'cosa
          :slots (list (list 'ruido-calle 'if-needed #'calcula-ruido)
                       (list 'calle-nombre)
                       (list 'calle-numero)
                       (list 'color-pared)
                       (list 'material-suelo)
                       (list 'numero-habitaciones)
                       (list 'distancia-carretera)))
    (form :name 'apartamento
          :is-a 'vivienda
          :slots '((numero-habitaciones = 2)
                   (color-pared = blanco)
                   (material-suelo = gres)
                   (piso)
                   (mano)))
    (form :name 'chalet
          :is-a 'vivienda
          :slots (list (list 'ruido-calle 
                             'if-needed #'calcula-ruido-en-casa)
                       (list 'num-pisos '= '2)))
    (form :name 'apt-breton-22
          :is-a 'apartamento
          :slots '((calle-nombre = Breton)
                   (calle-numero = 22)
                   (material-suelo = madera)))
    (form :name 'apt-22-1
          :is-a 'apt-breton-22
          :slots '((numero-habitaciones = 3)
                   (mano = derecha)
                   (piso = 2)))
    (form :name 'apt-22-2
          :is-a 'apt-breton-22
          :slots '((numero-habitaciones = 4)
                   (mano = izquierda)
                   (piso = 2)))
    (form :name 'chalet-montesol-5
          :is-a 'chalet
          :slots '((calle-nombre = urbanizacion-montesol)
                   (calle-numero = 5)
                   (numero-habitaciones = 5)
                   (num-pisos = 2)
                   (distancia-carretera = 200)))
    ))

;;;;;;;;;;;;;;;;;;;
;;;
;;; Puedes probar a obtener valores con la funcion GET-VALUE
;;;

;(get-value 'apt-22-1 'color-pared)
;--> BLANCO

;(get-value 'apt-22-1 'material-suelo)
;--> MADERA

;(get-value 'apt-22-1 'distancia-carretera)
;--> NIL

;(get-value 'apt-22-1 'ruido-calle)
;--> ALTO

;(get-value 'chalet-montesol-5 'ruido-calle)
;--> BAJO

;;;
;(set-value 'apt-breton-22 'ruido-calle 'muy-alto)
;(set-value 'chalet 'ruido-calle 'muy-bajo)

;(get-value 'apt-22-1 'ruido-calle)
;--> MUY-ALTO

;(get-value 'chalet-montesol-5 'ruido-calle)
;--> MUY-BAJO