(defglobal MAIN ?*manana* = (create$) ?*tarde* = (create$) ?*noche* = (create$) ) (defclass MAIN::Horario "El horario de las actividades" (is-a USER) (role concrete) (multislot noche (type INSTANCE) (cardinality 1 3) (create-accessor read-write)) (single-slot comida_primera (type INSTANCE) (create-accessor read-write)) (multislot tarde (type INSTANCE) (cardinality 1 3) (create-accessor read-write)) (multislot manana (type INSTANCE) (cardinality 1 3) (create-accessor read-write)) (single-slot comida_segunda (type INSTANCE) (create-accessor read-write))) ;;; ######################################################################## ;;; ### Reglas, funciones, etc. para imprimir la planificaci'on ### ;;; ######################################################################## ;; La función "imprime-poco" imprime sólo el nombre y la dirección de una ;; actividad. Usamos para monstrar la planificaión en la pantalla (deffunction MAIN::imprime-poco (?v) (if (eq (nth$ 1 ?v) [nil]) then (printout t "¡ ERROR ! 0 actividades" crlf) (return) ) (if (> (length$ ?v) 0) then (loop-for-count (?i 1 (length ?v)) (printout t "nombre: " (send (nth$ ?i ?v ) get-nombre) crlf) (printout t "direcci'on: " (send (nth$ ?i ?v ) get-direcci'on) crlf) (printout t crlf) ))) ;; Esta función hace la misma como "imprime-poco" pero hay una diferencia: ;; en cada atributo hay sólo una actividad, no es multivaluado. (deffunction MAIN::imprime-comida (?v) (if (eq ?v [nil]) then (printout t "¡ ERROR ! 0 actividades" crlf) (return) ) (printout t "nombre: " (send ?v get-nombre) crlf) (printout t "direcci'on: " (send ?v get-direcci'on) crlf) (printout t crlf) ) (deffunction MAIN::imprime-poco-comida (?v) (if (eq ?v [nil]) then (printout t "¡ ERROR ! 0 actividades" crlf) (return) ) (printout t (send ?v get-nombre) crlf) ) ;; Para imprimir el horario con un message-handler. Se ejecuta cuando se ;; escribe (send [instancia de horario] imprime) (deffunction imprime-muy-poco (?v) (if (eq (nth$ 1 ?v) [nil]) then (printout t "¡ ERROR ! 0 actividades" crlf) (return) ) (if (> (length$ ?v) 0) then (loop-for-count (?i 1 (length ?v)) (printout t (send (nth$ ?i ?v ) get-nombre) " ; ") )) (printout t crlf)) (defmessage-handler MAIN::Horario imprime primary () (printout t "Manana: ") (imprime-muy-poco ?self:manana) (printout t "Tarde : ") (imprime-muy-poco ?self:tarde) (printout t "Noche : ") (imprime-muy-poco ?self:noche) (printout t "Comida primera: ") (imprime-poco-comida ?self:comida_primera) (printout t "Comida segunda: ") (imprime-poco-comida ?self:comida_segunda) ) ;; Esta regla ejecutamos al final para imprimir todos los días de la ;; planificación recomendada (defrule imprimir-planificaci'on (declare (salience -30)) (d'ia ?d) => (loop-for-count (?i 1 ?d) (printout t "D'ia " ?i ": " crlf) (send (symbol-to-instance-name (string-to-field (str-cat "d" ?i))) imprime ) (printout t crlf) )) ;;; ######################################################################## ;;; ### Obtiene una respuesta de entre un conjunto de respuestas posibles### ;;; ######################################################################## (deffunction pregunta (?pregunta $?valores_posibles) (printout t ?pregunta) (bind ?respuesta (read)) (while (not (member ?respuesta ?valores_posibles)) do (printout t ?pregunta) (bind ?respuesta (read)) ) ?respuesta) ;;; ######################################################################## ;;; ### Hace una pregunta a la que hay que responder si o no ### ;;; ######################################################################## (deffunction si-o-no-p (?pregunta) (bind ?respuesta (pregunta ?pregunta si no s n)) (if (or (eq ?respuesta si) (eq ?respuesta s)) then TRUE else FALSE)) ;;; ######################################################################## ;;; ### Hace una pregunta a la que hay que responder si, no, obl o proh ### ;;; ######################################################################## (deffunction todo-pos-p (?pregunta) (bind ?respuesta (pregunta ?pregunta si no s n obligatorio prohibido o p)) (switch ?respuesta (case si then s) (case s then s) (case no then n) (case n then n) (case obligatorio then o) (case o then o) (case prohibido then p) (case p then p) (default none)) ) ;;; ######################################################################## ;;; ### Las preguntas ### ;;; ######################################################################## (defrule determinar-tipo (declare (salience 10)) => (if (si-o-no-p "¿Quieres un viaje tranquilo? (s/n) ") then (assert (tranquilo)) else (assert (no tranquilo))) (if (si-o-no-p "¿Quieres visitar los lugares típicos de Barcelona? (s/n) ") then (assert (local)) else (assert (no local))) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo del cine ### ;;; ######################################################################## (defrule preg-cine ; () => (if (si-o-no-p "¿Quieres opinar sobre cines? (s/n) ") then (assert (cine)) ) ) (defrule preg-cine-original (cine) (no local) => (bind ?respuesta (todo-pos-p "¿Te gusta el cine original? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Cine_Original))) (case o then (assert (obligatorio Cine_Original))) (case p then (assert (prohibido Cine_Original))) ) ) (defrule preg-cine-famoso (cine) => (bind ?respuesta (todo-pos-p "¿Te gusta el cine famoso? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Cine_Famoso))) (case o then (assert (obligatorio Cine_Famoso))) (case p then (assert (prohibido Cine_Famoso))) ) ) (defrule preg-cine-alternativo (cine) => (bind ?respuesta (todo-pos-p "¿Te gusta el cine alternativo? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Cine_Alternativo))) (case o then (assert (obligatorio Cine_Alternativo))) (case p then (assert (prohibido Cine_Alternativo))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo del teatro ### ;;; ######################################################################## (defrule preg-teatro (tranquilo) => (if (si-o-no-p "¿Quieres opinar sobre teatro? (s/n) ") then (assert (teatro)) ) ) (defrule preg-teatro-cl'asico (teatro) => (bind ?respuesta (todo-pos-p "¿Te gusta el teatro clásico? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Teatro_Cl'asico))) (case o then (assert (obligatorio Teatro_Cl'asico))) (case p then (assert (prohibido Teatro_Cl'asico))) ) ) (defrule preg-teatro-improvisaci'on (teatro) => (bind ?respuesta (todo-pos-p "¿Te gusta el teatro improvisación? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Improvisaci'on))) (case o then (assert (obligatorio Improvisaci'on))) (case p then (assert (prohibido Improvisaci'on))) ) ) (defrule preg-teatro-alternativo (teatro) => (bind ?respuesta (todo-pos-p "¿Te gusta el teatro alternativo? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Teatro_Alternativo))) (case o then (assert (obligatorio Teatro_Alternativo))) (case p then (assert (prohibido Teatro_Alternativo))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo del museo ### ;;; ######################################################################## (defrule preg-museo (tranquilo) (local) => (if (si-o-no-p "¿Quieres opinar sobre los museos? (s/n) ") then (assert (museo)) ) ) (defrule preg-museo-historia (museo) => (bind ?respuesta (todo-pos-p "¿Te gusta el museo historia? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Historia))) (case o then (assert (obligatorio Historia))) (case p then (assert (prohibido Historia))) ) ) (defrule preg-museo-arte (museo) => (bind ?respuesta (todo-pos-p "¿Te gusta el museo de arte? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Arte))) (case o then (assert (obligatorio Arte))) (case p then (assert (prohibido Arte))) ) ) (defrule preg-museo-tecnolog'ia (museo) => (bind ?respuesta (todo-pos-p "¿Te gusta el museo de tecnología? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Tecnolog'ia))) (case o then (assert (obligatorio Tecnolog'ia))) (case p then (assert (prohibido Tecnolog'ia))) ) ) (defrule preg-museo-personas-c'elebres (museo) => (bind ?respuesta (todo-pos-p "¿Te gusta el museo de personas célebres? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Personas_C'elebres))) (case o then (assert (obligatorio Personas_C'elebres))) (case p then (assert (prohibido Personas_C'elebres))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo del monumento ### ;;; ######################################################################## (defrule preg-monumento (tranquilo) (local) => (if (si-o-no-p "¿Quieres opinar sobre los monumentos? (s/n) ") then (assert (monumento)) ) ) (defrule preg-monumento-edificio (monumento) => (bind ?respuesta (todo-pos-p "¿Te gusta edificios típicos? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Edificio))) (case o then (assert (obligatorio Edificio))) (case p then (assert (prohibido Edificio))) ) ) (defrule preg-monumento-religioso (monumento) => (bind ?respuesta (todo-pos-p "¿Te gusta los monumentos religiosos? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Monumento_Religioso))) (case o then (assert (obligatorio Monumento_Religioso))) (case p then (assert (prohibido Monumento_Religioso))) ) ) (defrule preg-monumento-escultura (monumento) => (bind ?respuesta (todo-pos-p "¿Te gusta las esculturas? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Escultura))) (case o then (assert (obligatorio Escultura))) (case p then (assert (prohibido Escultura))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo del bar ### ;;; ######################################################################## (defrule preg-bar => (if (si-o-no-p "¿Te gustan los bares? (s/n) ") then (assert (bar)) ) ) (defrule bar-espanol (bar) (local) => (assert (gusta Bar_Espanol)) ) (defrule preg-bar-espanol (bar) (no local) => (bind ?respuesta (todo-pos-p "¿Te gustan los bares españoles? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Bar_Espanol))) (case o then (assert (obligatorio Bar_Espanol))) (case p then (assert (prohibido Bar_Espanol))) ) ) (defrule preg-bar-irland'es (bar) (no local) => (bind ?respuesta (todo-pos-p "¿Te gustan los bares irlandeses? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Bar_Irland'es))) (case o then (assert (obligatorio Bar_Irland'es))) (case p then (assert (prohibido Bar_Irland'es))) ) ) (defrule preg-bar-internacional (bar) (no local) => (bind ?respuesta (todo-pos-p "¿Te gustan los bares para internacionales? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Bar_para_Internacionales))) (case o then (assert (obligatorio Bar_para_Internacionales))) (case p then (assert (prohibido Bar_para_Internacionales))) ) ) (defrule preg-bar-cocktail (bar) (no local) => (bind ?respuesta (todo-pos-p "¿Te gustan los bares de cocktails? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Bar_de_Cocktails))) (case o then (assert (obligatorio Bar_de_Cocktails))) (case p then (assert (prohibido Bar_de_Cocktails))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo de la actividad comercial ### ;;; ######################################################################## (defrule preg-comercial (no tranquilo) => (if (si-o-no-p "¿Quieres opinar sobre las actividades organizadas y comerciales? (s/n) ") then (assert (comercial)) ) ) (defrule preg-comercial-viaje_a_fuera (comercial) (local) => (bind ?respuesta (todo-pos-p "¿Te gustan los viajes a fuera? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Viajes_a_fuera))) (case o then (assert (obligatorio Viajes_a_fuera))) (case p then (assert (prohibido Viajes_a_fuera))) ) ) (defrule preg-comercial-gu'ia_de_la_ciudad (comercial) (local) => (bind ?respuesta (todo-pos-p "¿Te gustan las guías de la ciudad? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Gu'ia_de_la_Ciudad))) (case o then (assert (obligatorio Gu'ia_de_la_Ciudad))) (case p then (assert (prohibido Gu'ia_de_la_Ciudad))) ) ) (defrule preg-comercial-parque_de_atracci'on (comercial) => (bind ?respuesta (todo-pos-p "¿Te gustan las parques de atracciones? (s/n/o/p) ") ) (switch ?respuesta (case s then (assert (gusta Parque_de_Atracci'on))) (case o then (assert (obligatorio Parque_de_Atracci'on))) (case p then (assert (prohibido Parque_de_Atracci'on))) ) ) ;;; ######################################################################## ;;; ### Preguntas sobre dicotecas y clubs ### ;;; ######################################################################## (defrule preg-discoteca (no tranquilo) => (bind ?respuesta (todo-pos-p "¿Te gustan las discotecas? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Discoteca))) (case o then (assert (obligatorio Discoteca))) (case p then (assert (prohibido Discoteca))) ) ) (defrule preg-club (no tranquilo) => (bind ?respuesta (todo-pos-p "¿Te gustan los clubs? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta Club))) (case o then (assert (obligatorio Club))) (case p then (assert (prohibido Club))) ) ) ;;; ######################################################################## ;;; ### Preguntas para el tipo de comida ### ;;; ######################################################################## (defrule preg-preferencia-comida => (if (si-o-no-p "¿Tienes alguna preferencia de la comida? (s/n) ") then (assert (comida)) else (assert (gusta comida Comida_R'apida)) (assert (gusta comida Comida_Turca)) (assert (gusta comida Comida_Japonesa)) (assert (gusta comida Comida_Mexicana)) (assert (gusta comida Comida_China)) (assert (gusta comida Comida_Italiana)) (assert (gusta comida Comida_Espanola)) ) ) (defrule preg-lugar-comida (comida) => (if (si-o-no-p "¿Prefieres un bar para comer? (s/n) ") then (assert (gusta comida Comida_Espanola)) else (assert (lugar_igual)) ) ) (defrule preg-comida-r'apida (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida rápida? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_R'apida))) (case o then (assert (obligatorio comida Comida_R'apida))) (case p then (assert (prohibido comida Comida_R'apida))) ) ) (defrule preg-comida-turca (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida turca? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_Turca))) (case o then (assert (obligatorio comida Comida_Turca))) (case p then (assert (prohibido comida Comida_Turca))) ) ) (defrule preg-comida-japonesa (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida japonesa? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_Japonesa))) (case o then (assert (obligatorio comida Comida_Japonesa))) (case p then (assert (prohibido comida Comida_Japonesa))) ) ) (defrule preg-comida-mexicana (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida mexicana? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_Mexicana))) (case o then (assert (obligatorio comida Comida_Mexicana))) (case p then (assert (prohibido comida Comida_Mexicana))) ) ) (defrule preg-comida-china (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida china? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_China))) (case o then (assert (obligatorio comida Comida_China))) (case p then (assert (prohibido comida Comida_China))) ) ) (defrule preg-comida-italiana (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida italiana? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusto comida Comida_Italiana))) (case o then (assert (obligatorio comida Comida_Italiana))) (case p then (assert (prohibido comida Comida_Italiana))) ) ) (defrule preg-comida-espanola (lugar_igual) => (bind ?respuesta (todo-pos-p "¿Te gusta la comida española? (s/n/o/p) ")) (switch ?respuesta (case s then (assert (gusta comida Comida_Espanola))) (case o then (assert (obligatorio comida Comida_Espanola))) (case p then (assert (prohibido comida Comida_Espanola))) ) ) ;;; ######################################################################## ;;; ### Preguntas comunes ### ;;; ######################################################################## (defrule preg-precio => (if (si-o-no-p "¿Te importa el precio? (s/n) ") then (assert (precio_m'aximo 20)) else (assert (precio_m'aximo 100)) ) ) (defrule preg-grupo => (if (si-o-no-p "¿Viajas sólo? (s/n) ") then (assert (grupo no)) else (assert (grupo s'i)) ) ) (defrule preg-edad-solo (grupo no) => (printout t "¿Cuántos años tienes?") (bind ?respuesta (read)) (while (not (integerp ?respuesta)) (printout t "¿Cuántos años tienes?") (bind ?respuesta (read)) ) (assert (edad_m'inima ?respuesta)) (assert (edad_m'axima ?respuesta)) ) (defrule preg-edad-grupo (grupo s'i) => (printout t "¿Cuántos años tiene la persona más joven?") (bind ?respuesta (read)) (while (not (integerp ?respuesta)) (printout t "¿Cuántos años tiene la persona más joven?") (bind ?respuesta (read)) ) (assert (edad_m'inima ?respuesta)) (printout t "¿Cuántos años tiene la persona más mayor?") (bind ?respuesta (read)) (while (not (integerp ?respuesta)) (printout t "¿Cuántos años tiene la persona más mayor?") (bind ?respuesta (read)) ) (assert (edad_m'axima ?respuesta)) ) (defrule preg-duraci'on => (bind ?respuesta (pregunta "¿Cuántas franjas puede durar una actividad como máximo? (1/2/3) " 1 2 3) ) (assert (duraci'on ?respuesta)) ) (defrule preg-cantidad-dia => (printout t "¿Cuántos días quieres quedar in Barcelona?") (bind ?respuesta (read)) (while (not (integerp ?respuesta)) (printout t "¿Cuántos días quieres quedar in Barcelona?") (bind ?respuesta (read)) ) (assert (d'ia ?respuesta)) ) ;;; ######################################################################## ;;; ### Crear las instancias del horario ### ;;; ######################################################################## ;; Esta regla solamente crea las instancias del horario después de la última ;; pregunta (defrule crear-horario (d'ia ?d) => (while (> ?d 0) (make-instance (string-to-field (str-cat "d" ?d)) of Horario) (bind ?d (- ?d 1)) ) ) ;;; ######################################################################## ;;; ### Funciones para simplificar la programación ### ;;; ######################################################################## ;; Una función para añadir una actividad a un atributo en que ya están ;; actividades puestas. Primero se recibe el contenido de un atributo, se ;; crea un valor multivaluado de las informaciones del atributo y de la ;; actividad nueva. Al final se pone todo en el atributo. (deffunction anadir-algo (?instancia ?atributo ?actividad) (switch ?atributo (case manana then (bind ?var (nth$ 1 (send ?instancia get-manana))) (if (eq ?var [nil]) then (send ?instancia put-manana ?actividad) else (bind ?var (send ?instancia get-manana)) (send ?instancia put-manana (create$ ?var ?actividad)) ) ) (case tarde then (bind ?var (nth$ 1 (send ?instancia get-tarde))) (if (eq ?var [nil]) then (send ?instancia put-tarde ?actividad) else (bind ?var (send ?instancia get-tarde)) (send ?instancia put-tarde (create$ ?var ?actividad)) ) ) (case noche then (bind ?var (nth$ 1 (send ?instancia get-noche))) (if (eq ?var [nil]) then (send ?instancia put-noche ?actividad) else (bind ?var (send ?instancia get-noche)) (send ?instancia put-noche (create$ ?var ?actividad)) ) ) ) ) ;; La función comprueba que se puede hacer una actividad en grupo o ;; sólo. Además una persona sola puede hacer una actividad recomendada ;; para un grupo sólo pero un grupo no puede hacer las otras en grupo. (deffunction grupo (?actividad ?grupo) (bind ?var (send ?actividad get-grupo)) (bind ?respuesta FALSE) (switch ?var (case s'i then (if (eq ?grupo s'i) then (bind ?respuesta TRUE)) ) (case no then (if (eq ?grupo (or s'i no)) then (bind ?respuesta FALSE)) ) (default (bind ?respuesta FALSE)) ) (bind ?respuesta ?respuesta) ) ;;; ######################################################################## ;;; ### Funciones para distribuir las actividades no comida ### ;;; ######################################################################## ;; La función recibe todas las informaciones de los hechos y una actividad. ;; Después comprueba las condiciones según los parametros ?cond2 ?cond3. ;; Las condiciones son según de nuestra documentación: La segunda es para el ;; precio y del presupuesto del usuario y la tercera es para el tamaño del ;; grupo y la duración de la activida. (La primera condición es el gusto del ;; usuario.) ;; En la segunda fase de la función buscamos un día de los posibles en que hay ;; una franja libre en que podemos poner la actividad elegida. Para distribuir ;; las actividades hay dos bucles: un para los días y un para el limite de las ;; actividades en una franja. En el primer paso buscamos una franja libre o de ;; una actividad puesta, después con dos actividades, etc. Sin estos bucles el ;; algoritmo llena el primer día completo y después el próximo. ;; Al final cambiamos el valor del atributo "hecho" para olvidar poner una ;; misma actividad dos veces en una planificación. (deffunction distribuir (?actividad ?dia ?precio ?edad_m'axima ?edad_m'inima ?grupo ?duraci'on ?cond2 ?cond3) (if (eq ?cond2 true) then (if (not (< (send ?actividad get-precio) ?precio)) then (return) ) ) (if (eq ?cond3 true) then (if (not (< (send ?actividad get-duraci'on) ?duraci'on)) then (return) ) ) (if (eq ?cond3 true) then (if (not (grupo ?actividad ?grupo)) then (return)) ) (if (not (>= (send ?actividad get-edad_m'axima) ?edad_m'axima)) then (return) ) (if (not (<= (send ?actividad get-edad_m'inima) ?edad_m'inima)) then (return) ) (bind ?franjas (send ?actividad get-franja)) (loop-for-count (?i 2 3) (loop-for-count (?j 1 ?dia) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (and (< (length$ ?horario:manana) ?i) (member$ manana ?franjas)) (and (< (length$ ?horario:tarde) ?i) (member$ tarde ?franjas)) (and (< (length$ ?horario:noche) ?i) (member$ noche ?franjas)) ) ))) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (eq ?dia_elegido nil) then (return)) (bind ?c1 (and (< (length$ (send ?dia_elegido get-manana)) 3) (member$ manana ?franjas) )) (bind ?c2 (and (< (length$ (send ?dia_elegido get-tarde)) 3) (member$ tarde ?franjas) )) (bind ?c3 (and (< (length$ (send ?dia_elegido get-noche)) 3) (member$ noche ?franjas) )) (if ?c1 then (anadir-algo ?dia_elegido manana ?actividad) (printout t "manana" crlf) else (if ?c2 then (anadir-algo ?dia_elegido tarde ?actividad) (printout t "tarde" crlf) else (if ?c3 then (anadir-algo ?dia_elegido noche ?actividad) (printout t "noche" crlf) ) ) ) (send ?actividad put-hecho s'i) ) ;; Hay sólo una diferencia de esta función y la última: Con la condición ;; "gusta" podemos buscar una actividad según el nombre de la clase. Por ;; eso sólo damos el nombre de la clase a la función y elegimos la ;; actividad dentro. Sin la condición primera no podemos buscar según ;; del nombre. Ejecutamos al regla/función con cada actividad. Cuando hay ;; una activida que no cumple todas las condiciones necesarias se acaba ;; la función. (deffunction distribuir-gustas (?gusta ?dia ?precio ?edad_m'axima ?edad_m'inima ?grupo ?duraci'on ?cond2 ?cond3) (bind ?limite (+ (* ?dia 0.3) 1)) (loop-for-count (?i 1 ?limite) (bind ?actividad (nth$ 1 (find-instance ((?inst ?gusta)) (and (eq ?inst:hecho no) (>= ?inst:edad_m'axima ?edad_m'axima) (<= ?inst:edad_m'inima ?edad_m'inima) ) ))) (if (eq ?actividad nil) then (return)) (printout t "Actividad: " ?actividad crlf) (if (eq ?cond2 true) then (if (not (< (send ?actividad get-precio) ?precio)) then (return) ) ) (if (eq ?cond3 true) then (if (not (< (send ?actividad get-duraci'on) ?duraci'on)) then (return) ) ) (if (eq ?cond3 true) then (if (not (grupo ?actividad ?grupo)) then (return)) ) (if (not (>= (send ?actividad get-edad_m'axima) ?edad_m'axima)) then (return) ) (if (not (<= (send ?actividad get-edad_m'inima) ?edad_m'inima)) then (return) ) (bind ?franjas (send ?actividad get-franja)) (loop-for-count (?i 2 3) (loop-for-count (?j 1 ?dia) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (and (< (length$ ?horario:manana) ?i) (member$ manana ?franjas)) (and (< (length$ ?horario:tarde) ?i) (member$ tarde ?franjas)) (and (< (length$ ?horario:noche) ?i) (member$ noche ?franjas)) ) ))) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (eq ?dia_elegido nil) then (return)) (bind ?c1 (and (< (length$ (send ?dia_elegido get-manana)) 3) (member$ manana ?franjas) )) (bind ?c2 (and (< (length$ (send ?dia_elegido get-tarde)) 3) (member$ tarde ?franjas) )) (bind ?c3 (and (< (length$ (send ?dia_elegido get-noche)) 3) (member$ noche ?franjas) )) (if ?c1 then (anadir-algo ?dia_elegido manana ?actividad) else (if ?c2 then (anadir-algo ?dia_elegido tarde ?actividad) else (if ?c3 then (anadir-algo ?dia_elegido noche ?actividad) ) ) ) (send ?actividad put-hecho s'i) ) ) ;; La función para distribuir las actividades obligatorias es más ;; sencilla porque no hace falta comprobar las condiciones. El ;; usuario quiere hacerlo independiente de otras condiciones. (deffunction distribuir-obligatorias (?gusta) (bind ?actividad (nth$ 1 (find-instance ((?inst ?gusta)) (eq ?inst:hecho no))) ) (if (eq ?actividad nil) then (return)) (bind ?franjas (send ?actividad get-franja)) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (and (eq (nth$ 1 ?horario:manana) [nil]) (member$ manana ?franjas)) (and (eq (nth$ 1 ?horario:tarde) [nil]) (member$ tarde ?franjas)) (and (eq (nth$ 1 ?horario:noche) [nil]) (member$ noche ?franjas)))))) (bind ?c1 (and (eq (nth$ 1 (send ?dia_elegido get-manana)) [nil]) (member$ manana ?franjas) )) (bind ?c2 (and (eq (nth$ 1 (send ?dia_elegido get-tarde)) [nil]) (member$ tarde ?franjas) )) (bind ?c3 (and (eq (nth$ 1 (send ?dia_elegido get-noche)) [nil]) (member$ noche ?franjas) )) (if ?c1 then (send ?dia_elegido put-manana ?actividad) else (if ?c2 then (send ?dia_elegido put-tarde ?actividad) else (if ?c3 then (send ?dia_elegido put-noche ?actividad) ) ) ) ) ;;; ######################################################################## ;;; ### Funciones para distribuir las actividades de comida ### ;;; ######################################################################## ;; Las funciones de la distribución de las actividades de comida son muy ;; parecidos, hay sólo una diferencia: El atributo de la comida en el horario ;; sólo permite una actividad, por eso na hacen falta las bucles y las ;; funciones especiales para añadir una actividad. Pero el principio es lo ;; mismo. (deffunction distribuir-comida (?actividad ?dia ?precio ?edad_m'axima ?edad_m'inima ?grupo ?duraci'on ?cond2 ?cond3) (if (eq ?cond2 true) then (if (not (< (send ?actividad get-precio) ?precio)) then (return) ) ) (if (eq ?cond3 true) then (if (not (< (send ?actividad get-duraci'on) ?duraci'on)) then (return) ) ) (if (eq ?cond3 true) then (if (not (grupo ?actividad ?grupo)) then (return)) ) (if (not (>= (send ?actividad get-edad_m'axima) ?edad_m'axima)) then (return) ) (if (not (<= (send ?actividad get-edad_m'inima) ?edad_m'inima)) then (return) ) (loop-for-count (?j 1 ?dia) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (eq ?horario:comida_primera [nil]) (eq ?horario:comida_segunda [nil]) ) ))) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (eq ?dia_elegido nil) then (return)) (bind ?c1 (eq (send ?dia_elegido get-comida_primera) [nil]) ) (bind ?c2 (eq (send ?dia_elegido get-comida_segunda) [nil]) ) (if ?c1 then (send ?dia_elegido put-comida_primera ?actividad) else (if ?c2 then (send ?dia_elegido put-comida_segunda ?actividad) ) ) (send ?actividad put-hecho s'i) ) (deffunction distribuir-comida-gustas (?gusta ?dia ?precio ?edad_m'axima ?edad_m'inima ?grupo ?duraci'on ?cond2 ?cond3) (bind ?limite (+ (* ?dia 0.3) 1)) (loop-for-count (?i 1 ?limite) (bind ?actividad (nth$ 1 (find-instance ((?inst ?gusta)) (and (eq ?inst:hecho no) (>= ?inst:edad_m'axima ?edad_m'axima) (<= ?inst:edad_m'inima ?edad_m'inima) ) ))) ) (if (eq ?actividad nil) then (return)) (if (eq ?cond2 true) then (if (not (< (send ?actividad get-precio) ?precio)) then (return) ) ) (if (eq ?cond3 true) then (if (not (< (send ?actividad get-duraci'on) ?duraci'on)) then (return) ) ) (if (eq ?cond3 true) then (if (not (grupo ?actividad ?grupo)) then (return)) ) (if (not (>= (send ?actividad get-edad_m'axima) ?edad_m'axima)) then (return) ) (if (not (<= (send ?actividad get-edad_m'inima) ?edad_m'inima)) then (return) ) (loop-for-count (?j 1 ?dia) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (eq ?horario:comida_primera [nil]) (eq ?horario:comida_segunda [nil]) ) ))) (if (not (eq ?dia_elegido nil)) then (break)) ) (if (eq ?dia_elegido nil) then (return)) (bind ?c1 (eq (send ?dia_elegido get-comida_primera) [nil])) (bind ?c2 (eq (send ?dia_elegido get-comida_segunda) [nil])) (if ?c1 then (send ?dia_elegido put-comida_primera ?actividad) else (if ?c2 then (send ?dia_elegido put-comida_segunda ?actividad) ) ) (send ?actividad put-hecho s'i) ) (deffunction distribuir-comida-obligatorias (?gusta) (bind ?actividad (nth$ 1 (find-instance ((?inst ?gusta)) (eq ?inst:hecho no))) ) (bind ?dia_elegido (nth$ 1 (find-instance ((?horario Horario)) (or (eq (nth$ 1 ?horario:comida_primera) [nil]) (eq (nth$ 1 ?horario:comida_segunda) [nil]) ) ))) (bind ?c1 (eq (nth$ 1 (send ?dia_elegido get-comida_primera)) [nil])) (bind ?c2 (eq (nth$ 1 (send ?dia_elegido get-comida_segunda)) [nil])) (if ?c1 then (send ?dia_elegido put-comida_primera ?actividad) else (if ?c2 then (send ?dia_elegido put-comida_segunda ?actividad) ) ) (send ?actividad put-hecho s'i) ) ;;; ######################################################################## ;;; ### Reglas para las actividades no comida ### ;;; ######################################################################## ;; En el inicio todas las actividades prohibidas reciben el valor "sí" para ;; el atributo "hecho". Después no son disponibles para la planificación (defrule prohibidas (declare (salience -1)) (prohibido ?prohibido) => (do-for-all-instances ((?inst ?prohibido)) TRUE (send ?inst put-hecho s'i) ) ) ;; Lss reglas son para cada combinación de las condiciones. Por ejemplo la ;; parte final del nombre de una regla ".2." significa que una actividad ;; debe cumplir la condición 2. (defrule distribuir-obligatorias (declare (salience -1)) (obligatorio ?nombre) => (distribuir-obligatorias ?nombre) ) (defrule distribuir-perfectas (declare (salience -2)) (d'ia ?d) (gusta ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur true true) ) (defrule distribuir-obligatorias (declare (salience -3)) (obligatorio ?nombre) => (distribuir-obligatorias ?nombre) ) (defrule distribuir-12. (declare (salience -4)) (d'ia ?d) (gusta ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur true false) ) (defrule distribuir-1.. (declare (salience -5)) (d'ia ?d) (gusta ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur false false) ) (defrule distribuir-.23 (declare (salience -6)) (d'ia ?d) ?actividad <- (object (is-a Actividad_no_comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir ?actividad ?d ?p ?emax ?emin ?g ?dur true true) ) (defrule distribuir-.2. (declare (salience -7)) (d'ia ?d) ?actividad <- (object (is-a Actividad_no_comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir ?actividad ?d ?p ?emax ?emin ?g ?dur true false) ) (defrule distribuir-..3 (declare (salience -8)) (d'ia ?d) ?actividad <- (object (is-a Actividad_no_comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir ?actividad ?d ?p ?emax ?emin ?g ?dur false true) ) (defrule distribuir-... (declare (salience -9)) (d'ia ?d) ?actividad <- (object (is-a Actividad_no_comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir ?actividad ?d ?p ?emax ?emin ?g ?dur false false) ) ;;; ######################################################################## ;;; ### Reglas para las actividades de comida ### ;;; ######################################################################## ;; Las reglas con del mismo orden como las actividades no comida y con el ;; mismo principio. (defrule comida-prohibidas (declare (salience -1)) (prohibido comida ?prohibido) => (do-for-all-instances ((?inst ?prohibido)) TRUE (send ?inst put-hecho s'i) ) ) (defrule distribuir-comida-obligatorias (declare (salience -1)) (obligatorio comida ?nombre) => (distribuir-comida-obligatorias ?nombre) ) (defrule distribuir-comida-perfectas (declare (salience -2)) (d'ia ?d) (gusta comida ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur true true) ) (defrule distribuir-comida-obligatorias (declare (salience -3)) (obligatorio comida ?nombre) => (distribuir-comida-obligatorias ?nombre) ) (defrule distribuir-comida-12. (declare (salience -4)) (d'ia ?d) (gusta comida ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur true false) ) (defrule distribuir-comida-1.. (declare (salience -5)) (d'ia ?d) (gusta comida ?nombre) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida-gustas ?nombre ?d ?p ?emax ?emin ?g ?dur false false) ) (defrule distribuir-comida-.23 (declare (salience -6)) (d'ia ?d) ?actividad <- (object (is-a Actividad_Comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida ?actividad ?d ?p ?emax ?emin ?g ?dur true true) ) (defrule distribuir-comida-.2. (declare (salience -7)) (d'ia ?d) ?actividad <- (object (is-a Actividad_Comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida ?actividad ?d ?p ?emax ?emin ?g ?dur true false) ) (defrule distribuir-comida-..3 (declare (salience -8)) (d'ia ?d) ?actividad <- (object (is-a Actividad_Comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida ?actividad ?d ?p ?emax ?emin ?g ?dur false true) ) (defrule distribuir-comida-... (declare (salience -9)) (d'ia ?d) ?actividad <- (object (is-a Actividad_Comida)) (edad_m'axima ?emax) (edad_m'inima ?emin) (duraci'on ?dur) (precio_m'aximo ?p) (grupo ?g) => (distribuir-comida ?actividad ?d ?p ?emax ?emin ?g ?dur false false) )