Implementar en el lenguaje CLIPS el conjunto de los operadores del mundo de los bloques. La solución debe, mediante reglas de inferencia, identificar la trayectoria de los estados alcanzados, partiendo de un estado inicial, y los operadores aplicados, que reflejen los movimientos efectuados por el robot hasta alcanzar el estado meta (u objetivo). Los operadores válidos son: Operador Coger Coger (x) Dejar (x) Montar Montar (x en y) Desm Desmontar ontar (x, y)
Precondición/Resultado Precondición: Precondición: Sobre Sobre mesa (x), libre libre (x), mano robot vacía Resultado: Cogido (x) Precondición: Cogido Cogido (x) Resultado: Sobre mesa (x), libre (x), mano robot vacía Precondición: Cogido Cogido (x), (x), Libre (y) Resultado: Sobre (y, x), mano robot vacía, libre (x) Precondición: Precondición: Mano robot vacía, sobre (y, x), libre libre (x) Resultado: Cogido (x), libre (y)
Solución: (deftemplate (deftemplate apilado (slot encima (type SYMBOL)) (slot debajo (type SYMBOL)) ) (deftemplate (deftemplate objetivo (slot encima (type SYMBOL)) (slot debajo (type SYMBOL)) ) (deffacts bloques ; Estado de partida ; nada encima de B encima de A encima de mesa ; nada encima de C encima de D encima de mesa (apilado (apilado (apilado (apilado (apilado (apilado
(encima (encima (encima (encima (encima (encima
B) (debajo A)) nada) (debajo B)) C) (debajo D)) nada) (debajo C)) D) (debajo mesa)) A) (debajo mesa))
; Estado final u objetivo (objetivo (encima A) (debajo D)) ; Reglas
(defrule Objetivo-logrado (declare (salience 110)) ?obj <- (objetivo (encima ?a) (debajo ?b)) ?x <- (apilado (encima nada) (debajo ?a)) ?y <- (apilado (encima nada) (debajo ?b)) ?z <- (apilado (encima ?a) (debajo ?c)) => (modify ?z (debajo ?b)) (retract ?obj ?y) (printout t crlf "Objetivo conseguido" crlf) ) (defrule Objetivo-arriba-la-mesa ?obj <- (objetivo (encima ?a) (debajo ?b)) ?x <- (apilado (encima ?algo&:(neq ?algo nada)) (debajo ?a)) => (assert (objetivo (encima ?algo) (debajo mesa))) (printout t "Objetivo: encima " ?algo " debajo: mesa" crlf) ) (defrule Objetivo-abajo-a-la-mesa ?obj <- (objetivo (encima ?a) (debajo ?b)) ?x <- (apilado (encima ?algo&:(neq ?algo nada)) (debajo ?b)) => (assert (objetivo (encima ?algo) (debajo mesa))) (printout t "Objetivo: encima " ?algo " debajo: mesa" crlf) ) (defrule Objetivo-cumplido (declare (salience 100)) ?obj <- (objetivo (encima ?a) (debajo mesa)) (apilado (encima ?a) (debajo mesa)) => (retract ?obj) ) (defrule mover-a-la-mesa ?obj <- (objetivo (encima ?a) (debajo mesa)) (apilado (encima nada) (debajo ?a)) ?y <- (apilado (encima ?a) (debajo ?b)) => (retract ?obj) (modify ?y (debajo mesa)) (assert (apilado (encima nada) (debajo ?b))) (printout t "muevo " ?a " a la mesa" crlf) )
Dado un mapa que representa la situación de distintas ciudades, se quiere construir un sistema en Clips que permita contestar preguntas sobre la posición relativa de dos ciudades, con las siguientes características: a) Se introducirán exclusivamente hechos correspondientes a las relaciones “estar al norte de” y “estar al oeste de” y sólo entre las ciudades más próximas entre sí. Por ejemplo, si suponemos 9 ciudades distribuidas en una cuadrícula: ABC DE F GHI sólo se establecerán como hechos: “A está al norte de D”, “A está al oeste de B”, etc. b) El sistema de representación será capaz de inferir todas las relaciones inversas de las dadas directamente, es decir, las relaciones “estar al sur de” y “estar al este de”. c) Se inferirán nuevas relaciones por transitividad. Por ejemplo, sabiendo que “A está al norte de D” y que “D está al norte de G” se inferirá que “A está al norte de G”. d) Se inferirán las relaciones noroeste, noreste, suroeste y sureste a partir de los hechos iniciales. Por ejemplo, se podrá inferir que “C está al noreste de G”. e) El hecho que se utilizará para consultar al sistema será ( situación ). Cuando este hecho se inserta en el sistema, el mismo debe responder mostrando por pantalla la situación de la ciudad 1 con respecto a la ciudad 2.
Solución: Desde luego, la forma más simple de hacer es: (deffacts ciudades (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada (ubicada
A B D E G H A D B E C F
al-oeste-de al-oeste-de al-oeste-de al-oeste-de al-oeste-de al-oeste-de al-norte-de al-norte-de al-norte-de al-norte-de al-norte-de al-norte-de
B) C) E) F) H) I) D) G) E) H) F) I)
(situacion B F) ) ; Reglas para inferir relaciones inversas (defrule al-sur-de (ubicada ?a al-norte-de ?b) => (assert (ubicada ?a al-sur-de ?a)) ) (defrule al-este-de (ubicada al-oeste-de ?a ?b) => (assert (ubicada ?b al-este-de ?a)) ) ; Reglas para inferir relaciones transitivas (defrule transitiva (ubicada ?a ?rel ?b) (ubicada ?b ?rel ?c) => (assert (ubicada ?a ?rel ?c)) ) ; Reglas para inferir relaciones combinadas (defrule noreste (ubicada ?a al-norte-de ?b) (ubicada ?b al-este-de ?c) => (assert (ubicada ?a al-noreste-de ?c)) ) (defrule noroeste (ubicada ?a al-norte-de ?b)
(ubicada ?b al-oeste-de ?c) => (assert (ubicada ?a al-noroeste-de ?c)) ) (defrule sureste (ubicada ?a al-sur-de ?b) (ubicada ?b al-este-de ?c) => (assert (ubicada ?a al-sureste-de ?c)) ) (defrule suroeste (ubicada ?a al-sur-de ?b) (ubicada ?b al-oeste-de ?c) => (assert (ubicada ?a al-suroeste-de ?c)) ) ;Respuesta de la pregunta (defrule relacion-entre-ciudades (declare (salience -10)) (situacion ?a ?b) (ubicada ?a ?rel ?b) => (printout t ?a " está " ?rel " " ?b crlf) )
Consideremos fórmulas de la lógica proposicional construidas con las conectivas: negación (-), disyunción (|), conjunción (&), implicación (->) y equivalencia (<->). Por ejemplo: (p&q)->r Para la representación en clips de este tipo de fórmulas se propone el siguiente template. (deftemplate formula (slot id) (slot tipo) (multislot componentes) ) Id almacena un identificador asociado a la fórmula. Tipo almacena la conectiva entre (siguiente campo) los identificadores de las fórmulas componentes. Por ejemplo, la fórmula anterior quedaría en los siguientes hechos:
(formula (id id-1) (tipo ->) (componentes id2 id3)) (formula (id id-2) (tipo &) (componentes id4 id5)) (formula (id id-3) (tipo var) (componentes)) (formula (id id-4) (tipo var) (componentes)) (formula (id id-5) (tipo var) (componentes)) a) ¿Con qué hechos se representaría la fórmula ((-q)| (-r)) <> (-(q&r)) Toda fórmula proposicional se puede transformar a forma normal negativa aplicando una serie de reglas de transformación, de las cuales las siguientes son una parte: (-(-p)) se transforma en p (p->q) se transforma en (-p)|q (-(p&q)) se transforma en (-p)|(-q) (p<->q) se transforma en (p->q)&(q->p) b) Construir un conjunto de reglas Clips que sirvan para realizar estas transformaciones. Para ello será necesario utilizar la función gensym que genera un identificador único para asignárselo a una fórmula. Por ejemplo, (assert (formula (id (genysim)))) No se permite la utilización de condicionales en el consecuente de las reglas. c) ¿Cómo se podría imprimir mediante reglas Clips una fórmula así representada conocido el identificador r aíz?
Solución: Solución: 1. (deffacts hechos (formula (formula (formula (formula (formula (formula (formula (formula
(id (id (id (id (id (id (id (id
q) (tipo "var") (componentes)) r) (tipo "var") (componentes)) id-1) (tipo "-") (componentes q)) id-2) (tipo "-") (componentes r)) id-3) (tipo "|") (componentes id-1 id-2)) id-4) (tipo "-") (componentes id-5)) id-5) (tipo "&") (componentes q r)) raiz) (tipo "<->") (componentes id-3 id-5))
(transformar) )
2. ; transformacion de la doble negación (defrule doble-negacion (declare (salience 550)) (transformar) ?f1 <- (formula (id ?id-1) (tipo "-") (componentes ?id-2)) ?f2 <- (formula (id ?id-2) (tipo "-") (componentes ?id-3)) ?f3 <- (formula (id ?id-3) ) => (retract ?f1 ?f2) (modify ?f3 (id ?id-1)) ) ;transformación de la implicación (defrule implicacion (declare (salience 550)) (transformar) ?f1 <- (formula (id ?id-1) (tipo "->") (componentes ?id-2 ?id-3)) => (bind ?nuevo-id (gensym)) (modify ?f1 (tipo "|") (componentes ?nuevo-id ?id-3)) (assert (formula (id ?nuevo-id) (tipo "-") (componentes ?id-2))) ) ;transformación negación de la conjunción (defrule negacion-conjuncion (declare (salience 550)) (transformar) ?f1 <- (formula (id ?id-1) (tipo "-") (componentes ?id-2)) ?f2 <- (formula (id ?id-2) (tipo "&") (componentes ?id-3 ?id-4)) => (bind ?id-2a (gensym))
(bind ?id-2b (gensym)) (modify ?f1 (id ?id-1) (tipo "|") (componentes ?id-2a ?id-2b)) (modify ?f2 (id ?id-2a) (tipo "-") (componentes ?id-3)) (assert (formula (id ?id-2b) (tipo "-") (componentes ?id-4))) ) ; transformacion doble implicación (defrule doble-implicacion (declare (salience 550)) (transformar) ?f1 <- (formula (id ?id-1) (tipo "<->") (componentes ?id-2 ?id-3)) => (bind ?id-4a (gensym)) (bind ?id-4b (gensym)) (modify ?f1 (id ?id-1) (tipo "&") (componentes ?id-4a ?id-4b)) (assert (formula (id ?id-4a) (tipo "->") (componentes ?id-2 ?id3))) (assert (formula (id ?id-4b) (tipo "->") (componentes ?id-3 ?id2))) ) ; cierra la transformacion y define hecho raiz para la impresión (defrule cierra-transformacion (declare (salience 100)) ?t <- (transformar) => (retract ?t) (assert (imprimir raiz)) )
3. (defrule imprimir-dupla ?f <- (imprimir ?id-1) (formula (id ?id-1) (tipo ?tipo&"&"|"|"|"->"|"<->") (componentes ?id-2 ?id-3)) => (retract ?f) (printout t ?tipo " ") (assert (imprimir ?id-3)) (assert (imprimir ?id-2)) ) (defrule imprimir-negacion ?f <- (imprimir ?id-1) (formula (id ?id-1) (tipo "-") (componentes ?id-2)) => (retract ?f) (printout t "- ") (assert (imprimir ?id-2)) ) (defrule imprimir-var ?f <- (imprimir ?id-1) (formula (id ?id-1) (tipo "var")) => (retract ?f) (printout t ?id-1 " ") ) (defrule imprimir-fin (not (imprimir ?))
=> (printout t crlf) )
El siguiente árbol de decisión presenta una pequeña sección de un diagnóstico de fallos en el sistema de encendido de coches. Cada caja redondeada es una recomendación. Cada caja rectangular impl ica la recogida de evidencias. Implemente en Clips un sistema que solucione este problema. ¿Hay diversas posibilidades en cuanto al diseño de la implementación? Razone las opciones y sus ventajas o inconvenientes. ¿Puede implementar el sistema de acuerdo a cada una de esas posibilidades? No importa si no entiende alguna palabra de la figura, son preguntas de respuestas booleanas y las recomendaciones correspondientes a las secuencias de evidencias.
;Definición de la estructuras de datos (deftemplate nodo-binario "estructura del nodo del arbol binario" (slot nodo-id (type INTEGER)) (slot pregunta (type STRING)) (slot nodo-yes (type INTEGER)) (slot nodo-not (type INTEGER)) ) (deftemplate nodo-terminal "estructura del nodo terminal del arbol" (slot nodo-id (type INTEGER)) (slot indicacion (type STRING)) ) (deffacts arbol-binario "contenidos de los nodos que componen en arbol" (nodo-binario (nodo-id 1) (pregunta "Starter turning") (nodo-yes 2) (nodonot 3)) (nodo-binario (nodo-id 2) (pregunta "Got any petrol") (nodo-yes 4) (nodonot 5)) (nodo-binario (nodo-id 3) (pregunta "Lights working") (nodo-yes 6) (nodonot 7)) (nodo-binario (nodo-id 6) (pregunta "Solenoid clik") (nodo-yes 8) (nodonot 9)) (nodo-binario (nodo-id 8) (pregunta "Terminals clean") (nodo-yes 10) (nodo-not 11)) (nodo-binario (nodo-id 9) (pregunta "Solenoid fuse OK") (nodo-yes 12) (nodo-not 13)) (nodo-terminal (nodo-terminal (nodo-terminal (nodo-terminal (nodo-terminal (nodo-terminal (nodo-terminal
(nodo-id (nodo-id (nodo-id (nodo-id (nodo-id (nodo-id (nodo-id
4) (indicacion "Call de A.A.")) 5) (indicacion "Buy same")) 7) (indicacion "Charge battery")) 10) (indicacion "Replace starter")) 11) (indicacion "Clean terminals")) 12) (indicacion "Replace solenoid")) 13) (indicacion "Replace fuse"))
(nodo-activo 1) ) ;************************************* ;DEFINICIÓN DE REGLAS ;******************************************** (defrule pide-datos "Presenta la pregunta del nodo y navega por el arbol" ?n <- (nodo-activo ?nodo) (nodo-binario (nodo-id ?nodo) (pregunta ?pregunta) (nodo-yes ?ny) (nodonot ?nn)) => (retract ?n) (printout t crlf ?pregunta " (Y/-)?: " crlf) (if (eq (read) Y) then (assert (nodo-activo ?ny)) else (assert (nodo-activo ?nn)) ) ) (defrule presenta-conclusiones "Presenta la indicacion correspondiente" ?n <- (nodo-activo ?nodo) (nodo-terminal (nodo-id ?nodo) (indicacion ?indicacion)) =>
(retract ?n) (printout t crlf ?indicacion "!" crlf crlf) )
Ejercicio de Clips: Se dispone de un registro con los siguientes datos de personas: DNI, Nombre, Apellidos, añonacimiento, profesión, DNI-padre, DNI-madre y DNI-cónyuge. 1.1 Diseñar las estructuras Clips para almacenar estos datos en la base de hechos. Implementar las reglas Clips que permitan alcanzar los siguientes objetivos: 1.2 Se desea obtener un listado de los nombres de los ascendientes de cada persona. 1.3 Se desea determinar si hubo matrimonios entre primos hermanos. 1.4 Se desea determinar si hubo matrimonios entre un cónyuge que tuviese una determinada profesión y que el padre del otro cónyuge tuviese esa misma profesión. 1.5 Se desea un listado de todas las personas ordenadas por año de nacimiento. 1.6 Se desea un listado de todas las personas ordenadas por apellidos. Para comparar strings se dispone de la función str-compare que tiene como argumentos los dos strings a comparar. Devuelve 0 si son iguales, un valor positivo si el primero es mayor que el segundo, y devuelve un valor negativo en el caso inverso.
;Se dispone de un registro con los siguientes datos de personas: DNI, Nombre y apellidos, año-nacimiento, profesión, DNI-padre, ;DNI-madre y DNI-cónyuge. ;Definición de la estructuras de datos (deftemplate persona "Tipo de entidad persona" (slot posicion (type INTEGER)); campo para la ordenación de los registros segun diferentes criterios (slot dni) (slot nombre) (multislot apellidos) (slot nacimiento (type INTEGER));Año nacimiento (slot profesion) (slot padre) ;Contendrá el DNI del padre (slot madre) ;Contendrá el DNI de la madre (slot conyuge); contendrá el DNI del conyuge ) (deffacts personas (persona (posicion 1) (dni 156688068A) (nombre Pedro) (apellidos "Ponce Sala") (nacimiento 1941) (profesion "cartero")) (persona (posicion 2) (dni 080245678A) (nombre Francisco) (apellidos "Ponce Suarez") (nacimiento 1960) (profesion "Informatico") (padre 156688068A) (madre 112244069A) (conyuge 663355046A)) (persona (posicion 3) (dni 856678098A) (nombre Zeus) (apellidos "Ponce Suarez") (nacimiento 1961) (profesion "Agricultor") (padre 156688068A)(madre 112244069A) (conyuge 333344059A)) (persona (posicion 4) (dni 356688068A) (nombre Pepe) (apellidos "Ponce Saez") (nacimiento 1980) (profesion "Lechero") (padre 080245678A) (madre 663355046A)) (persona (posicion 5) (dni 556688068A) (nombre Luis) (apellidos "Ponce Lopez") (nacimiento 1972) (profesion "cartero") (padre 856678098A) (madre 333344059A) (conyuge 552299078A)) (persona (posicion 6) (dni 456688068A) (nombre Juan) (apellidos "Ponce Lopez") (nacimiento 1981) (profesion "elect") (padre 856678098A) (madre 663355046A) ) (persona (posicion 7) (dni 552299078A) (nombre Carol) (apellidos "Ponce Saez") (nacimiento 1973) (profesion "azafata") (padre 080245678A) (madre 663355046A)(conyuge 556688068A)) (persona (posicion 8) (dni 663355046A) (nombre Petra) (apellidos "Saez Diaz") (nacimiento 1963) (profesion "ama casa") (conyuge 080245678A)) (persona (posicion 9) (dni 333344059A) (nombre Manuela) (apellidos "Lopez Perez") (nacimiento 1962) (profesion "cartero") (conyuge 856678098A)) (persona (posicion 10) (dni 112244069A) (nombre Felisa) (apellidos "Suarez Garcia") (nacimiento 1948) (profesion "ama casa") (conyuge 156688068A)) (inicio) ) ;******************************************** ;DEFINICIÓN DE REGLAS ;******************************************** ;Regla que plantea de forma muy simple el menú de acciones que se desean realizar:
(defrule presenta-menu "Presenta el menu de acciones al usuario" ?inicio <- (inicio) => (printout t crlf "Seleccione acción (1-5)" crlf " 1- Listar por apellidos" crlf " 2- Listar por año de nacimiento" crlf " 3- Obtener los ascendientes de una persona" crlf " 4- Determinar si hubo matrimonios entre primos" crlf " 5- Determinar si un conyuge con la profesion del suegro" crlf " Acción: ") (bind ?accion (read)) (if (= ?accion 1) then (assert (listar-apellidos))) (if (= ?accion 2) then (assert (listar-anhos))) (if (= ?accion 3) then (assert (listar-ascendientes))) (if (= ?accion 4) then (assert (determinar-matri-primos))) (if (= ?accion 5) then (assert (determinar-matri-suegro))) (retract ?inicio) ) ;************************************** ;Reglas que ordenan las posiciones por apellidos (defrule ordenar-apellidos "ordena por apellidos" (declare (salience 550)) (listar-apellidos) ?x1 <- (persona (posicion ?i) (apellidos $?ap1) ) ?x2 <- (persona (posicion ?j)(apellidos $?ap2) ) (test (= ?j (+ ?i 1))) ;Pasamos la variable multicampo a una cadena simple y se compara (test (> (str-compare (implode$ $?ap1) (implode$ $?ap2)) 0)) ;Ordenadas alfabeticamente => (modify ?x1 (posicion ?j)) (modify ?x2 (posicion ?i)) ) ; regla para preparar el proceso de impresión (defrule inicia-indice-apellidos "Inicia el indice para la ordenación" (declare (salience 520)) ?l <- (listar-apellidos) => (retract ?l) (assert (indice-ap 1)) ) ; Regla imprime ordenadamente por apellidos (defrule imprime-apellidos "Imprime por apellidos" (declare (salience 500)) ?x <- (indice-ap ?i) (persona (posicion ?i) (nombre ?nombre) (apellidos $?ap) => (printout t $?ap ", " ?nombre crlf) (retract ?x) (assert (indice-ap (+ ?i 1))) )
)
;************************************** ;Regla que ordena las posiciones por anho de la misma forma que la anterior (defrule ordenar-anhos "ordena por anhos" (declare (salience 550)) (listar-anhos) ?x1 <- (persona (posicion ?i) (nacimiento ?anho-1) ) ?x2 <- (persona (posicion ?j) (nacimiento ?anho-2) ) ;se comparan solo las posiciones adyacentes (test (= ?j (+ ?i 1))) (test (< ?anho-1 ?anho-2)) => (modify ?x1 (posicion ?j)) (modify ?x2 (posicion ?i)) ) (defrule inicia-indice-anhos "Inicia el indice para la ordenación" (declare (salience 520)) ?l <- (listar-anhos) => (retract ?l) (assert (indice-an 1)) ) (defrule imprime-anhos "imprime por anhos" (declare (salience 450)) ?x <- (indice-an ?i) (persona (posicion ?i) (nombre ?nombre) (nacimiento ?a) ) => (printout t ?a ", " ?nombre crlf) (retract ?x) (assert (indice-an (+ ?i 1))) ) ;************************************** ; Reglas para el listado de los ancestros de una persona (defrule obtener-dni-ascendientes "Pide el dni de la persona cuyos ascendientes se buscan" (declare (salience 550)) ?fase <- (listar-ascendientes) => (printout t crlf "introduzca el dni de la persona: " crlf) (assert (objetivo (read))) (retract ?fase) ) (defrule obtener-ascendentes "Obtiene los ascendientes de una persona dada" (declare (salience 500)) ?ob <- (objetivo ?dni-ob) (persona (dni ?dni-ob) (nombre ?nombre) (apellidos $?ap-h) (padre ?dni padre) (madre ?dni-madre) ) (persona (dni ?dni-padre) (nombre ?nombre-p) (apellidos $?ap-p) ) (persona (dni ?dni-madre) (nombre ?nombre-m) (apellidos $?ap-m) ) => (printout t ?nombre " " $?ap-h " es hijo de " ?nombre-p " " $?ap-p " y de " ?nombre-m " " $?ap-m crlf)
(retract ?ob) (assert (objetivo ?dni-padre)) (assert (objetivo ?dni-madre)) ) ;************************************** ;Regla que comprueba si hay matrimonios entre primos. Para simplificar supondremos que hay un único matrimonio ;para cada miembro de una pareja. Así, podemos dejar las abuelas tranquilas, por ejemplo (defrule comprueba-matrimonios-primos "Determina si ha habido matrimonios entre primos" ?mp <- (determinar-matri-primos) (persona (dni ?dni) (nombre ?nombre) (padre ?padre) (madre ?madre) (conyuge ?d-conyuge) ) (persona (dni ?d-conyuge) (nombre ?conyuge) (padre ?c-padre) (madre ?c madre) ) (persona (dni ?padre) (padre ?abuelo-p)) ; abuelo paterno (persona (dni ?madre) (padre ?abuelo-m)) ; abuelo materno (persona (dni ?c-padre) (padre ?c-abuelo-p) ) ; abuelo paterno del conyuge (persona (dni ?c-madre) (padre ?c-abuelo-m) ) ; abuelo materno del conyuge (test ( or (eq ?abuelo-p ?c-abuelo-p ) (eq ?abuelo-p ?c-abuelo-m ) (eq ?abuelo-m ?c-abuelo-p ) (eq ?abuelo-m ?c-abuelo-m ) )) => (retract ?mp) (printout t "Se ha encontrado un matrimonio entre primos: " ?nombre " y " ?conyuge " " crlf) ) ;************************************** ;Regla que comprueba si hay un matrimonio con un conyuge con la misma profesión que el padre del otro conyuge (defrule comprueba-profesion-suegro "Determina si una persona con la profesión de su suegro" ?mp <- (determinar-matri-suegro) (persona (dni ?dni) (nombre ?nombre) (profesion ?prof ) (conyuge ?conyuge)) (persona (dni ?conyuge) (padre ?suegro) ); obtenemos el dni del suegro (persona (dni ?suegro) (nombre ?n-suegro) (profesion ?prof)) ; coincide la profesion del suegro => (retract ?mp) (printout t "Se ha encontrado que " ?nombre " y su suegro " ?nsuegro " tienen la misma profesión " crlf) )
Supóngase una empresa de mensajería que transporta paquetes y cartas. La siguiente tabla presenta los costes de enviar cartas y paquetes menores de 2 Kgs. entre la ciudad origen y la ciudad destino siempre que la entrega sea al día siguiente. COSTE (euros) ORIGEN
DESTINO
CARTA
PAQUETE
Madrid
Barcelona
4
7
Madrid
Toledo
2
6
Madrid
Badajoz
3
7
Barcelona
Cádiz
6
8
Barcelona
Gerona
2
4
Barcelona
Badajoz
4
9
Si la entrega es para el mismo día que la recogida existe un suplemento tanto para las cartas como para los paquetes de 60 euros. Al margen de esto, si el paquete pesa más de 2 kilos, hay un suplemento de 6 euros por cada 100 grs. de más. Se pide, utilizando Clips, 4.1. Definir la base de hechos . Construir la base de reglas que formalice dichos conocimientos utilizando el menor número de reglas posible. 4.3. Construir las reglas para la introducción de los datos del paquete a enviar y muestren el importe correspondiente. 4.2.
Supóngase que cada fila de la tabla representa los costes de enviar cartas entre dos ciudades determinadas, con independencia de cuál sea el origen y cuál el destino. Es decir, vale lo mismo enviar una carta de Madrid a Barcelona que de Barcelona a Madrid. Construir la o las reglas para formalizar tal conocimiento.
4.4.
;Definición de la estructuras de datos (deftemplate ruta "Ruta y tipo de envíos" (slot origen) (slot destino) (slot tipo) (slot importe (type INTEGER)) ) (deftemplate envio "Datos del envio" (slot origen) (slot destino) (slot tipo (type SYMBOL)) (slot urgente? (type SYMBOL)) (slot peso (type INTEGER)) (slot importe (type INTEGER)) ) (deftemplate suplementos "suplemento que se paga por entrega rápida" (slot entrega-rapida (type INTEGER)) (slot exceso-peso-minimo (type INTEGER)) (slot importe-peso-minimo (type INTEGER)) (slot exceso-peso-margen (type INTEGER)) (slot importe-margen (type INTEGER)) ) (deffacts tarifas (ruta (origen Madrid) (destino Barcelona) (tipo C) (importe 4)) (ruta (origen Madrid) (destino Barcelona) (tipo P) (importe 7)) (ruta (origen Madrid) (destino Toledo ) (tipo C) (importe 2)) (ruta (origen Madrid) (destino Toledo ) (tipo P) (importe 6)) (ruta (origen Madrid) (destino Badajoz) (tipo C) (importe 3)) (ruta (origen Madrid) (destino Badajoz) (tipo P) (importe 7)) (ruta (origen Barcelona) (destino Cadiz) (tipo C) (importe 6)) (ruta (origen Barcelona) (destino Cadiz) (tipo P) (importe 8)) (ruta (origen Barcelona) (destino Gerona) (tipo C) (importe 2)) (ruta (origen Barcelona) (destino Gerona) (tipo P) (importe 4)) (ruta (origen Barcelona) (destino Badajoz) (tipo C) (importe 4)) (ruta (origen Barcelona) (destino Badajoz) (tipo C) (importe 9)) (suplementos (entrega-rapida 60) (exceso-peso-minimo 2000) (exceso-peso margen 100) (importe-margen 6)) ) ;************************************* ;DEFINICIÓN DE REGLAS ;******************************************** ;Regla que plantea de forma muy simple el menú de acciones que se desean realizar: ;origen, destino, y tipo de paquete ;pregunta la urgencia del envío (urgente o no) ;si es paquete pide el peso (defrule pide-datos "Pide los datos del envio" (initial-fact) => (printout t crlf "Datos del envío" crlf) (printout t crlf "Origen: " ) (bind ?origen (read)) (printout t crlf "Destino: ") (bind ?destino (read)) (printout t crlf "Es una carta (C) o un paquete (P): ") (bind ?tipo (read)) (printout t crlf "Es urgente? (S/N): ") (bind ?urgente (read)) (assert (envio (origen ?origen) (destino ?destino) (tipo ?tipo) (urgente? ?urgente) (peso 0) (importe 0))) )
(defrule calcula-importe "calcula el importe en función del origen, destino, urgencia y tipo" ?e <- (envio (origen ?origen) (destino ?destino) (tipo ?tipo) (urgente? ?urgente) (peso 0) (importe 0)) (ruta (origen ?origen) (destino ?destino) (tipo ?tipo) (importe ?importe)) (suplementos (entrega-rapida ?entrega-rapida)) => (if (eq ?urgente S) then (bind ?importe (+ ?importe ?entregarapida))) (modify ?e (importe ?importe)) ) (defrule suma-importe-exceso-peso "acumula el importe del peso extra" ?e <- (envio (tipo P) (peso 0) (importe ?importe&:(> ?importe 0))) (suplementos (exceso-peso-minimo ?peso-minimo) (importe-peso-minimo ?importe-peso-minimo) (exceso-peso-margen ?margen) (importe-margen ?importe-margen)) => (printout t crlf "Peso?: ") (bind ?peso (read)) (if (> ?peso ?peso-minimo) then (bind ?importe (+ ?importe ?importe-peso-minimo)) (bind ?exceso (div (- ?peso ?peso-minimo) ?margen)) (if (> ?exceso 0) then (bind ?importe (+ ?importe (* ?exceso ?importe-margen)))) ) (modify ?e (peso ?peso) (importe ?importe)) ) ; Regla final que termina presentando el coste del envio. (defrule presenta-importe "presenta el coste del envio" (declare (salience -10)) ?e <- (envio (importe ?importe)) => (printout t crlf "El coste del envío es: " ?importe crlf) )
Supóngase una agencia de viajes que ofrece viajes de trenes a sus clientes. Los viajes tienen unos atributos como son: el lugar de origen y el lugar de destino y una tarifa inicial que se utilizará para calcular el precio final del viaje. Los viajes en tren se caracterizan por el tipo de tren (AVE o TALGO), por la clase (turista o preferente), por el período de salida (blanco, rojo o azul) y el tipo de cliente (asiduo o esporádico). Sin descuentos ni incrementos, los precios de un viaje en clase turista, entre dos ciudades, son los siguientes y dependen del tipo de tren. COSTE (euros) ORIGEN
DESTINO
AVE
TALGO
Madrid
Córdoba
70
60
Madrid
Sevilla
80
70
Barcelona
Madrid
---
80
…
…
El precio sería el mismo para el viaje Barcelona-Madrid que para el viaje Madrid-Barcelona. Se utilizan las siguientes reglas para calcular el precio final: o Si el viaje es en clase preferente, los precios de la tabla se ven incrementados en un 30% o o o o o
Si la fecha de salida es azul, el precio del billete se reduce en un 10% y si es roja se incrementa en un 10%. Si el cliente es asiduo, el precio se reduce en un 10% Si el viajero es menor de 22 años (tarifa joven), se le aplica un 20% de reducción. Si el viajero es mayor de 65 años (tarifa dorada), se le aplica un 50% de reducción. Los descuentos y suplementos se aplican en el orden establecido en el enunciado.
Usando Clips: 5.1. Definir la base de hechos Construir la base de reglas que formalice dichos conocimientos utilizando el menor número de reglas posible. Esto debe realizarse de tal forma que sea fácil añadir y borrar reglas en el sistema, y modificar los incrementos y descuentos sin modificar la base de reglas. 5.3. Construir las reglas para la introducción de los datos del viaje y muestren el importe correspondiente. 5.2.
;Definición de la estructuras de datos (deftemplate trayecto "Trayecto y tipo" (slot origen) (slot destino) (slot tipo-transporte) (slot importe (type INTEGER)) ) (deftemplate billete "Datos billete" (slot origen) (slot destino) (slot tipo-transporte (type SYMBOL)) (slot preferente? (type SYMBOL)) (slot edad-viajero (type INTEGER)) (slot tipo-dia (type SYMBOL)) (slot asiduo? (type SYMBOL)) (slot tarifa-edad (type SYMBOL)) (slot importe (type INTEGER)) ) (deftemplate suplementos "suplemento que se paga por entrega rápida" (slot preferente (type FLOAT)) (slot dia-azul (type FLOAT)) (slot dia-rojo (type FLOAT)) (slot viajero-asiduo (type FLOAT)) (slot tarifa-joven (type FLOAT)) (slot tarifa-dorada (type FLOAT)) (slot exceso-peso-margen (type INTEGER)) (slot importe-margen (type INTEGER)) ) (deffacts tarifas (trayecto (origen Madrid) (destino Cordoba) (tipo-transporte A) (importe 70)) (trayecto (origen Madrid) (destino Cordoba) (tipo-transporte T) (importe 60)) (trayecto (origen Madrid) (destino Sevilla) (tipo-transporte A) (importe 80)) (trayecto (origen Madrid) (destino Sevilla) (tipo-transporte T) (importe 70)) (trayecto (origen Barcelona) (destino Madrid) (tipo-transporte T) (importe 80)) (suplementos (preferente 0.3) (dia-azul -0.1) (dia-rojo 0.1) (viajeroasiduo -0.1) (tarifa-joven -0.1) (tarifa-dorada -0.5 )) ; desglose de edades (edad-joven 22) (edad-mayor 65) ) ;************************************* ;DEFINICIÓN DE REGLAS ;******************************************** ;Regla que plantea de forma muy simple el menú de acciones que se desean FLOATizar: ;origen, destino, y tipo de paquete
;pregunta la urgencia del envío (urgente o no) ;si es paquete pide el peso (defrule pide-datos "Pide los datos del envio" ?i <- (initial-fact) (edad-joven ?joven) (edad-mayor ?mayor) => (printout t crlf "Datos del billete" crlf) (printout t crlf "Origen: " ) (bind ?origen (read)) (printout t crlf "Destino: ") (bind ?destino (read)) (printout t crlf "Tipo de tren, AVE (A) o Talgo (T): ") (bind ?tipo-transporte (read)) (printout t crlf "Viaja en preferente (S/N): ") (bind ?preferente? (read)) (printout t crlf "La fecha del viaje es dia Normal (N), Azul (A) o Rojo (R): ") (bind ?tipo-dia (read)) (printout t crlf "Es viajero asiduo (S/N): ") (bind ?asiduo? (read)) (printout t crlf "Edad del viajero (años): ") (bind ?edad (read)) (if (< ?edad ?joven) then (assert (billete (origen ?origen) (destino ?destino) (tipotransporte ?tipo-transporte) (preferente? ?preferente?) (tipo-dia ?tipo-dia) (asiduo? ?asiduo?) (tarifa-edad J) (importe 0))) else (if (> ?edad ?mayor) then (assert (billete (origen ?origen) (destino ?destino) (tipotransporte ?tipo-transporte) (preferente? ?preferente?) (tipo-dia ?tipo-dia) (asiduo? ?asiduo?) (tarifa-edad D) (importe 0))) else (assert (billete (origen ?origen) (destino ?destino) (tipotransporte ?tipo-transporte) (preferente? ?preferente?) (tipo-dia ?tipo-dia) (asiduo? ?asiduo?) (tarifa-edad N) (importe 0))) ) ) (retract ?i) (assert (trayecto-tipo)) ) (defrule calcula-importe-trayecto-tipo-tren "calcula el importe en función del origen, destino y tipo de transporte" ?i <- (trayecto-tipo) ?e <- (billete (origen ?origen) (destino ?destino) (tipo-transporte ?tipo) ) (trayecto (origen ?origen) (destino ?destino) (tipo-transporte ?tipo) (importe ?importe)) => (modify ?e (importe ?importe)) (retract ?i) (assert (clase)) ) (defrule suma-clase "acumula el importe de clase preferente, si lo es" ?i <- (clase) ?e <- (billete (preferente? S) (importe ?importe)) (suplementos (preferente ?preferente))
=> (modify ?e (importe (* ?importe (+ 1 ?preferente)))) (retract ?i) (assert (tipo-dia)) ) (defrule suma-tipo-dia "acumula el importe en funcion del tipo de dia" ?i <- (tipo-dia) ?e <- (billete (tipo-dia ?tipo-dia) (importe ?importe)) (suplementos (dia-rojo ?dia-rojo) (dia-azul ?dia-azul)) => (if (eq ?tipo-dia A) then (modify ?e (importe (* ?importe (+ 1 ?diaazul))))) (if (eq ?tipo-dia R) then (modify ?e (importe (* ?importe (+ 1 ?diarojo))))) (retract ?i) (assert (tipo-viajero)) ) (defrule suma-tipo-viajero "acumula el importe segun si es asiduo o no lo es" ?i <- (tipo-viajero) ?e <- (billete (origen ?origen) (destino ?destino) (asiduo? S) (importe ?importe)) (suplementos (viajero-asiduo ?viajero-asiduo)) => (modify ?e (importe (* ?importe (+ 1 ?viajero-asiduo)))) (retract ?i) (assert (tipo-edad)) ) (defrule suma-edad-viajero "acumula el importe segun la tarifa aplicable segun la edad" ?i <- (tipo-edad) ?e <- (billete (tarifa-edad ?tarifa-edad) (importe ?importe)) (suplementos (tarifa-joven ?tarifa-joven) (tarifa-dorada ?tarifa-dorada)) => (if (eq ?tarifa-edad J) then (modify ?e (importe (* ?importe (+ 1 ?tarifa-joven))))) (if (eq ?tarifa-edad D) then (modify ?e (importe (* ?importe (+ 1 ?tarifa-dorada))))) (retract ?i) (assert (calcula-total)) ) ; Regla final que termina presentando el coste del envio. (defrule presenta-importe "presenta el precio final del billete" ?i <- (calcula-total) (billete (importe ?importe)) => (printout t crlf "El precio del billete es: " ?importe crlf) (retract ?i) )
Se pretende construir un sistema que aconseje a un usuario la compañía (de entre dos contratadas) más barata para cada llamada. El sistema debería preguntar si la llamada es local o interprovincial, la duración estimada, y el día y la hora de comienzo. Los precios de la compañía AAT son: Las llamadas locales tienen una tarifa mínima de 0,1 euros, e incluye los dos primeros minutos. Los siguientes minutos son: de lunes a viernes, de 8 a 18 hs, a 0,02 euros y de 18 a 8 hs. de 0,01 euros. Los sábados y domingos, todo el día a 0,01 euros. Las llamadas interprovinciales tienen una tarifa mínima de 0,25 euros que también incluye solamente el primer minuto. Cada uno de los siguientes minutos cuesta: de lunes a viernes, de 8 a 22 hs, a 0,3 euros y de 22 a 8 hs. de 0,2 euros. Los sábados y domingos, todo el día a 0,2 euros el minuto. Los precios de la compañía BBT son: Las llamadas locales tienen una tarifa mínima de 0,04 euros, pero no incluye ningún minuto. Cada minuto de lunes a viernes cuesta, de 8 a 20 hs, a 0,03 euros y de 20 a 8 hs. de 0,01 euros. Los sábados y domingos, todo el día a 0,01 euros. Las llamadas interprovinciales tienen una tarifa mínima de 0,1 euros, que tampoco incluye ningún minuto. Cada minutos cuesta: de lunes a viernes, de 8 a 20 hs, a 0,3 euros y de 20 a 8 hs. de 0,1 euros. Los sábados y domingos, todo el día a 0,1 euros el minuto. Se pide construir el sistema en Clips. Construir la base de hechos y la base de reglas que formalice dichos conocimientos utilizando el menor número de reglas posible.
3.1.
Construir las reglas para la introducción de los datos de la llamada y muestren al usuario el número de la compañía por la cual efectuar la llamada.
3.2.
1era. Versión: ;La solución más adecuada a este tipo de problemas normalmente es la definición de una tabla, y este se podría resolver así, ; como en los anteriores ejercicios. Pero en este, dada la variabilidad de los tipos de datos, vamos a resolverlo de otra forma, ; con reglas que contienen todos los variables, datos y rangos que se utilizan para el calculo de la tarifa (deftemplate llamada "Datos de la llamada tipo" (slot tipo-llamada (type SYMBOL)) (slot dia (type INTEGER)) (slot hora (type INTEGER)) (slot duracion (type INTEGER)) ) ;************************************* ;DEFINICIÓN DE REGLAS ;******************************************** ;Regla que plantea de forma muy simple el menú de acciones que se desean FLOATizar: ;origen, destino, y tipo de paquete ;pregunta la urgencia del envío (urgente o no) ;si es paquete pide el peso (defrule pide-datos "Pide los datos de la llamada" => (printout t crlf "Datos de la llamada tipo" crlf) (printout t crlf "Llamada Local (L) o Interprovincial (I)?: ") (bind ?tipo-llamada (read)) (printout t crlf "El dia habitual de la llamada (1 a 7)?: ") (bind ?dia (read)) (printout t crlf "La hora habitual de la llamada (1 a 24)?: ") (bind ?hora (read)) (printout t crlf "Duracion de la llamada: ") (bind ?duracion (read)) (assert (llamada (tipo-llamada ?tipo-llamada) (dia ?dia) (hora ?hora) (duracion ?duracion))) ) (defrule calcula-importe-segun-la-telefonica-AAT "calcula el importe en función del tipo de llamada, duración y dia y hora de AAT" ?e <- (llamada (tipo-llamada ?tipo) (dia ?dia) (hora ?hora) (duracion ?duracion)) => (if (eq ?tipo L) then (bind ?importe 0.1) (if (> ?duracion 2) then (bind ?duracion (- ?duracion 2)) (if (and (>= ?dia 1) (<= ?dia 5) (>= ?hora 8) (< ?hora 18)) then (bind ?importe (+ ?importe (* ?duracion 0.02)))) (if (and (>= ?dia 1) (<= ?dia 5) (or (>= ?hora 18) (< ?hora 8))) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) (if (and (>= ?dia 6) (<= ?dia 7)) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) )
) (if (eq ?tipo I) then (bind ?importe 0.25) (if (> ?duracion 1) then (bind ?duracion (- ?duracion 1)) (if (and (>= ?dia 1) (<= ?dia 5) (>= ?hora 8) (< ?hora 22)) then (bind ?importe (+ ?importe (* ?duracion 0.03)))) (if (and (>= ?dia 1) (<= ?dia 5) (or (>= ?hora 22) (< ?hora 8))) then (bind ?importe (+ ?importe (* ?duracion 0.02)))) (if (and (>= ?dia 6) (<= ?dia 7)) then (bind ?importe (+ ?importe (* ?duracion 0.02)))) ) ) (printout t crlf "El importe de la llamada tipo en AAT es: " ?importe crlf crlf) ) (defrule calcula-importe-segun-la-telefonica-BBT "calcula el importe en función del tipo de llamada, duración y dia y hora de BBT" ?e <- (llamada (tipo-llamada ?tipo) (dia ?dia) (hora ?hora) (duracion ?duracion)) => (if (eq ?tipo L) then (bind ?importe 0.04) (if (and (>= ?dia 1) (<= ?dia 5) (>= ?hora 8) (< ?hora 20)) then (bind ?importe (+ ?importe (* ?duracion 0.03)))) (if (and (>= ?dia 1) (<= ?dia 5) (or (>= ?hora 20) (< ?hora 8))) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) (if (and (>= ?dia 6) (<= ?dia 7)) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) ) (if (eq ?tipo I) then (bind ?importe 0.1) (if (and (>= ?dia 1) (<= ?dia 5) (>= ?hora 8) (< ?hora 22)) then (bind ?importe (+ ?importe (* ?duracion 0.03)))) (if (and (>= ?dia 1) (<= ?dia 5) (or (>= ?hora 22) (< ?hora 8))) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) (if (and (>= ?dia 6) (<= ?dia 7)) then (bind ?importe (+ ?importe (* ?duracion 0.01)))) ) (printout t crlf "El importe de la llamada tipo en BBT es: " ?importe crlf crlf) )
2da. Versión: ; Antes hemos resuelto este mismo problema con una reglas para cada telefonica que incluyen todas sus tarifas ; Ahora lo resolveremos mediante una tabla sencilla. Se puede hacer más complejo, de forma que admita todas las ; posibilidades de tarifas (es un recomendable ejercicio). Pero esta es una solución intermedia. (deftemplate llamada "Datos de la llamada tipo" (slot tipo-llamada (type SYMBOL)) (slot dia (type INTEGER)) (slot hora (type INTEGER)) (slot duracion (type INTEGER)) )
(deftemplate tarifa "datos de cada telefonica" (slot telefonica (type SYMBOL)) (slot tipo-llamada (type SYMBOL)) (slot establecimiento-llamada (type FLOAT)) (slot franquicia (type INTEGER)) (slot inicio-noche-laborable (type INTEGER)) (slot minuto-laborable-noche (type FLOAT)) (slot inicio-dia-laborable (type INTEGER)) (slot minuto-laborable-dia (type FLOAT)) (slot minuto-festivo (type FLOAT)) ) (deffacts tarifas-telefonicas "datos de las tarifas de las diferentes telefonicas" (tarifa (telefonica AAT) (tipo-llamada L) (establecimiento-llamada 0.1) (franquicia 2) (inicio-noche-laborable 18) (minuto-laborable-noche 0.01) (inicio-dia-laborable 8) (minuto-laborable-dia 0.02) (minuto-festivo 0.01)) (tarifa (telefonica AAT) (tipo-llamada I) (establecimiento-llamada 0.25) (franquicia 1) (inicio-noche-laborable 22) (minuto-laborable-noche 0.2) (inicio-dia-laborable 8) (minuto-laborable-dia 0.3) (minuto-festivo 0.2)) (tarifa (telefonica BBT) (tipo-llamada L) (establecimiento-llamada 0.04) (franquicia 0) (inicio-noche-laborable 20) (minuto-laborable-noche 0.03) (inicio-dia-laborable 8) (minuto-laborable-dia 0.01) (minuto-festivo 0.01)) (tarifa (telefonica BBT) (tipo-llamada I) (establecimiento-llamada 0.1) (franquicia 0) (inicio-noche-laborable 20) (minuto-laborable-noche 0.3) (inicio-dia-laborable 8) (minuto-laborable-dia 0.1) (minuto-festivo 0.1)) ) ;************************************* ;DEFINICIÓN DE REGLAS ;******************************************** ;Regla que plantea de forma muy simple el menú de acciones que se desean FLOATizar: ;origen, destino, y tipo de paquete ;pregunta la urgencia del envío (urgente o no) ;si es paquete pide el peso (defrule pide-datos "Pide los datos de la llamada" => (printout t crlf "Datos de la llamada tipo" crlf) (printout t crlf "Llamada Local (L) o Interprovincial (I)?: ") (bind ?tipo-llamada (read)) (printout t crlf "El dia habitual de la llamada (1 a 7)?: ") (bind ?dia (read)) (printout t crlf "La hora habitual de la llamada (1 a 24)?: ") (bind ?hora (read))
(printout t crlf "Duracion de la llamada: ") (bind ?duracion (read)) (assert (llamada (tipo-llamada ?tipo-llamada) (dia ?dia) (hora ?hora) (duracion ?duracion))) ) (defrule calcula-importe-segun-la-telefonica "calcula el importe en función del tipo de llamada, duración y dia y hora" ?e <- (llamada (tipo-llamada ?tipo) (dia ?dia) (hora ?hora) (duracion ?duracion)) (tarifa (telefonica ?telefonica) (tipo-llamada ?tipo) (establecimientollamada ?est) (franquicia ?franquicia) (inicio-noche-laborable ?inicio-noche-laborable) (minuto-laborablenoche ?minuto-laborable-noche) (inicio-dia-laborable ?inicio-dia-laborable) (minuto-laborable-dia ?minuto-laborable-dia) (minuto-festivo ?minuto-festivo)) => (bind ?importe ?est) (if (> ?duracion ?franquicia) then (bind ?duracion (- ?duracion ?franquicia)) (if (and (>= ?dia 1) (<= ?dia 5) (>= ?hora ?inicio-dia-laborable) (< ?hora ?inicio-noche-laborable)) then (bind ?importe (+ ?importe (* ?duracion 0.02)))) (if (and (>= ?dia 1) (<= ?dia 5) (or (>= ?hora ?inicio-nochelaborable) (< ?hora ?inicio-dia-laborable))) then (bind ?importe (+ ?importe (* ?duracion ?minuto-laborable-noche)))) (if (and (>= ?dia 6) (<= ?dia 7)) then (bind ?importe (+ ?importe (* ?duracion ?minuto-festivo)))) ) (printout t crlf "El importe de la llamada tipo en " ?telefonica " es: " ?importe crlf crlf) )
Dentro del problema global de un juego de ajedrez:
1 Definir una plantilla "ficha" que sirva para almacenar los datos relativos a las diferentes piezas de ajedrez que se encuentran sobre el tablero: tipo de pieza, color y posición que ocupa. 2 Definir las reglas que sean necesarias para la generacion de todas las casillas del tablero, almacenándolas en hechos de la forma (casilla ) . 3 Definir las reglas que sean necesarias para eliminar las casillas que estén ocupadas. Asúmase para ello que se han generado los hechos del 3.1. 4 Definir las reglas que sean necesarias para eliminar las casillas que son amenazadas por alguna de las piezas blancas colocadas. Para simplificar, considerar únicamente amenazas procedentes de reyes, peones y torres. 5 Defina la regla/s para visualizar las casillas libres y no amenazadas. Resolución del ejercicio 1 (deftemplate ficha (slot tipo (type SYMBOL) (allowed-values peon torre alfil caballo rey reina)) (slot color (type SYMBOL) (allowed-values blanca negra)) (slot posicion_h (type INTEGER) (range 1 8)) (slot posicion_v (type INTEGER) (range 1 8)))
2 (defrule inicio (initial-fact) => (bind ?i 1) (while (< ?i 9) (bind ?j 1) (while (< ?j 9) (assert (casilla ?i ?j)) (bind ?j (+ ?j 1)) ) (bind ?i (+ ?i 1)) ) )
3 (defrule eliminar_ocupadas (ficha (posicion_h ?i) (posicion_v ?j)) ?ocupada <- (casilla ?i ?j) => (retract ?ocupada) )
4 ;el enunciado no diferencia, para eliminar las casillas amenazadas,
;de si trata de una amenaza blanca o negra sobre el contrario, ;asumamos que las blancas avanzan en sentido creciente del indice del tablero (defrule eliminar_amenazadas_peon (ficha (tipo peon)(color blanca) (posicion_h ?i) (posicion_v ?j)) ?amenazada <- (casilla ?k ?l) (or (and (test(= ?l (+ ?i 1))) (test(= ?k (+ ?j 1)))) (and (test(= ?l (- ?- 1))) (test(= ?k (+ ?j 1)))) ) => (retract ?amenazada) ) ;la siguiente regla podría haberse diferenciado en 8 (defrule eliminar_amenazadas_rey (ficha (tipo rey)(color blanca) (posicion_h ?i) (posicion_v ?j)) ?amenazada <- (casilla ?k ?l) (or (and (test(= ?l (+ ?j 1))) (test (= ?k ?i))) (and (test(= ?l (- ?j 1))) (test (= ?k ?i))) (and (test(= ?l ?j)) (test (= ?k (+ ?i 1)))) (and (test(= ?l ?j)) (test (= ?k (- ?i 1)))) (and (test(= ?l (+ ?j 1))) (test(= ?k (+ ?i 1)))) (and (test(= ?l (+ ?j 1))) (test(= ?k (- ?i 1)))) (and (test(= ?l (- ?j 1))) (test(= ?k (+ ?i 1)))) (and (test(= ?l (- ?j 1))) (test(= ?k (- ?i 1)))) ) => (retract ?amenazada) ) ; para eliminar las celdas amenazadas por la torre (defrule eliminar_amenazadas_torre_1 (ficha (tipo torre)(color blanca) (posicion_h ?i) (posicion_v ?j)) ?amenazada <- (casilla ?i ?k) (test (> ?k ?j)) => (retract ?amenazada) ) ;Esta solución pasa por alto la posibilidad de que alguna ficha, ;en la misma columna que la torre "amenazante", impida que la torre ;amenace el resto posterior de la columna. Para solucionar esto, lo más práctico ;sería diferencia entre celda ocupada y celda simplemente amenazada.
5 (defrule mensaje (declare (salience -10)) => (printout t "Han quedado libres las siguientes casillas" crlf))
(defrule casillas (declare (salience -20)) (casilla ?i ?j)
=> (printout t "(" ?i " , " ?j ")
(defrule terminacion (declare (salience -30)) => (printout t crlf))
"))
Se dispone de dos cántaros de agua, uno de 4 litros y otro de 3 litros de capacidad, siendo ésta la única información que se tiene de los mismos. Existe una bomba de agua con la que se pueden llenar los cántaros. Se desea que el cántaro de 4 ls. de capacidad quede lleno por la mitad y el de 3 ls. vacío. Este es un ejemplo planteable como problema de búsqueda en un espacio de estados. Este espacio consistiría del conjunto de pares de enteros (x, y), tal que x = 0, 1, 2, 3 o 4 e y = 0, 1, 2 o 3, donde x e y representan el número de litros de agua que hay en los cántaros de 4 y 3 litros respectivamente. Se considerará que el estado inicial es (0, 0) y el estado meta (2, 0). En cuanto a los operadores que se pueden aplicar a los estados descritos con anterioridad, pueden definirse los siguientes:
a. Llenar el cántaro de 4 ls.: Si (x, y) and x < 4 entonces (4, y) b. Llenar el cántaro de 3 ls.: Si (x, y) and y < 3 entonces (x, 3) c. Vaciar en el suelo el cántaro de 4 l.: Si (x, y) and x > 0 entonces (0, y) d. Vaciar en el suelo el cántaro de 3 ls.: Si (x, y) and y > 0 (x, 0) e. Verter agua del cántaro de 3 ls. al de 4 hasta llenarlo: Si (x, y) and x + y ≥ 4 and y > 0 and x < 4 entonces (4, y − (4 − x)) f. Verter agua del cántaro de 4 ls. al de 3 hasta llenarlo : Si (x, y) and si x + y ≥ 3 and x > 0 and y < 3 entonces (x − (3 − y), 3) g. Verter todo el agua del cántaro de 3 ls. al de 4 : Si (x, y) and x + y ≤ 4 and y > 0 entonces (x + y, 0) h. Verter todo el agua del cántaro de 4 ls. al de 3 : Si (x, y) and x + y ≤ 3 and x > 0 entonces (0, x + y) ¿Cómo llevarías a un programa Clips la resolución de este problema, considerada la solución del mismo como la obtención de un hecho que represente la distribución de litros planteada como objetivo desde el hecho que representa la distribución inicial?
1. ¿Cómo representaría el contenido y capacidad de las jarras? 2. ¿Y de los operadores? 3. ¿Cómo determinarías el final del proceso? 4. ¿Podría (y cómo) generalizarse la resolución para una jarra A de capacidad A1 y otra jarra B con capacidad B1 y obtener A2 litros en la primera y B2 litros en la segunda? ¿podría plantearse algún dificultad en la resolución? 5. La verdadera resolución de este tipo de problemas es encontrar y mostrar (imprimir, por ejemplo) la secuencia de operadores que conducen al objetivo. ¿Cómo podría hacerse aquí? Resolución del ejercicio. (deftemplate cantaros (slot profundidad (slot padre (type (slot contenido_4 (slot contenido_3 (ultimo_mov (type )
(type INTEGER) (range 1 ?VARIABLE)) FACT-ADDRESS SYMBOL) (allowed-symbols sin-padre)) (type INTEGER)) (type INTEGER) STRING))
(deffacts cantaros_inicio (cantaros (contenido_4 0) (contenido_3 0)) ) (defrule llena_4 (declare (salience 510)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(< ?c4 4)) (contenido_3 ?c3)) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 4) (contenido_3 ?c3) (ultimo_mov "llena 4))) (printout t "llena_4" crlf) ) (defrule llena_3 (declare (salience 510)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4) (contenido_3 ?c3&:(< ?c3 3))) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 ?c4) (contenido_3 3))) (printout t "llena_3" crlf) ) (defrule vacia_4 (declare (salience 500)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(> ?c4 0)) (contenido_3 ?c3)) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 0)(contenido_3 ?c3))) (printout t "vacia_4" crlf) ) (defrule vacia_3 (declare (salience 500)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4)(contenido_3 ?c3&:(> ?c3 0))) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 ?c4) (contenido_3 0))) (printout t "vacia_3" crlf) ) (defrule llenar_3_con_4 (declare (salience 515)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(> ?c4 0)) (contenido_3 ?c3&:(< ?c3 3))) (test (>= (+ ?c3 ?c4) 3)) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 (?c4 (- 3 ?c3))) (contenido_3 3))) (printout t "llenar_3_con_4" crlf)
) (defrule llenar_4_con_3 (declare (salience 515)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(< 4)) (contenido_3 ?c3&:(> ?c3 0))) (test (>= (+ ?c3 ?c4) 4)) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 (contenido_3 (- ?c3 (- 4 ?c4))))) (printout t "llenar_4_con_3" crlf) ) (defrule verter_3_en_4 (declare (salience 515)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(< 4)) (contenido_3 ?c3&:(> ?c3 0))) (test (< (+ ?c3 ?c4) 4)) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 ?c4 ?c3)) (contenido_3 0))) (printout t "verter_3_en_4" crlf) ) (defrule verter_4_en_3 (declare (salience 515)) ?h <- (cantaros (profundidad ?pf) (padre ?p) (contenido_4 ?c4&:(> 0)) (contenido_3 ?c3&:(< ?c3 3))) (test (< (+ ?c3 ?c4) 4)) (printout t "verter_4_en_3" crlf) => (assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 (contenido_3 (+ ?c4 ?c3)))) )
?c4
4)
?c4
(+
?c4
0)
(defrule elimina-circularidad (declare (salience 520)) (cantaros (profundidad ?pf1) (contenido_4 ?c4) (contenido_3 ?c3)) ?h <-(cantaros (profundidad ?pf2&:(< ?pf1 ?pf2)) (contenido_4 ?c4) (contenido_3 ?c3)) => (retract ?h) ) (defrule finaliza (declare (salience 520)) (cantaros (contenido_4 2) (contenido_3 0)) => (printout t "Conseguido" crlf) (halt) )
Las siguientes reglas de sustitución de símbolos pueden usarse para reemplazar la cifra de la izquierda por la tira de cifras a su derecha: 2 → 11
3 → 21
4 → 31
5 → 32
Codificar en Clips un sistema que permita la traducción de un número compuesto de varias cifras (del 1 al 5) según las reglas anteriores. Para ello podrían ser útiles las siguientes funciones: (str-index ): devuelve la posición del primer string dentro del segundo. (sub-string ): devuelve la porción del string que comienza en la posición integer-1 y termina en la posición integer-1 + integer-2. (str-cat *) : Concatena los strings argumento
Resolución del ejercicio. (deffacts datos-a-traducir (vector 3 2 1) (tabla 2 1 1) (tabla 3 2 1) (tabla 4 3 1) ) (defrule traduce ?cadena <- (vector $?ini ?x $?fin) (tabla ?x ?y1 ?y2) => (retract ?cadena) (assert (vector $?ini ?y1 ?y2 $?fin)) ) (defrule imprime-cadenas (vector $?datos) => (printout t "una salida es: "$?datos crlf))
Una solución alternativa: (deftemplate traduccion (slot numero (type STRING)) ) (deftemplate cifra (slot entrada) (slot salida) ) (deffacts entrada_salida
(traduccion (numero "0")) ) (deffacts tabla-traduccion (cifra (entrada "2") (salida "11")) (cifra (entrada "3") (salida "21")) (cifra (entrada "4") (salida "31")) ) (defrule pide_valor ?f1 <- (traduccion (numero "0")) => (printout t "Introduzca numero: " crlf) (modify ?f1 ( numero (read)))) (defrule traduce_i (cifra (entrada ?i)(salida ?o)) ?f1 <- (traduccion (numero ?numero)) (test (neq (str-index ?i ?numero) FALSE )) => (bind ?long (str-length ?numero)) (bind ?posicion (str-index ?i ?numero)) (bind ?numero (str-cat (sub-string 1 (- ?posicion 1) ?numero) ?o (sub-string (+ ?posicion 1) ?long ?numero))) (printout t "una salida es: " ?numero crlf) (modify ?f1 (numero ?numero)) )
Dados los datos del siguiente esquema,
Juan Rodriguez
Ana Lopez casados
hijos
Jose Perez
Elena Rodriguez
Javier Rodriguez
casados
Eva Garcia casados
hijos
Jaime Perez
hijos
Rut Rodriguez
codificar en Clips un sistema que permita inferir: •
Si una persona tiene un cónyuge que está vivo, entre sus herederos se incluirá al cónyuge.
•
Si una persona tiene hijos que están vivos, estos se incluirán entre sus herederos.
•
Si una persona tiene un descendiente (hijo) que tiene hijos, los hijos del descendiente serán sus herederos siempre que el cónyuge y sus hijos hayan fallecido.
•
Si una persona no tiene hijos ni cónyuge ni padres vivos, sus herederos serán los herederos de sus padres.
Resolución del ejercicio. (deftemplate persona (slot id (type SYMBOL)) (slot nombre (type STRING)) (slot apellidos (type STRING)) (slot conyuge (type SYMBOL)) ; Id del cónyuge (multislot padres (type SYMBOL) (cardinality 2 2)) ; Ids de los padres (multislot hijos (type SYMBOL)) ; Ids de los hijos (slot vivo (allowed-values SI NO) (default SI))) Se han insertado como vivas a las siguientes personas: (deffacts arbol-genealogico (persona (id juan) (nombre "Juan") (apellidos "Rodríguez") (conyuge ana) (hijos elena javier)
(vivo NO)) (persona (id ana) (nombre "Ana") (apellidos "López") (conyuge juan) (hijos elena javier) (vivo NO)) (persona (id jose) (nombre "José") (apellidos "Pérez") (conyuge elena) (hijos jaime belen alba) (vivo NO)) (persona (id elena) (nombre "Elena") (apellidos "Rodríguez") (conyuge jose) (padres juan ana) (hijos jaime belen alba) (vivo NO)) (persona (id javier) (nombre "Javier") (apellidos "Rodríguez") (conyuge eva) (padres juan ana) (hijos rut mar) (vivo NO)) (persona (id eva) (nombre "Eva") (apellidos "García") (conyuge javier) (hijos rut mar)) (persona (id jaime) (nombre "Jaime") (apellidos "Pérez") (padres jose elena) (vivo NO)) (persona (id belen) (nombre "Belén") (apellidos "Pérez") (padres jose elena)) (persona (id alba) (nombre "Alba") (apellidos "Pérez") (padres jose elena)) (persona (id rut) (nombre "Rut")
(apellidos "Rodríguez") (padres javier eva)) (persona (id mar) (nombre "Mar") (apellidos "Rodríguez") (padres javier eva) (vivo NO))) ; Secuenciación de tareas de búsqueda de herederos (deffacts secuencia-tareas (siguiente buscar-conyuge buscar-hijo) (siguiente buscar-hijo buscar-nieto) (siguiente buscar-nieto buscar-padre) (siguiente buscar-padre buscar-herederos-padres) (siguiente buscar-herederos-padres sin-herederos)) ; ; REGLAS "EXPERTAS" ; ; Inicialización. Calcularemos los herederos para cada persona fallecida (defrule inicializar (persona (id ?id) (vivo NO)) => (assert (tarea buscar-conyuge ?id))) ; Si el conyuge está vivo, formará parte de sus herederos (defrule buscar-conyuge (tarea buscar-conyuge ?id) (persona (id ?id) (conyuge ?id-conyuge)) (persona (id ?id-conyuge) (vivo SI)) => (assert (heredero ?id ?id-conyuge))) ; Los hijos vivos, formarán parte de sus herederos (defrule buscar-hijo (tarea buscar-hijo ?id) (persona (id ?id) (hijos $?hijos)) (persona (id ?id-hijo&: (member$ ?id-hijo $?hijos)) (vivo SI)) => (assert (heredero ?id ?id-hijo))) ; Si el cónyuge y todos los hijos han muerto, heredarán sus nietos (defrule buscar-nieto (tarea buscar-nieto ?id) (persona (id ?id) (conyuge ?id-conyuge) (hijos $?hijos)) (persona (id ?id-conyuge) (vivo NO)) (forall (persona (id ?id-hijo&: (member$ ?id-hijo $?hijos))) (persona (id ?id-hijo) (vivo NO))) (persona (id ?id-hijo) (hijos $?nietos)) (persona (id ?id-nieto&: (member$ ?id-nieto $?nietos)) (vivo SI)) => (assert (heredero ?id ?id-nieto))) ; Si no tiene cónyuge ni hijos, heredarán sus padres vivos
(defrule buscar-padre (tarea buscar-padre ?id) (persona (id ?id) (conyuge nil) (hijos) (padres $?padres)) (persona (id ?id-padre&: (member$ ?id-padre $?padres)) (vivo SI)) => (assert (heredero ?id ?id-padre))) ; Lo mismo si el cónyuge, todos los hijos y nietos han muerto (defrule buscar-padre2 (tarea buscar-padre ?id) (persona (id ?id) (conyuge ?id-conyuge) (hijos $?hijos) (padres $?padres)) (not (heredero ?id ?)) (persona (id ?id-padre&: (member$ ?id-padre $?padres)) (vivo SI)) => (assert (heredero ?id ?id-padre))) ; Finalmente, si no tiene cónyuge, ni hijos, y sus padres se conocen pero han muerto, ; heredarán los herederos de sus padres (defrule buscar-herederos-padres (tarea buscar-herederos-padres ?id) (persona (id ?id) (conyuge nil) (hijos) (padres $?padres)) (forall (persona (id ?id-padre&: (member$ ?id-padre $?padres))) (persona (id ?id-padre) (vivo NO))) (heredero ?id-padre&: (member$ ?id-padre $?padres) ?heredero-padre& ~Estado) => (assert (heredero ?id ?heredero-padre))) ; Lo mismo si el cónyuge, todos los hijos, nietos y padres han muerto (defrule buscar-herederos-padres2 (tarea buscar-herederos-padres ?id) (persona (id ?id) (conyuge ?id-conyuge) (hijos $?hijos) (padres $?padres)) (not (heredero ?id ?)) (forall (persona (id ?id-padre&: (member$ ?id-padre $?padres))) (persona (id ?id-padre) (vivo NO))) (heredero ?id-padre&: (member$ ?id-padre $?padres) ?heredero-padre& ~Estado) => (assert (heredero ?id ?heredero-padre))) ; Para las personas sin herederos, el Estado se queda con la herencia (defrule sin-herederos (tarea sin-herederos ?id) (not (heredero ?id ?)) => (assert (heredero ?id Estado))) ; ; REGLAS DE CONTROL ; ; Regla con prioridad baja para cambiar de tarea según la secuenciación establecida
; en la base de hechos (defrule siguiente-tarea (declare (salience -100)) ?t <- (tarea ?tarea ?id) (siguiente ?tarea ?siguiente) => (retract ?t) (assert (tarea ?siguiente ?id))) ; Elimina la última tarea de la base de hechos cuando finaliza (defrule ultima-tarea (declare (salience -100)) ?t <- (tarea ?tarea ?id) (not (siguiente ?tarea ?siguiente)) => (retract ?t))
Se desea desarrollar un sistema basado en conocimiento en Clips para la determinación de la terapia adecuada a los síntomas encontrados en el paciente. Para ello se dispone del conocimiento recogido en la siguiente tabla. En ella tenemos una columna para las infecciones, que tienen asociada una terapia genérica (por ejemplo paperas tiene asociada una "terapia de paperas genérica") que en algunos casos se particulariza con alguna otra indicación (por ejemplo para las paperas de adultos) . Infección
Síntomas
Terapia específica
Rubeola
Fiebre de 3 días, glándulas inflamadas y salpullido
Paperas
Fiebre, sudor, glándulas inflamadas y sin salpullido
Suero inmunológico solo para adultos
Sarampión
Fiebre, ojos llorosos, manchas de Koplik, tos y salpullido.
Ganmaglobulina para adultos no mayores de 65 años
Sarampión alemán
Fiebre, ojos llorosos, manchas rosadas, tos, glándulas inflamadas en la nuca e inflamación de oído.
Ganmaglobulina si la paciente esta embarazada.
Varicela
Fiebre, costras y picazón.
Escarlatina
Fiebre, dolor de cabeza, vómitos, salpullido rojo y dolor al tragar.
Penicilina para no alérgicos
Resolución del ejercicio.
Desde luego hay otras formas de resolver el problema e incluso con algo más de estructura en el código, o incluso ahorrando código, pero esta propuesta puede ser aceptable. Los datos iniciales del paciente se introducen como hechos iniciales y se pregunta al usuario por datos complementarios cuando estos son necesarios. (deftemplate paciente (slot adulto (type SYMBOL) (allowed-values SI NO NONE) (default NONE) ) (slot adulto_mayor (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot sexo (type SYMBOL) (allowed-values MASCULINO FEMENINO NONE) (default NONE)) (slot sudor (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot embarazada (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot fiebre (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot fiebre_mas_3_dias (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot glandulas_inflamadas (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot salpullido (type SYMBOL) (allowed-values SI NO) (default NO)) (slot ojos_llorosos (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot manchas_Koplik (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot tos (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot manchas_rosadas (type SYMBOL) (allowed-values SI NO NONE) (default NONE))
(slot glandulas_inflamadas_nuca (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot inflamacion_oido (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot costras (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot picazon (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot dolor_cabeza (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot vomitos (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot salpullido_rojo (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot dolor_tragar (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot alergico_penicilina (type SYMBOL) (allowed-values SI NO NONE) (default NONE)) (slot tipo_infeccion (type SYMBOL)(default NONE)) (slot terapia_especifica (type SYMBOL)(default NONE)) ) (deffacts datos_paciente (paciente (adulto SI) (sexo FEMENINO) (fiebre SI) (ojos_llorosos SI) (manchas_rosadas SI) (tos SI) (glandulas_inflamadas_nuca SI) (inflamacion_oido SI) ) ) (defrule dias_fiebre ?paciente <-(paciente
(fiebre SI) (glandulas_inflamadas SI) (salpullido SI) (fiebre_mas_3_dias NONE)
) => (printout t crlf "Mas de 3 dias de fiebre? ") (modify ?paciente (fiebre_mas_3_dias (read))) ) (defrule pide_salpullido ?salpullido <- (paciente (salpullido SI) (dolor_cabeza SI) (vomitos SI) (dolor_tragar SI) (salpullido_rojo NONE) ) => (printout t "El salpullido es rojo? ") (modify ?salpullido (salpullido_rojo (read))) (printout t crlf)
) (defrule adulto_mayor ?adulto <-(paciente
(adulto SI) (tipo_infeccion sarampion) (adulto_mayor NONE)
) => (printout t crlf "Mas de 65 años? ") (modify ?adulto (adulto_mayor (read))) ) (defrule embarazada ?sexo <-(paciente
(sexo FEMENINO) (tipo_infeccion sarampion_aleman) (embarazada NONE)
) => (printout t crlf "Se encuentra embarazada? ") (modify ?sexo (embarazada (read))) ) (defrule rubeola ?paciente <-(paciente
(fiebre_mas_3_dias SI ) (glandulas_inflamadas SI) (salpullido SI) (tipo_infeccion NONE)
) => (modify ?paciente (tipo_infeccion rubeola)) (printout t crlf "tiene rubeola") ) (defrule paperas ?paciente <-(paciente
(fiebre SI ) (sudor SI) (glandulas_inflamadas SI) (salpullido NO) (tipo_infeccion NONE)
) => (modify ?paciente (tipo_infeccion paperas)) (printout t crlf "tiene paperas") ) (defrule sarampion ?paciente <-(paciente
(fiebre SI ) (ojos_llorosos SI) (manchas_Koplik SI) (tos SI) (salpullido SI) (tipo_infeccion NONE)
) => (modify ?paciente (tipo_infeccion sarampion)) (printout t crlf "tiene sarampion") ) (defrule sarampion_aleman ?paciente <-(paciente
(fiebre SI ) (ojos_llorosos SI)
(manchas_rosadas SI) (glandulas_inflamadas_nuca SI) (inflamacion_oido SI) (tipo_infeccion NONE) ) => (modify ?paciente (tipo_infeccion sarampion_aleman)) (printout t crlf "tiene sarampion aleman") ) (defrule varicela ?paciente <-(paciente
(fiebre SI ) (costras SI) (picazon SI) (tos SI) (tipo_infeccion NONE)
) => (modify ?paciente (tipo_infeccion varicela)) (printout t crlf "tiene varicela" crlf) ) (defrule escarlatina ?paciente <-(paciente
(fiebre SI ) (dolor_cabeza SI) (vomitos SI) (salpullido_rojo SI) (dolor_tragar SI) (tipo_infeccion NONE)
) => (modify ?paciente (tipo_infeccion escarlatina)) (printout t crlf "tiene escarlatina" crlf) ) (defrule suero_paperas_adultos ?paciente <-(paciente (tipo_infeccion paperas ) (adulto SI) (terapia_especifica NONE) ) => (modify ?paciente (terapia_especifica suero_inmunologico)) (printout t crlf "terapia especifica: suero_inmunologico" crlf) ) (defrule ganma_sarampion_menores ?paciente <-(paciente (tipo_infeccion sarampion) (adulto_mayor NO) (terapia_especifica NONE) ) => (modify ?paciente (terapia_especifica ganmaglobulina)) (printout t crlf "terapia especifica: ganmaglobulina" crlf) ) (defrule ganma_sarampion_aleman_embarazada ?paciente <-(paciente (tipo_infeccion sarampion_aleman) (embarazada SI) (terapia_especifica NONE) )
