09 Clips
09 Clips
09 Clips
Operador Precondición/Resultado
Coger (x) Precondición: Sobre mesa (x), libre (x), mano robot vacía
Resultado: Cogido (x)
Dejar (x) Precondición: Cogido (x)
Resultado: Sobre mesa (x), libre (x), mano robot vacía
Montar (x en y) Precondición: Cogido (x), Libre (y)
Resultado: Sobre (y, x), mano robot vacía, libre (x)
Desmontar (x, y) Precondición: Mano robot vacía, sobre (y, x), libre (x)
Resultado: Cogido (x), libre (y)
Solución:
(deftemplate apilado
(slot encima (type SYMBOL))
(slot debajo (type SYMBOL))
)
(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
; 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
DEF
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 <ciudad_1> <ciudad_2> ). 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 A al-oeste-de B)
(ubicada B al-oeste-de C)
(ubicada D al-oeste-de E)
(ubicada E al-oeste-de F)
(ubicada G al-oeste-de H)
(ubicada H al-oeste-de I)
(ubicada A al-norte-de D)
(ubicada D al-norte-de G)
(ubicada B al-norte-de E)
(ubicada E al-norte-de H)
(ubicada C al-norte-de F)
(ubicada F al-norte-de I)
(situacion B F)
(defrule al-sur-de
(defrule al-este-de
(defrule transitiva
(defrule noreste
(defrule noroeste
(defrule sureste
;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))
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 raíz?
Solución:
Solución:
1.
(deffacts hechos
(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)))
)
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 implica 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
(nodo-activo 1)
)
;*************************************
;DEFINICIÓN DE REGLAS
;********************************************
(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)
)
;**************************************
;Regla que ordena las posiciones por anho de la misma forma que la anterior
;**************************************
;**************************************
;**************************************
;Regla que comprueba si hay un matrimonio con un conyuge con la misma profesión
que el padre del otro conyuge
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 .
4.2. 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.4. 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.
;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 ?entrega-
rapida)))
(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 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%.
o Si el cliente es asiduo, el precio se reduce en un 10%
o Si el viajero es menor de 22 años (tarifa joven), se le aplica un 20% de reducción.
o Si el viajero es mayor de 65 años (tarifa dorada), se le aplica un 50% de reducción.
o Los descuentos y suplementos se aplican en el orden establecido en el enunciado.
Usando Clips:
5.1. Definir la base de hechos
5.2. 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.
;Definición de la estructuras de datos
;*************************************
;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
;*************************************
;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
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.
;*************************************
;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
(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 <i> <j>).
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.
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)
)
(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?
2. ¿Y de los operadores?
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?
(deftemplate cantaros
(slot profundidad (type INTEGER) (range 1 ?VARIABLE))
(slot padre (type FACT-ADDRESS SYMBOL) (allowed-symbols sin-padre))
(slot contenido_4 (type INTEGER))
(slot contenido_3 (type INTEGER)
(ultimo_mov (type 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&:(< ?c4
4)) (contenido_3 ?c3&:(> ?c3 0)))
(test (>= (+ ?c3 ?c4) 4))
=>
(assert (cantaros (profundidad (+ 1 ?pf)) (padre ?h) (contenido_4 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&:(< ?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&:(> ?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 0)
(contenido_3 (+ ?c4 ?c3))))
)
(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 <strig-expression> <string-expression>): devuelve la posición del primer string dentro del
segundo.
(sub-string <integer-1-expression> <integer-2-expression> <string-expression>): 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 <string-expression>*) : Concatena los strings argumento
(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))
(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 Eva Garcia
casados casados
hijos hijos
Jaime Perez Rut Rodriguez
(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)))
;
; REGLAS "EXPERTAS"
;
;
; REGLAS DE CONTROL
;
(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)
)
=>
(modify ?paciente (terapia_especifica ganmaglobulina))
(printout t crlf "terapia especifica: ganmaglobulina" crlf)
)
(defrule penicilina_escarlatina_no_alergicos
?paciente <-(paciente (tipo_infeccion escarlatina)
(alergico_penicilina NO)
(terapia_especifica NONE)
)
=>
(modify ?paciente (terapia_especifica penicilina))
(printout t crlf "terapia especifica: penicilina" crlf)
)