diff --git a/cfg/conf.d/clips-executive.yaml b/cfg/conf.d/clips-executive.yaml index a3be5692d8..e7d1dcaff1 100644 --- a/cfg/conf.d/clips-executive.yaml +++ b/cfg/conf.d/clips-executive.yaml @@ -250,6 +250,7 @@ clips-executive: - rcll/production-strategy.clp - rcll/exploration.clp - rcll/goal-lock-expiration.clp + - rcll/goal-class.clp - name: goal-expander file: rcll/fixed-sequence.clp - name: action-selection diff --git a/fawkes b/fawkes index c7c8772adc..ebe7f88cdc 160000 --- a/fawkes +++ b/fawkes @@ -1 +1 @@ -Subproject commit c7c8772adce56dafa0d401ceb625cdb134e3699d +Subproject commit ebe7f88cdc4756608d24544721e8499e8b2792ac diff --git a/src/clips-specs/rcll/domain.clp b/src/clips-specs/rcll/domain.clp index cbd307fb33..eb04f89dad 100644 --- a/src/clips-specs/rcll/domain.clp +++ b/src/clips-specs/rcll/domain.clp @@ -192,13 +192,13 @@ (domain-object (name CCG1) (type cap-carrier)) (domain-object (name CCG2) (type cap-carrier)) (domain-object (name CCG3) (type cap-carrier)) - (domain-object (name ?bs) (type mps)) - (domain-object (name ?cs1) (type mps)) - (domain-object (name ?cs2) (type mps)) - (domain-object (name ?ds) (type mps)) - (domain-object (name ?rs1) (type mps)) - (domain-object (name ?rs2) (type mps)) - (domain-object (name ?ss) (type mps)) + (domain-object (name ?bs) (type bs)) + (domain-object (name ?cs1) (type cs)) + (domain-object (name ?cs2) (type cs)) + (domain-object (name ?ds) (type ds)) + (domain-object (name ?rs1) (type rs)) + (domain-object (name ?rs2) (type rs)) + (domain-object (name ?ss) (type ss)) (domain-object (name INPUT) (type mps-side)) (domain-object (name OUTPUT) (type mps-side)) (domain-object (name WAIT) (type mps-side)) @@ -280,6 +280,20 @@ (domain-fact (name mps-side-free) (param-values ?rs2 OUTPUT)) (domain-fact (name mps-side-free) (param-values ?ds OUTPUT)) (domain-fact (name mps-side-free) (param-values ?ss OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?bs INPUT)) + (domain-fact (name mps-has-side) (param-values ?cs1 INPUT)) + (domain-fact (name mps-has-side) (param-values ?cs2 INPUT)) + (domain-fact (name mps-has-side) (param-values ?rs1 INPUT)) + (domain-fact (name mps-has-side) (param-values ?rs2 INPUT)) + (domain-fact (name mps-has-side) (param-values ?ds INPUT)) + (domain-fact (name mps-has-side) (param-values ?ss INPUT )) + (domain-fact (name mps-has-side) (param-values ?bs OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?cs1 OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?cs2 OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?rs1 OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?rs2 OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?ds OUTPUT)) + (domain-fact (name mps-has-side) (param-values ?ss OUTPUT)) (domain-fact (name wp-cap-color) (param-values CCB1 CAP_BLACK)) (domain-fact (name wp-cap-color) (param-values CCB2 CAP_BLACK)) @@ -296,6 +310,8 @@ (domain-fact (name rs-filled-with) (param-values ?rs1 ZERO)) (domain-fact (name rs-filled-with) (param-values ?rs2 ZERO)) + (domain-fact (name rs-filled-for) (param-values ?rs1 ZERO)) + (domain-fact (name rs-filled-for) (param-values ?rs2 ZERO)) ) (assert (domain-facts-loaded)) @@ -315,3 +331,75 @@ (wm-robmem-sync-restore) (assert (domain-facts-loaded)) ) + +; ----------------- PDDL Goal Formulation Objects and Predicates ------------------- +; the following objects and predicates cary information that make it easier to +; define goal-formulation preconditions in PDDL by either removing the need for +; quantification, or by reducing the size of the grounding space in the case of object +; types. +; (e.g. to detect if the given order has a workpiece assigned to it, +; order-has-wp can be used instead just for that order instead of having to use +; wp-for-order and quantifying over all workpieces) + +(defrule domain-assert-mps-polymorphism + (domain-object (name ?mps) (type bs|cs|ds|rs|ss)) + => + (assert (domain-object (name ?mps) (type mps))) +) +(defrule domain-assert-fs-polymorphism + (domain-object (name ?mps) (type cs|ss)) + => + (assert (domain-object (name ?mps) (type fs))) +) + +(defrule domain-assert-order-has-wp + (domain-fact (name wp-for-order) (param-values ?wp ?order)) + (not (domain-fact (name order-has-wp) (param-values ?order))) + => + (assert (domain-fact (name order-has-wp) (param-values ?order))) +) + +(defrule domain-retract-order-has-wp + ?df <- (domain-fact (name order-has-wp) (param-values ?order)) + (not (domain-fact (name wp-for-order) (param-values ?wp ?order))) + => + (retract ?df) +) + +(defrule goal-class-wp-has-order + (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) + (not (domain-fact (name wp-has-order) (param-values ?wp))) + => + (assert (domain-fact (name wp-has-order) (param-values ?wp))) +) + +(defrule goal-class-not-wp-has-order + ?wmf <- (domain-fact (name wp-has-order) (param-values ?wp)) + (not (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order))) + => + (retract ?wmf) +) + +(defrule domain-assert-rs-paid-for + (domain-fact (name rs-filled-with) (param-values ?rs ?bases-filled)) + (not (domain-fact (name rs-filled-with) (param-values ?rs ?other-bases&~?bases-filled))) + (domain-constant (type ring-num) (value ?required)) + (not (domain-fact (name rs-paid-for) (param-values ?rs ?required))) + (wm-fact (key domain fact rs-sub args? minuend ?bases-filled + subtrahend ?required + difference ZERO|ONE|TWO|THREE)) + => + (assert (domain-fact (name rs-paid-for) (param-values ?rs ?required))) +) + +(defrule domain-retract-rs-paid-for + (domain-fact (name rs-filled-with) (param-values ?rs ?bases-filled)) + (not (domain-fact (name rs-filled-with) (param-values ?rs ?other-bases&~?bases-filled))) + (domain-constant (type ring-num) (value ?required)) + ?df <- (domain-fact (name rs-paid-for) (param-values ?rs ?required)) + (not (wm-fact (key domain fact rs-sub args? minuend ?bases-filled + subtrahend ?required + difference ZERO|ONE|TWO|THREE))) + => + (retract ?df) +) diff --git a/src/clips-specs/rcll/domain.pddl b/src/clips-specs/rcll/domain.pddl index 44a5e5ebbf..95a2a07174 100644 --- a/src/clips-specs/rcll/domain.pddl +++ b/src/clips-specs/rcll/domain.pddl @@ -25,8 +25,16 @@ robot - object team-color - object location - object - waitpoint - location + waitpoint - location mps - location + ;cs - mps + bs - mps + ;ss - mps + rs - mps + ds - mps + fs - mps + cs - fs + ss - fs mps-typename - object mps-statename - object mps-side - object @@ -38,7 +46,7 @@ cs-operation - object cs-statename - object order - object - order-complexity-value - object + order-complexity-value - object workpiece - object cap-carrier - workpiece shelf-spot - object @@ -46,6 +54,8 @@ zone - object token - object master-token - token + refbox-phasename - object + refbox-statename - object ) (:constants @@ -75,6 +85,7 @@ (mps-state ?m - mps ?s - mps-statename) (mps-team ?m - mps ?col - team-color) (mps-side-free ?m - mps ?side - mps-side) + (mps-has-side ?m - mps ?side - mps-side) (bs-prepared-color ?m - mps ?col - base-color) (bs-prepared-side ?m - mps ?side - mps-side) (cs-can-perform ?m - mps ?op - cs-operation) @@ -86,6 +97,8 @@ (rs-prepared-color ?m - mps ?col - ring-color) (rs-ring-spec ?m - mps ?r - ring-color ?rn - ring-num) (rs-filled-with ?m - mps ?n - ring-num) + (rs-paid-for ?rs - mps ?n - ring-num) + (rs-failed-put-slide ?rs - mps ?robot - robot ?wp - workpiece) ;rs-sub and rs-inc are static predicates stating the legal ring-num operations (rs-sub ?minuend - ring-num ?subtrahend - ring-num ?difference - ring-num) (rs-inc ?summand - ring-num ?sum - ring-num) @@ -100,6 +113,10 @@ (order-delivery-begin ?ord - order) (order-delivery-end ?ord - order) (order-gate ?ord - order ?gate - ds-gate) + (order-producible ?ord - order) + (order-deliverable ?ord - order) + (order-has-wp ?ord - order) + (order-out-of-delivery ?ord -order) (wp-unused ?wp - workpiece) (wp-usable ?wp - workpiece) (wp-at ?wp - workpiece ?m - mps ?side - mps-side) @@ -110,12 +127,22 @@ (wp-cap-color ?wp - workpiece ?col - cap-color) (wp-on-shelf ?wp - workpiece ?m - mps ?spot - shelf-spot) (wp-spawned-for ?wp - workpiece ?r - robot) - (wp-for-order ?wp - workpiece ?ord - order) - (spot-free ?m - mps ?spot - shelf-spot) - (ss-initialized ?m - mps) - (ss-stored-wp ?m - mps ?wp - workpiece) - (locked ?name - object) - (location-locked ?m - mps ?s - mps-side) + (wp-for-order ?wp - workpiece ?ord - order) + (wp-has-order ?wp - workpiece) + (spot-free ?m - mps ?spot - shelf-spot) + (ss-initialized ?m - mps) + (ss-stored-wp ?m - mps ?wp - workpiece) + (locked ?name - object) + (location-locked ?m - mps ?s - mps-side) + (refbox-order-quantity-requested ?order - order ?quantity - integer) + (refbox-order-quantity-delivered ?order - order ?quantity - integer) + (refbox-game-time ?value - float) + (refbox-points-cyan ?value - integer) + (refbox-points-magenta ?value - integer) + (refbox-team-color ?value - team-color) + (refbox-phase ?value - refbox-phasename) + (refbox-state ?value - refbox-statename) + (refbox-field-ground-truth ?name - object ?mtype - object ?zone - object ?yaw - float ?orientation - float) ) ;Kind of a hack. actually it should model the removal of present workpieces diff --git a/src/clips-specs/rcll/execution-monitoring.clp b/src/clips-specs/rcll/execution-monitoring.clp index e6a6dcbe57..868bf622b2 100644 --- a/src/clips-specs/rcll/execution-monitoring.clp +++ b/src/clips-specs/rcll/execution-monitoring.clp @@ -8,15 +8,6 @@ -;A timeout for an action -(deftemplate action-timer - (slot plan-id (type SYMBOL)) - (slot action-id(type NUMBER)) - (slot timeout-duration) - (multislot start-time) - (slot status) -) - (defglobal ?*MONITORING-SALIENCE* = 1 ?*COMMON-TIMEOUT-DURATION* = 30 diff --git a/src/clips-specs/rcll/goal-class.clp b/src/clips-specs/rcll/goal-class.clp new file mode 100644 index 0000000000..2cbb04a6ba --- /dev/null +++ b/src/clips-specs/rcll/goal-class.clp @@ -0,0 +1,1400 @@ +;--------------------------------------------------------------------------- +; goal-classes.clp - Define the goal classes and their preconditions +; +; Created: Tue 02 Nov 2021 19:05:00 CET +; Copyright 2021 Daniel Swoboda +; Licensed under GPLv2+ license, cf. LICENSE file in the doc directory. +;--------------------------------------------------------------------------- + +; This program is free software; you can redistribute it and/or modify +; it under the terms of the GNU General Public License as published by +; the Free Software Foundation; either version 2 of the License, or +; (at your option) any later version. +; +; This program is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU Library General Public License for more details. +; +; Read the full text in the LICENSE.GPL file in the doc directory. +; + + +; ------------------------- ASSERT GOAL CLASSES ----------------------------------- + +; MPS INTERACTION GOALS ARE KEPT AT OLD STATE FORE NOW + + +; CLEANUP GOALS + +(defrule goal-class-create-clear-rs-from-expired-product + "Assert a goal class for CLEAR-MPS goals that holds the precondition for formulation + in case an expired product blocks a RS." + (not (goal-class (class CLEAR-MPS) (id CLEAR-MPS-RS) (sub-type SIMPLE))) + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + => + (assert + (goal-class (class CLEAR-MPS) + (id CLEAR-MPS-RS) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot rs wp side) + (param-constants ?team-color ?robot nil nil OUTPUT) + (param-types team-color robot rs workpiece mps-side) + (param-quantified) + (preconditions " + (and + (can-hold ?robot) + (not (mps-state ?rs BROKEN)) + (wp-at ?wp ?rs OUTPUT) + (wp-cap-color ?wp CAP_NONE) + (wp-for-order ?wp ?order) + (order-out-of-delivery ?order) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-clear-cs-from-capless-carrier + "Assert a goal class for CLEAR-MPS goals that holds the precondition for formulation + in case a CC blocks a CS." + (not (goal-class (class CLEAR-MPS) (id CLEAR-MPS-CS-CC) (sub-type SIMPLE))) + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + => + (assert + (goal-class (class CLEAR-MPS) + (id CLEAR-MPS-CS-CC) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot cs cc side) + (param-constants ?team-color ?robot nil nil OUTPUT) + (param-types team-color robot cs cap-carrier mps-side) + (param-quantified) + (preconditions " + (and + (can-hold ?robot) + (not (mps-state ?cs BROKEN)) + (wp-at ?cc ?cs OUTPUT) + (wp-cap-color ?cc CAP_NONE) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-clear-cs-from-finished-product + "Assert a goal class for CLEAR-MPS goals that holds the precondition for formulation + in case a finished product blocks a CS." + (not (goal-class (class CLEAR-MPS) (id CLEAR-MPS-CS-WP) (sub-type SIMPLE))) + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + => + (assert + (goal-class (class CLEAR-MPS) + (id CLEAR-MPS-CS-WP) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot cs wp side) + (param-constants ?team-color ?robot nil nil OUTPUT) + (param-types team-color robot cs workpiece mps-side) + (param-quantified) + (preconditions " + (and + (can-hold ?robot) + (not (mps-side-free ?cs INPUT)) + (not (mps-state ?cs BROKEN)) + (wp-at ?wp ?cs OUTPUT) + (not (wp-cap-color ?wp CAP_NONE)) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-clear-bs + "Assert a goal class for CLEAR-MPS goals that holds the precondition for formulation + of potential BS clear goals." + (not (goal-class (class CLEAR-MPS) (id CLEAR-MPS-BS) (sub-type SIMPLE))) + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + => + (assert + (goal-class (class CLEAR-MPS) + (id CLEAR-MPS-BS) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot bs wp side) + (param-constants ?team-color ?robot nil nil nil) + (param-types team-color robot bs workpiece mps-side) + (param-quantified) + (preconditions " + (and + (can-hold ?robot) + (mps-team ?bs ?team-color) + (not (mps-state ?bs BROKEN)) + (wp-at ?wp ?bs ?side) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-discard-wp + "Create a goal-class for discarding workpieces." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + + (not (goal-class (class DISCARD-UNKNOWN) (id DISCARD-UNKNOWN-WP))) + => + (assert + (goal-class (class DISCARD-UNKNOWN) + (id DISCARD-UNKNOWN-WP) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names robot wp rs) + (param-constants ?robot nil nil) + (param-types robot workpiece rs) + (param-quantified ) + (preconditions " + (and + (holding ?robot ?wp) + (or + (rs-failed-put-slide ?rs ?robot ?wp) + (or + (not (wp-has-order ?wp)) + (and + (wp-has-order ?wp) + (wp-cap-color ?wp CAP_NONE) + (wp-ring1-color ?wp RING_NONE) + ) + ) + ) + ) + ") + ) + ) +) + +(defrule goal-class-create-discard-cc + "Create a goal-class for discarding cap-carriers." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + + (not (goal-class (class DISCARD-UNKNOWN) (id DISCARD-UNKNOWN-CC))) + => + (assert + (goal-class (class DISCARD-UNKNOWN) + (id DISCARD-UNKNOWN-CC) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names robot wp rs) + (param-constants ?robot nil nil) + (param-types robot cap-carrier rs) + (param-quantified ) + (preconditions " + (and + (holding ?robot ?wp) + (or + (rs-failed-put-slide ?rs ?robot ?wp) + (or + (not (wp-has-order ?wp)) + (and + (wp-has-order ?wp) + (wp-cap-color ?wp CAP_NONE) + (wp-ring1-color ?wp RING_NONE) + ) + ) + ) + ) + ") + ) + ) +) + + + +; PRODUCTION MAINTENANCE GOALS + +(defrule goal-class-create-get-from-bs-for-rs + "Create a goal-class for getting WPs from the BS to fill an RS with." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + + (not (goal-class (class GET-BASE-TO-FILL-RS))) + => + (assert + (goal-class (class GET-BASE-TO-FILL-RS) + (id GET-BASE-TO-FILL-RS) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names robot wp rs bs side) + (param-constants ?robot nil nil nil nil) + (param-types robot workpiece rs bs mps-side) + (param-quantified ) + (preconditions " + (and + (can-hold ?robot) + (wp-spawned-for ?wp ?robot) + (or + (rs-filled-with ?rs ZERO) + (rs-filled-with ?rs ONE) + (rs-filled-with ?rs TWO) + ) + (not (mps-state ?bs BROKEN)) + (not (mps-state ?bs DOWN)) + (mps-has-side ?bs ?side) + ) + ") + ) + ) +) + +(defrule goal-class-create-get-from-shelf-for-rs + "Create a goal-class for getting CCs from the shelf to fill an RS with." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + + (not (goal-class (class GET-SHELF-TO-FILL-RS))) + => + (assert + (goal-class (class GET-SHELF-TO-FILL-RS) + (id GET-SHELF-TO-FILL-RS) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names robot rs cc cs spot) + (param-constants ?robot nil nil nil nil) + (param-types robot rs cap-carrier cs shelf-spot) + (param-quantified ) + (preconditions " + (and + (can-hold ?robot) + (not (mps-state ?rs BROKEN)) + (or + (rs-filled-with ?rs ZERO) + (rs-filled-with ?rs ONE) + (rs-filled-with ?rs TWO) + ) + (wp-on-shelf ?cc ?cs ?spot) + ) + ") + ) + ) +) + +(defrule goal-class-create-fill-rs + "Create a goal-class for an RS to formulate FILL-RS goals to fill it with WPs." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact mps-team args? m ?rs col ?team-color)) + (wm-fact (key domain fact mps-type args? m ?rs t RS)) + + (not (goal-class (class FILL-RS) (meta rs ?rs cc FALSE))) + => + (assert + (goal-class (class FILL-RS) + (id (sym-cat FILL-RS-WP- ?rs)) + (meta rs ?rs cc FALSE) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names wp robot rs filled) + (param-constants nil ?robot ?rs nil) + (param-types workpiece robot rs ring-num) + (param-quantified ) + (preconditions " + (and + (wp-usable ?wp) + (holding ?robot ?wp) + (not (wp-has-order ?wp)) + (not (mps-state ?rs BROKEN)) + (rs-filled-with ?rs ?filled) + (or + (rs-filled-with ?rs ZERO) + (rs-filled-with ?rs ONE) + (rs-filled-with ?rs TWO) + ) + ) + ") + ) + ) +) + +(defrule goal-class-create-fill-rs-cc + "Create a goal-class for an RS to formulate FILL-RS goals to fill it with CCs." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact mps-team args? m ?rs col ?team-color)) + (wm-fact (key domain fact mps-type args? m ?rs t RS)) + + (not (goal-class (class FILL-RS) (meta rs ?rs cc TRUE))) + => + (assert + (goal-class (class FILL-RS) + (id (sym-cat FILL-RS-CC- ?rs)) + (meta rs ?rs cc TRUE) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names wp robot rs filled) + (param-constants nil ?robot ?rs nil) + (param-types cap-carrier robot rs ring-num) + (param-quantified ) + (preconditions " + (and + (wp-usable ?wp) + (holding ?robot ?wp) + (not (mps-state ?rs BROKEN)) + (rs-filled-with ?rs ?filled) + (or + (rs-filled-with ?rs ZERO) + (rs-filled-with ?rs ONE) + (rs-filled-with ?rs TWO) + ) + ) + ") + ) + ) +) + +(defrule goal-class-create-fill-cap + "Assert a FILL-CAP goal class for each CS based on its assigned cs-color." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact cs-color args? m ?cs col ?cap-color)) + + (not (goal-class (class FILL-CAP) (meta cs ?cs))) + => + (assert + (goal-class (class FILL-CAP) + (id (sym-cat FILL-CAP- ?cs)) + (meta cs ?cs) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names robot cs cc spot cap-color) + (param-constants ?robot ?cs nil nil ?cap-color) + (param-types robot cs cap-carrier shelf-spot cap-color) + (param-quantified ) + (preconditions " + (and + (can-hold ?robot) + (not (mps-state ?cs BROKEN)) + (cs-can-perform ?cs RETRIEVE_CAP) + (not (cs-buffered ?cs CAP_BLACK)) + (not (cs-buffered ?cs CAP_GREY)) + (mps-side-free ?cs INPUT) + (wp-on-shelf ?cc ?cs ?spot) + (wp-cap-color ?cc ?cap-color) + ) + ") + ) + ) +) + +; MAINLINE PRODUCTION GOALS + +(defrule goal-class-create-mount-first-ring + "If there exists an order for a product of complexity C1, C2 or C3, assert the + MFR goal-class for this order and the mounting operation of the first ring." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity&C1|C2|C3)) + (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?ring1-color rn ?bases-needed)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?other-color rn ?other-bases)) + + (test (not (eq ?ring1-color ?other-color))) + (test (not (eq ?ring1-color RING_NONE))) + (test (not (eq ?other-color RING_NONE))) + (test (not (eq ?bases-needed NA))) + (test (not (eq ?other-bases NA))) + (not (goal-class (class MOUNT-FIRST-RING) (meta order ?order))) + => + (assert + (goal-class (class MOUNT-FIRST-RING) + (id (sym-cat MOUNT-FIRST-RING- ?order)) + (meta order ?order) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names rs bases-needed other-color ring1-color bs wp side order robot base-color) + (param-constants ?rs ?bases-needed ?other-color ?ring1-color nil nil nil ?order ?robot ?base-color) + (param-types rs ring-num ring-color ring-color bs workpiece mps-side order robot base-color) + (param-quantified ) + (preconditions " + (and + (not (mps-state ?rs BROKEN)) + (rs-paid-for ?rs ?bases-needed) + (mps-side-free ?rs INPUT) + (not + (or + (rs-prepared-color ?rs ?other-color) + (rs-prepared-color ?rs ?ring1-color) + ) + ) + ;missing deadlock prevention + (mps-has-side ?bs ?side) + (order-producible ?order) + (or + (and + (not (order-has-wp ?order)) + (can-hold ?robot) + (not (mps-state ?bs DOWN)) + (not (mps-state ?bs BROKEN)) + (wp-spawned-for ?wp ?robot) + ) + (and + (holding ?robot ?wp) + (wp-base-color ?wp ?base-color) + (wp-for-order ?wp ?order) + (wp-ring1-color ?wp RING_NONE) + ) + ) + ) + + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-mount-next-ring2 + "If there exists an order for a product of complexity C2 or C3, assert the MNR goal-class + for this order and the mounting operation of the second ring." + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact self args? r ?robot)) + + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity&C2|C3)) + (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) + (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) + (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?ring2-color rn ?bases-needed)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?other-color&~?ring2-color $?)) + + (wm-fact (key domain fact rs-ring-spec args? m ?prev-rs r ?ring1-color $?)) + + (test (neq ?ring1-color RING_NONE)) + (test (neq ?ring2-color RING_NONE)) + (test (neq ?other-color RING_NONE)) + (test (neq ?bases-needed NA)) + + (not (goal-class (class MOUNT-NEXT-RING) (meta order ?order ring ring2))) + => + (assert + (goal-class (class MOUNT-NEXT-RING) + (id (sym-cat MOUNT-NEXT-RING-2- ?order)) + (meta order ?order ring ring2) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names order robot wp base-color ring1-color ring2-color ring3-color other-color rs prev-rs bases-needed) + (param-constants ?order ?robot nil ?base-color ?ring1-color ?ring2-color ?ring3-color ?other-color ?rs ?prev-rs ?bases-needed) + (param-types order robot workpiece base-color ring-color ring-color ring-color ring-color rs rs ring-num) + (param-quantified ) + (preconditions " + (and + (order-producible ?order) + (wp-for-order ?wp ?order) + (wp-base-color ?wp ?base-color) + (wp-ring1-color ?wp ?ring1-color) + (wp-ring2-color ?wp RING_NONE) + (wp-ring3-color ?wp RING_NONE) + (wp-cap-color ?wp CAP_NONE) + (rs-paid-for ?rs ?bases-needed) + + (not (mps-state ?rs BROKEN)) + (mps-side-free ?rs INPUT) + (not + (or + (rs-prepared-color ?rs ?ring2-color) + (rs-prepared-color ?rs ?other-color) + ) + ) + + (or + (and + (can-hold ?robot) + (wp-at ?wp ?prev-rs OUTPUT) + ) + (and + (holding ?robot ?wp) + (mps-type ?prev-rs RS) + ) + ) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-mount-next-ring3 + "If there exists an order for a product of complexity C3, assert the MNR goal-class + for this order and the mounting operation of the third ring." + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact self args? r ?robot)) + + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com C3)) + (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) + (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) + (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?ring3-color rn ?bases-needed)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs r ?other-color&~?ring3-color $?)) + + (wm-fact (key domain fact rs-ring-spec args? m ?prev-rs r ?ring2-color $?)) + + (test (neq ?ring1-color RING_NONE)) + (test (neq ?ring2-color RING_NONE)) + (test (neq ?ring3-color RING_NONE)) + (test (neq ?other-color RING_NONE)) + (test (neq ?bases-needed NA)) + + (not (goal-class (class MOUNT-NEXT-RING) (meta order ?order ring ring3))) + => + (assert + (goal-class (class MOUNT-NEXT-RING) + (id (sym-cat MOUNT-NEXT-RING-3- ?order)) + (meta order ?order ring ring3) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names order robot wp base-color ring1-color ring2-color ring3-color other-color rs prev-rs bases-needed) + (param-constants ?order ?robot nil ?base-color ?ring1-color ?ring2-color ?ring3-color ?other-color ?rs ?prev-rs ?bases-needed) + (param-types order robot workpiece base-color ring-color ring-color ring-color ring-color rs rs ring-num) + (param-quantified ) + (preconditions " + (and + (order-producible ?order) + (wp-for-order ?wp ?order) + (wp-base-color ?wp ?base-color) + (wp-ring1-color ?wp ?ring1-color) + (wp-ring2-color ?wp ?ring2-color) + (wp-ring3-color ?wp RING_NONE) + (wp-cap-color ?wp CAP_NONE) + (rs-paid-for ?rs ?bases-needed) + + (not (mps-state ?rs BROKEN)) + (mps-side-free ?rs INPUT) + (not + (or + (rs-prepared-color ?rs ?ring3-color) + (rs-prepared-color ?rs ?other-color) + ) + ) + + (or + (and + (can-hold ?robot) + (wp-at ?wp ?prev-rs OUTPUT) + ) + (and + (holding ?robot ?wp) + (mps-type ?prev-rs RS) + ) + ) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-deliver + "If there exists an order for a product of a certain configuration, + assert a goal class fact for it that holds the preconditions for the formulation of + its deliver goal. " + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?comp)) + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) + (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) + (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) + (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) + (wm-fact (key domain fact order-gate args? ord ?order gate ?gate)) + + (not (goal-class (class DELIVER) (meta order ?order))) + => + (assert + (goal-class (class DELIVER) + (id (sym-cat DELIVER- ?order)) + (meta order ?order) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot ds fs wp base-color ring1-color ring2-color ring3-color cap-color order complexity gate) + (param-constants ?team-color ?robot nil nil nil ?base-color ?ring1-color ?ring2-color ?ring3-color ?cap-color ?order ?comp ?gate) + (param-types team-color robot ds fs workpiece base-color ring-color ring-color ring-color cap-color order order-complexity-value ds-gate) + (param-quantified ) + (preconditions " + (and + ;mps CEs + (mps-side-free ?ds INPUT) + + ;wp CEs + (wp-for-order ?wp ?order) + (wp-base-color ?wp ?base-color) + (wp-ring1-color ?wp ?ring1-color) + (wp-ring2-color ?wp ?ring2-color) + (wp-ring3-color ?wp ?ring3-color) + (wp-cap-color ?wp ?cap-color) + + ;order CEs + (order-gate ?order ?gate) + (order-deliverable ?order) + + ;positional CEs + (or + (and + (wp-at ?wp ?fs OUTPUT) + (not (mps-state ?fs BROKEN)) + (can-hold ?robot) + ) + (holding ?robot ?wp) + ) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-produce-c0 + "If there exists an order for a C0 product of a certain configuration, + assert a goal class fact for it that holds the preconditions for the formulation of + its production goal. " + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com C0)) + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) + (wm-fact (key domain fact cs-color args? m ?cs col ?cap-color)) + + (not (goal-class (class PRODUCE-C0) (meta order ?order) (sub-type SIMPLE))) + => + (assert + (goal-class (class PRODUCE-C0) + (id (sym-cat PRODUCE-C0- ?order)) + (meta order ?order) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot cs wp cap-color bs side order base-color) + (param-constants ?team-color ?robot ?cs nil ?cap-color nil nil ?order ?base-color) + (param-types team-color robot cs workpiece cap-color bs mps-side order base-color) + (param-quantified) + (preconditions " + (and + ;cs CEs + (mps-side-free ?cs INPUT) + (not (mps-state ?cs BROKEN)) + (mps-team ?cs ?team-color) + (cs-buffered ?cs ?cap-color) + (cs-can-perform ?cs MOUNT_CAP) + ;bs CEs + (mps-has-side ?bs ?side) + (mps-team ?bs ?team-color) + ;order CEs + (order-producible ?order) + ;wp CEs + (or + (and + (wp-spawned-for ?wp ?robot) + (not (mps-state ?bs BROKEN)) + (not (mps-state ?bs DOWN)) + (can-hold ?robot) + (not (order-has-wp ?order)) + ) + (and + (holding ?robot ?wp) + (wp-base-color ?wp ?base-color) + (wp-cap-color ?wp CAP_NONE) + (wp-for-order ?wp ?order) + ) + ) + ) + ") + (effects "") + ) + ) +) + +(defrule goal-class-create-produce-cx + "If there exists an order for a C1, C2, or C3 product of a certain configuration, + assert a goal class fact for it that holds the preconditions for the formulation of + its production goal. " + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?com&C1|C2|C3)) + (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) + (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) + (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) + (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) + (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) + (wm-fact (key domain fact cs-color args? m ?cs col ?cap-color)) + + (wm-fact (key domain fact rs-ring-spec args? m ?rs1 r ?ring1-color $?)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs2 r ?ring2-color $?)) + (wm-fact (key domain fact rs-ring-spec args? m ?rs3 r ?ring3-color $?)) + + (not (goal-class (class PRODUCE-CX) (meta order ?order) (sub-type SIMPLE))) + => + (bind ?rs nil) + (if (eq ?com C1) then + (bind ?rs ?rs1) + ) + (if (eq ?com C2) then + (bind ?rs ?rs2) + ) + (if (eq ?com C3) then + (bind ?rs ?rs3) + ) + (assert + (goal-class (class PRODUCE-CX) + (id (sym-cat PRODUCE-CX- ?order)) + (meta order ?order) + (type ACHIEVE) + (sub-type SIMPLE) + (param-names team-color robot cs order base-color ring1-color ring2-color ring3-color cap-color wp rs) + (param-constants ?team-color ?robot ?cs ?order ?base-color ?ring1-color ?ring2-color ?ring3-color ?cap-color nil ?rs) + (param-types team-color robot cs order base-color ring-color ring-color ring-color cap-color workpiece rs) + (param-quantified) + (preconditions " + (and + ;cs CEs + (mps-side-free ?cs INPUT) + (not (mps-state ?cs BROKEN)) + (cs-buffered ?cs ?cap-color) + (cs-can-perform ?cs MOUNT_CAP) + ;wp CEs + (wp-for-order ?wp ?order) + (wp-base-color ?wp ?base-color) + (wp-ring1-color ?wp ?ring1-color) + (wp-ring2-color ?wp ?ring2-color) + (wp-ring3-color ?wp ?ring3-color) + (wp-cap-color ?wp CAP_NONE) + (or + (and + (wp-at ?wp ?rs OUTPUT) + (can-hold ?robot) + ) + (holding ?robot ?wp) + ) + ;order CEs + (order-producible ?order) + ) + ") + (effects "") + ) + ) +) + + +; ------------------------- ASSERT GOALS ----------------------------------- + +; MPS INTERACTION GOALS - KEPT AT OLD STATE FOR NOW + + +; CLEANUP GOALS + +(defrule goal-class-assert-goal-clear-mps + "If the precondition of a goal-class for a CLEAR-MPS type is fulfilled, assert + the goal fact and thus formulate the goal. " + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (or + (goal (class URGENT) (mode FORMULATED)) + (goal (class CLEAR) (mode FORMULATED)) + + ) + (goal-class (class ?class&CLEAR-MPS) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?team-color ?robot ?mps ?wp ?side)) + + (wm-fact (key domain fact mps-type args? m ?mps t ?mps-type)) + => + (printout t "Goal " CLEAR-MPS " ("?mps") formulated from PDDL" crlf) + + (bind ?parent nil) + (bind ?priority nil) + + (if (eq ?mps-type CS) + then + (do-for-fact ((?goal goal)) (and (eq ?goal:class CLEAR) (eq ?goal:mode FORMULATED)) + (bind ?parent ?goal:id) + (bind ?priority ?*PRIORITY-CLEAR-CS*) + (if (and (any-factp ((?wm wm-fact)) (and (wm-key-prefix ?wm:key (create$ domain fact wp-at)) + (eq (wm-key-arg ?wm:key m) ?mps) + (eq (wm-key-arg ?wm:key side) INPUT))) + (eq ?cid CLEAR-MPS-CS-CC)) + then + (bind ?priority (+ 1 ?priority)) + (printout warn "Enhance CLEAR-MPS priority, since there is a product at the input already" crlf) + ) + ) + else + (if (eq ?mps-type BS) then + (do-for-fact ((?goal goal)) (and (eq ?goal:class URGENT) (eq ?goal:mode FORMULATED)) + (bind ?parent ?goal:id) + (bind ?priority ?*PRIORITY-CLEAR-BS*) + ) + else + (if (eq ?mps-type RS) then + (do-for-fact ((?goal goal)) (and (eq ?goal:class CLEAR) (eq ?goal:mode FORMULATED)) + (bind ?parent ?goal:id) + (bind ?priority ?*PRIORITY-CLEAR-RS*) + ) + ) + ) + ) + + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority ?priority) + (parent ?parent) + (params robot ?robot + mps ?mps + wp ?wp + side ?side + ) + (required-resources (sym-cat ?mps - ?side) ?wp) + )) +) + +(defrule goal-class-assert-goal-discard + "If the preconditions of a DISCARD-UNKNOWN goal class are satisfied, assert the goal." + (declare (salience (+ 1 ?*SALIENCE-GOAL-FORMULATE*))) + (goal (id ?parent) (class NO-PROGRESS) (mode FORMULATED)) + (goal (id ?urgent) (class URGENT) (mode FORMULATED)) + + (goal-class (class ?class&DISCARD-UNKNOWN) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?robot ?wp ?rs)) + + (not (goal (class ?class) (params robot ?robot wp ?wp))) + => + (do-for-fact ((?wm wm-fact)) (wm-key-prefix ?wm:key (create$ monitoring safety-discard)) + (bind ?parent ?urgent) + (retract ?wm) + ) + (printout t "Goal " ?class " formulated from PDDL" crlf) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority ?*PRIORITY-DISCARD-UNKNOWN*) + (parent ?parent) + (params robot ?robot + wp ?wp + ) + (required-resources ?wp) + )) +) + + +; PRODUCTION MAINTENANCE GOALS + +(defrule goal-class-assert-goal-get-from-bs-for-rs + "If the preconditions of a get-base-to-fill-rs goal class is met assert the goal." + (declare (salience (+ 1 ?*SALIENCE-GOAL-FORMULATE*))) + (goal (id ?maintain-id) (class PREPARE-RINGS) (mode FORMULATED)) + + (goal-class (class ?class&GET-BASE-TO-FILL-RS) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?robot ?wp ?rs ?bs ?side)) + + (not (goal (class ?class) (params robot ?robot + bs ?bs + bs-side ?side + base-color ?any-base + wp ?wp))) + => + (printout t "Goal " ?class " formulated from PDDL" crlf) + (bind ?distance (node-distance (str-cat ?bs - (if (eq ?side INPUT) then I else O)))) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) + (priority (+ ?*PRIORITY-PREFILL-RS-WITH-FRESH-BASE* (goal-distance-prio ?distance))) + (parent ?maintain-id) (sub-type ?subtype) + (params robot ?robot + bs ?bs + bs-side ?side + base-color BASE_RED + wp ?wp + ) + (required-resources ?wp) + ) + ) +) + +(defrule goal-class-assert-goal-get-from-shelf-for-rs + "If the preconditions of a get-shelf-to-fill-rs goal class is met assert the goal." + (declare (salience (+ 1 ?*SALIENCE-GOAL-FORMULATE*))) + (goal (id ?maintain-id) (class PREPARE-RINGS) (mode FORMULATED)) + + (goal-class (class ?class&GET-SHELF-TO-FILL-RS) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?robot ?rs ?cc ?cs ?spot)) + + (not (goal (class ?class) (parent ?maintain-id) (params robot ?robot + cs ?cs + wp ?cc + spot ?spot))) + => + (printout t "Goal " ?class " formulated from PDDL" crlf) + (bind ?distance (node-distance (str-cat ?rs -I))) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) + (priority (+ ?*PRIORITY-PREFILL-RS* (goal-distance-prio ?distance))) + (parent ?maintain-id) (sub-type ?subtype) + (params robot ?robot + cs ?cs + wp ?cc + spot ?spot + ) + (required-resources ?cc) + ) + ) +) + +(defrule goal-class-assert-goal-fill-rs + "If the preconditions of a fill-rs goal class is met collect ring payment information + and assert the goal." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class PREPARE-RINGS) (mode FORMULATED)) + + (goal-class (class ?class&FILL-RS) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?wp ?robot ?rs ?filled)) + + (wm-fact (key domain fact mps-state args? m ?rs s ?state)) + (wm-fact (key domain fact rs-inc args? summand ?filled sum ?after)) + => + ;Check if this ring station should be filled with increased priority. + (bind ?priority-increase 0) + (do-for-all-facts ((?prio wm-fact)) (and (wm-key-prefix ?prio:key (create$ evaluated fact rs-fill-priority)) + (eq (wm-key-arg ?prio:key m) ?rs)) + (if (< ?priority-increase ?prio:value) + then + (bind ?priority-increase ?prio:value) + )) + ; + (if (eq ?state DOWN) + then + (bind ?priority-increase (- ?priority-increase 1)) + ) + (bind ?distance (node-distance (str-cat ?rs -I))) + (printout t "Goal " ?class " formulated from PDDL" crlf) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority (+ ?*PRIORITY-PREFILL-RS* ?priority-increase (goal-distance-prio ?distance))) + (parent ?production-id) + (params robot ?robot + mps ?rs + wp ?wp + rs-before ?filled + rs-after ?after + ) + (required-resources ?rs ?wp) + )) +) + +(defrule goal-class-assert-goal-fill-cap + "If the preconditions of a fill-cap goal class is met assert the goal." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class PREPARE-CAPS) (mode FORMULATED)) + + (goal-class (class ?class&FILL-CAP) (id ?cid) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?robot ?cs ?cc ?spot ?cap-color)) + => + (bind ?priority-increase 0) + ;increase priority if there is a product being produced that requires this cap-color + (if (any-factp ((?order-cap-color wm-fact)) + (and (wm-key-prefix ?order-cap-color:key (create$ domain fact order-cap-color)) + (eq (wm-key-arg ?order-cap-color:key col) ?cap-color) + (any-factp ((?wp-for-order wm-fact)) + (and (wm-key-prefix ?wp-for-order:key (create$ domain fact wp-for-order)) + (eq (wm-key-arg ?wp-for-order:key ord) (wm-key-arg ?order-cap-color:key ord))))) + ) + then + (bind ?priority-increase 1) + (printout t "Goal " ?class " formulated from PDDL with higher priority" crlf) + else + (printout t "Goal " ?class " formulated from PDDL" crlf) + ) + (bind ?distance (node-distance (str-cat ?cs -I))) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority (+ ?priority-increase ?*PRIORITY-PREFILL-CS* (goal-distance-prio ?distance))) + (parent ?production-id) + (params robot ?robot + mps ?cs + cc ?cc + ) + (required-resources (sym-cat ?cs -INPUT) ?cc) + )) +) + + +; MAINLINE PRODUCTION GOALS + +(defrule goal-class-assert-goal-mount-first-ring + "If the preconditions of a mount-first-ring goal class for an order is satisfied, + the complexity is allowed, and the keep-mps-side-free condition is met and there + is no such goal yet, collect the ring-payment information and assert the goal." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) + + (goal-class (class ?class&MOUNT-FIRST-RING) (id ?cid) (meta order ?order) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?rs ?bases-needed ?other-color ?ring1-color ?bs ?wp ?side ?order ?robot ?base-color)) + + (wm-fact (key domain fact rs-filled-with args? m ?rs n ?bases-filled)) + (wm-fact (key domain fact rs-sub args? minuend ?bases-filled + subtrahend ?bases-needed + difference ?bases-remain&ZERO|ONE|TWO|THREE)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity)) + (not (and (wm-fact (key domain fact wp-for-order args? wp ?ord-wp&~?wp ord ?any-order)) + (wm-fact (key domain fact order-complexity args? ord ?any-order com ?other-complexity)) + (wm-fact (key config rcll exclusive-complexities) (values $?other-exclusive&:(member$ (str-cat ?other-complexity) ?other-exclusive))) + (wm-fact (key config rcll exclusive-complexities) (values $?exclusive&:(member$ (str-cat ?complexity) ?exclusive))))) + (wm-fact (key config rcll allowed-complexities) (values $?allowed&:(member$ (str-cat ?complexity) ?allowed))) + + (not (wm-fact (key strategy keep-mps-side-free args? m ?rs side INPUT cause ~?wp))) + (not (goal (class ?class) (parent ?production-id) (params robot ?robot $? + bs-side ?side $? + order ?order + wp ?wp))) + => + (bind ?required-resources ?order ?wp) + (if (any-factp ((?exclusive-complexities wm-fact)) + (and (wm-key-prefix ?exclusive-complexities:key (create$ config rcll exclusive-complexities)) + (neq FALSE (member$ (str-cat ?complexity) ?exclusive-complexities:values)))) + then + (bind ?required-resources ?rs ?order ?wp PRODUCE-EXCLUSIVE-COMPLEXITY) + (printout t "Goal " ?class " formulated from PDDL for order " ?order ", it needs the PRODUCE-EXCLUSIVE-COMPLEXITY token" crlf) + else + (printout t "Goal " ?class " formulated from PDDL for order " ?order crlf) + ) + (bind ?distance (node-distance (str-cat ?bs - (if (eq ?side INPUT) then I else O)))) + + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority (+ ?*PRIORITY-MOUNT-FIRST-RING* (goal-distance-prio ?distance))) + (parent ?production-id) + (params robot ?robot + bs ?bs + bs-side ?side + bs-color ?base-color + mps ?rs + ring-color ?ring1-color + rs-before ?bases-filled + rs-after ?bases-remain + rs-req ?bases-needed + order ?order + wp ?wp + ) + (required-resources (sym-cat ?rs -INPUT) ?required-resources) + )) +) + +(defrule goal-class-assert-goal-mount-next-ring + "If the preconditions of a mount-next-ring goal class for an order is satisfied, + the complexity is allowed, and the keep-mps-side-free condition is met and there + is no such goal yet, collect the ring-payment information and assert the goal." + (declare (salience (+ 1 ?*SALIENCE-GOAL-FORMULATE*))) + (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) + + (goal-class (class ?class&MOUNT-NEXT-RING) (id ?cid) (meta order ?order ring ?ring) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?order ?robot ?wp ?base-color ?ring1-color ?ring2-color ?ring3-color ?other-color ?rs ?prev-rs ?bases-needed)) + + (wm-fact (key domain fact rs-filled-with args? m ?rs n ?bases-filled)) + (wm-fact (key domain fact rs-sub args? minuend ?bases-filled + subtrahend ?bases-needed + difference ?bases-remain&ZERO|ONE|TWO|THREE)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity)) + (wm-fact (key config rcll allowed-complexities) (values $?allowed&:(member$ (str-cat ?complexity) ?allowed))) + + (not (wm-fact (key strategy keep-mps-side-free args? m ?rs side INPUT cause ~?wp))) + (not (goal (class ?class) (parent ?maintain-id) (params robot ?robot $? + wp ?wp $? + order ?order))) + => + (bind ?curr-ring-color ?ring2-color) + (bind ?ring-pos 2) + (if (eq ?ring ring3) then + (bind ?curr-ring-color ?ring3-color) + (bind ?ring-pos 3) + ) + + (printout t "Goal " ?class " formulated from PDDL for order " ?order " (Ring " ?ring-pos ") " crlf) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (priority (+ ?ring-pos ?*PRIORITY-MOUNT-NEXT-RING*)) + (parent ?production-id) (sub-type ?subtype) + (params robot ?robot + prev-rs ?prev-rs + prev-rs-side OUTPUT + wp ?wp + rs ?rs + ring1-color ?ring1-color + ring2-color ?ring2-color + ring3-color ?ring3-color + curr-ring-color ?curr-ring-color + ring-pos (int-to-sym ?ring-pos) + rs-before ?bases-filled + rs-after ?bases-remain + rs-req ?bases-needed + order ?order + ) + (required-resources (sym-cat ?rs -INPUT) (sym-cat ?prev-rs -OUTPUT) ?wp) + )) +) + +(defrule goal-class-assert-goal-deliver + "If the precondition for a DELIVER goal-class for an order has been met and there is + no such DELIVER goal yet, assert and formulate the goal." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class DELIVER-PRODUCTS) (mode FORMULATED)) + + (goal-class (class ?class&DELIVER) (id ?cid) (meta order ?order) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?team-color ?robot ?ds ?mps ?wp ?base-color ?ring1-color ?ring2-color ?ring3-color ?cap-color ?order ?complexity ?gate)) + + (not (goal (class ?class) (params $? robot ?robot $? + order ?order + wp ?wp + ds ?ds + ds-gate ?gate $?))) + => + (printout t "Goal " ?class " formulated from PDDL for order " ?order crlf) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority ?*PRIORITY-DELIVER*) + (parent ?production-id) + (params robot ?robot + mps ?mps + order ?order + wp ?wp + ds ?ds + ds-gate ?gate + base-color ?base-color + ring1-color ?ring1-color + ring2-color ?ring2-color + ring3-color ?ring3-color + cap-color ?cap-color + ) + (required-resources (sym-cat ?mps -OUTPUT) ?order ?wp (sym-cat ?ds -INPUT)) + )) +) + +(defrule goal-class-assert-goal-produce-c0 + "If the precondition of a goal-class for a C0 order is fulfilled, assert the goal fact + and thus formulate the goal. Determine the priority of the goal through meta reasoning + on additional facts." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) + (goal (id ?urgent) (class URGENT) (mode FORMULATED)) + + (goal-class (class ?class&PRODUCE-C0) (id ?cid) (meta order ?order) (sub-type ?subtype)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?team-color ?robot ?mps ?wp ?cap-color ?bs ?side ?order ?base-color)) + + (not (goal (class ?class) (params $? order ?order $?))) + + (wm-fact (key order meta competitive args? ord ?order) (value ?competitive)) + (wm-fact (key config rcll competitive-order-priority) (value ?comp-prio)) + => + (printout t "Goal " ?class " formulated from PDDL for order " ?order crlf) + (bind ?distance (node-distance (str-cat ?bs - (if (eq ?side INPUT) then I else O)))) + (bind ?priority-decrease 0) + (bind ?parent ?production-id) + (if (and (eq ?comp-prio "HIGH") ?competitive) + then + (bind ?parent ?urgent)) + (if (eq ?comp-prio "LOW") + then + (bind ?priority-decrease 1) + ) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority (+ (- ?*PRIORITY-PRODUCE-C0* ?priority-decrease) (goal-distance-prio ?distance))) + (parent ?parent) + (params robot ?robot + bs ?bs + bs-side ?side + bs-color ?base-color + mps ?mps + cs-color ?cap-color + order ?order + wp ?wp + ) + (required-resources (sym-cat ?mps -INPUT) ?order ?wp) + )) +) + +(defrule goal-class-assert-goal-produce-cx + "If the precondition of a goal-class for a CX order is fulfilled, assert the goal + fact and thus formulate the goal. Determine the priority of the goal based on + its complexity." + (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) + (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) + (goal (id ?urgent) (class URGENT) (mode FORMULATED)) + + (goal-class (class ?class&PRODUCE-CX) (id ?cid) (meta order ?order) (sub-type ?subtype)) + (wm-fact (key domain fact order-complexity args? ord ?order com ?com)) + (pddl-formula (part-of ?cid) (id ?formula-id)) + (grounded-pddl-formula (formula-id ?formula-id) (is-satisfied TRUE) (grounding ?grounding-id)) + (pddl-grounding (id ?grounding-id) (param-values ?team-color ?robot ?cs ?order ?base-color ?ring1-color ?ring2-color ?ring3-color ?cap-color ?wp ?rs)) + + (not (goal (class ?class) + (parent ?production-id) + (params robot ?robot + wp ?wp $? + mps ?cs $? + order ?order))) + => + (bind ?prio ?*PRIORITY-PRODUCE-C1*) + (if (eq ?com C2) then (bind ?prio ?*PRIORITY-PRODUCE-C2*)) + (if (eq ?com C3) then (bind ?prio ?*PRIORITY-PRODUCE-C3*)) + (printout t "Goal " ?class " formulated from PDDL for order " ?order crlf) + (assert (goal (id (sym-cat ?class - (gensym*))) + (class ?class) (sub-type ?subtype) + (priority ?prio) + (parent ?production-id) + (params robot ?robot + wp ?wp + rs ?rs + mps ?cs + cs-color ?cap-color + order ?order + ) + (required-resources (sym-cat ?cs -INPUT) (sym-cat ?rs -OUTPUT) ?wp) + )) +) + +; ------------------------- CLEAN UP GOAL CLASSES ----------------------------------- +; TODO retract goal classes that are order dependend when they have been fulfilled +; and prevent reformulation to keep the fact base clean. This does not hurt performance +; for now. + +; ------------------------- META CHECKS FOR GOALS ----------------------------------- + +(defrule goal-class-order-producible-C0 + "Assert an order-producible fact for a product of complexity C0 when it has not been + fulfileld yet and the produce-ahead time has started." + (wm-fact (key domain fact order-complexity args? ord ?order com C0)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox game-time) (values $?game-time)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(> ?qr ?qd))) + (wm-fact (key refbox order ?order delivery-begin) (type UINT) + (value ?begin&:(< ?begin (+ (nth$ 1 ?game-time) ?*PRODUCE-C0-AHEAD-TIME*)))) + (wm-fact (key refbox order ?order delivery-end) (type UINT) + (value ?end&:(> ?end (+ (nth$ 1 ?game-time) ?*PRODUCE-C0-LATEST-TIME*)))) + (not (domain-fact (name order-producible) (param-values ?order))) + => + (assert (domain-fact (name order-producible) (param-values ?order))) +) + +(defrule goal-class-order-not-producible-C0 + "Retract an order-producible fact for a product of complexity C0 when it has been + fulfilled or the produce-latest time has been reached ." + (wm-fact (key domain fact order-complexity args? ord ?order com C0)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox game-time) (values $?game-time)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (or + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(<= ?qr ?qd))) + (wm-fact (key refbox order ?order delivery-end) (type UINT) + (value ?end&:(< ?end (+ (nth$ 1 ?game-time) ?*PRODUCE-C0-LATEST-TIME*)))) + ) + ?wmf <- (domain-fact (name order-producible) (param-values ?order)) + => + (retract ?wmf) +) + +(defrule goal-class-order-producible-CX + "Assert an order-producible fact for a product of complexity C1, C2, or C3 when it has + not been fulfilled yet." + (wm-fact (key domain fact order-complexity args? ord ?order com ~C0)) + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(> ?qr ?qd))) + (not (domain-fact (name order-producible) (param-values ?order))) + => + (assert (domain-fact (name order-producible) (param-values ?order))) +) + +(defrule goal-class-order-not-producible-CX + "Retract an order-producible fact for a product of complexity C1, C2, or C3 when it has + been fulfilled." + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(<= ?qr ?qd))) + ?wmf <- (domain-fact (name order-producible) (param-values ?order)) + => + (retract ?wmf) +) + +(defrule goal-class-order-deliverable + "Assert an order-deliverable fact when it has not been fulfilled and delivery ahead + time has started." + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(> ?qr ?qd))) + (not (domain-fact (name order-deliverable) (param-values ?order))) + (wm-fact (key refbox game-time) (values $?game-time)) + (wm-fact (key refbox order ?order delivery-begin) (type UINT) + (value ?begin&:(< ?begin (+ (nth$ 1 ?game-time) ?*DELIVER-AHEAD-TIME*)))) + => + (assert (domain-fact (name order-deliverable) (param-values ?order))) +) + +(defrule goal-class-order-not-deliverable + "Retract an order-deliverable fact when the order has been fulfilled." + (wm-fact (key refbox team-color) (value ?team-color)) + (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) + (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) + (value ?qd&:(<= ?qr ?qd))) + ?wmf <- (domain-fact (name order-deliverable) (param-values ?order)) + => + (retract ?wmf) +) + +(defrule goal-class-failed-put-slide + "Assert an rs-failed-put-slide fact, if the robot failed putting a wp on a slide + for *MAX-RETRIES-PICK* attempts." + (wm-fact (key domain fact self args? r ?robot)) + (wm-fact (key domain fact mps-type args? m ?rs t RS)) + ?t <- (wm-fact (key monitoring action-retried args? r ?robot a wp-put-slide-cc m ?rs wp ?wp) + (value ?tried&:(>= ?tried ?*MAX-RETRIES-PICK*))) + (not (domain-fact (name rs-failed-put-slide) (param-values ?rs ?robot ?wp))) + => + (assert (domain-fact (name rs-failed-put-slide) (param-values ?rs ?robot ?wp))) +) + +(defrule goal-class-order-out-of-delivery + "Assert an order-out-of-delivery fact if the delivery time is over." + (wm-fact (key refbox game-time) (values $?game-time)) + (wm-fact (key refbox order ?order delivery-end) (type UINT) + (value ?end&:(< ?end (nth$ 1 ?game-time)))) + (not (domain-fact (name order-out-of-delivery) (param-values ?order))) + => + (assert (domain-fact (name order-out-of-delivery) (param-values ?order))) +) diff --git a/src/clips-specs/rcll/goal-production.clp b/src/clips-specs/rcll/goal-production.clp index 007abd5246..95d3c08794 100644 --- a/src/clips-specs/rcll/goal-production.clp +++ b/src/clips-specs/rcll/goal-production.clp @@ -337,205 +337,6 @@ (modify ?g (parent ?urgent)) ) - -(defrule goal-production-create-fill-cap -" Fill a cap into a cap station. - Use a capcarrier from the corresponding shelf to feed it into a cap station." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class PREPARE-CAPS) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?wp-h))) - ;MPS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact cs-can-perform args? m ?mps op RETRIEVE_CAP)) - (not (wm-fact (key domain fact cs-buffered args? m ?mps col ?any-cap-color))) - (not (wm-fact (key domain fact wp-at args? wp ?wp-a m ?mps side INPUT))) - ;Capcarrier CEs - (wm-fact (key domain fact wp-on-shelf args? wp ?cc m ?mps spot ?spot)) - (wm-fact (key domain fact wp-cap-color args? wp ?cc col ?cap-color)) - => - (bind ?priority-increase 0) - ;If there is ... - (if (any-factp ((?order-cap-color wm-fact)) - ;... an order that requires the prepared cap color ... - (and (wm-key-prefix ?order-cap-color:key (create$ domain fact order-cap-color)) - (eq (wm-key-arg ?order-cap-color:key col) ?cap-color) - ;... and this order is currently being processed ... - (any-factp ((?wp-for-order wm-fact)) - (and (wm-key-prefix ?wp-for-order:key (create$ domain fact wp-for-order)) - (eq (wm-key-arg ?wp-for-order:key ord) (wm-key-arg ?order-cap-color:key ord))))) - ) - then - ;... then this is more important than pre-filling a cap station with a - ; color that is not necessarily needed in the future. - (bind ?priority-increase 1) - (printout t "Goal " FILL-CAP " formulated with higher priority" crlf) - else - (printout t "Goal " FILL-CAP " formulated" crlf) - ) - (bind ?distance (node-distance (str-cat ?mps -I))) - (assert (goal (id (sym-cat FILL-CAP- (gensym*))) - (class FILL-CAP) (sub-type SIMPLE) - (priority (+ ?priority-increase ?*PRIORITY-PREFILL-CS* (goal-distance-prio ?distance))) - (parent ?production-id) - (params robot ?robot - mps ?mps - cc ?cc - ) - (required-resources (sym-cat ?mps -INPUT) ?cc) - )) -) - - -(defrule goal-production-create-clear-rs-from-expired-product - "Remove an unfinished product from the output of a ring station." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (class CLEAR) (id ?maintain-id) (mode FORMULATED)) - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;MPS CEs - (wm-fact (key domain fact mps-type args? m ?mps t RS)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - ;WP CEs - (wm-fact (key domain fact wp-at args? wp ?wp m ?mps side OUTPUT)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - - ;TODO: Discuss strategy, throwing away expired products is usually not desired. - (wm-fact (key refbox order ?order delivery-end) (type UINT) - (value ?end&:(< ?end (nth$ 1 ?game-time)))) - => - (printout t "Goal " CLEAR-MPS " ("?mps") formulated" crlf) - (assert (goal (id (sym-cat CLEAR-MPS- (gensym*))) (class CLEAR-MPS) - (sub-type SIMPLE) - (priority ?*PRIORITY-CLEAR-RS*) - (parent ?maintain-id) - (params robot ?robot - mps ?mps - wp ?wp - side OUTPUT - ) - (required-resources (sym-cat ?mps -OUTPUT) ?wp) - )) -) - - -(defrule goal-production-create-clear-cs-for-capless-carriers -" Remove a capless capcarrier from the output of a cap station after - retrieving a cap from it. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class CLEAR) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;MPS CEs - ;Maybe add a check for the base_color - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - ;WP CEs - (wm-fact (key domain fact wp-at args? wp ?wp m ?mps side OUTPUT)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - => - (printout t "Goal " CLEAR-MPS " ("?mps") formulated" crlf) - (bind ?prio ?*PRIORITY-CLEAR-CS*) - (if (any-factp ((?wm wm-fact)) (and (wm-key-prefix ?wm:key (create$ domain fact wp-at)) - (eq (wm-key-arg ?wm:key m) ?mps) - (eq (wm-key-arg ?wm:key side) INPUT))) - then - (bind ?prio (+ 1 ?prio)) - (printout warn "Enhance CLEAR-MPS priority, since there is a product at the input already" crlf) - ) - (assert (goal (id (sym-cat CLEAR-MPS- (gensym*))) - (class CLEAR-MPS) (sub-type SIMPLE) - (priority ?prio) - (parent ?production-id) - (params robot ?robot - mps ?mps - wp ?wp - side OUTPUT - ) - (required-resources (sym-cat ?mps -OUTPUT) ?wp) - )) -) - - -(defrule goal-production-create-clear-bs - "Remove a workpiece from the base station." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class URGENT) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;MPS CEs - (wm-fact (key domain fact mps-type args? m ?mps t BS)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - ;WP CEs - (wm-fact (key domain fact wp-at args? wp ?wp m ?mps side ?side)) - => - (printout t "Goal " CLEAR-MPS " ("?mps") formulated" crlf) - (assert (goal (id (sym-cat CLEAR-MPS- (gensym*))) - (class CLEAR-MPS) (sub-type SIMPLE) - (priority ?*PRIORITY-CLEAR-BS*) - (parent ?production-id) - (params robot ?robot - mps ?mps - wp ?wp - side ?side - ) - (required-resources (sym-cat ?mps - ?side) ?wp) - )) -) - -(defrule goal-production-clear-cs-blocked - "Remove a finished product from a cap station if the station is blocked" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class CLEAR) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;There is a cap-carrier on the input that needs the CS, - ;there is a product that needs the CS, - ;there is a product on the output blocking it - (wm-fact (key domain fact wp-at args? wp ?cc m ?mps side INPUT)) - (wm-fact (key wp meta next-step args? wp ?next-wp) (value CAP)) - (wm-fact (key domain fact wp-for-order args? wp ?next-wp ord ?order)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?cc col ?cap-color)) - (wm-fact (key domain fact wp-at args? wp ?wp-output m ?mps side OUTPUT)) - ;MPS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - => - (printout t "Goal " CLEAR-MPS " (" ?mps ") formulated" crlf) - (assert (goal (id (sym-cat CLEAR-MPS- (gensym*))) - (class CLEAR-MPS) (sub-type SIMPLE) - (priority ?*PRIORITY-CLEAR-CS-NEEDED*) - (parent ?production-id) - (params robot ?robot - mps ?mps - wp ?wp-output - side OUTPUT - ) - (required-resources (sym-cat ?mps -OUTPUT) ?wp-output) - )) -) - - (defrule goal-production-increase-priority-to-prefill-rs-for-started-order " Add a priority increase of +2 for goals that pre-fill a ring station which requires additional bases such that the production of a started product @@ -637,678 +438,6 @@ ) ) - -(defrule goal-production-create-get-base-to-fill-rs - "Fill the ring station with a fresh base from the base station." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?maintain-id) (class PREPARE-RINGS) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (wm-fact (key domain fact wp-spawned-for args? wp ?spawned-wp r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;MPS-RS CEs (a cap carrier can be used to fill a RS later) - (wm-fact (key domain fact mps-type args? m ?mps t RS)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact rs-filled-with args? m ?mps n ?rs-before&ZERO|ONE|TWO)) - ;MPS-BS CEs - (wm-fact (key domain fact mps-type args? m ?bs t BS)) - (wm-fact (key domain fact mps-state args? m ?bs s ~BROKEN&~DOWN)) - (wm-fact (key domain fact mps-team args? m ?bs col ?team-color)) - (domain-object (name ?bs-side&:(or (eq ?bs-side INPUT) (eq ?bs-side OUTPUT))) (type mps-side)) - - (wm-fact (key domain fact order-base-color args? ord ?any-order col ?base-color)) - ; Formulate the goal only if it is not already formulated (prevents doubling - ; the goals due to matching with RS-1 and RS-2) - (not (goal (class GET-BASE-TO-FILL-RS) (params robot ?robot - bs ?bs - bs-side ?bs-side - base-color ? - wp ?spawned-wp))) - => - (printout t "Goal " GET-BASE-TO-FILL-RS " formulated" crlf) - (bind ?distance (node-distance (str-cat ?bs - (if (eq ?bs-side INPUT) then I else O)))) - (assert (goal (id (sym-cat GET-BASE-TO-FILL-RS- (gensym*))) - (class GET-BASE-TO-FILL-RS) - (priority (+ ?*PRIORITY-PREFILL-RS-WITH-FRESH-BASE* (goal-distance-prio ?distance))) - (parent ?maintain-id) (sub-type SIMPLE) - (params robot ?robot - bs ?bs - bs-side ?bs-side - base-color ?base-color - wp ?spawned-wp - ) - (required-resources ?spawned-wp) - )) -) - - -(defrule goal-production-create-get-shelf-to-fill-rs - "Get a capcarrier from a shelf to feed it later." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?maintain-id) (class PREPARE-RINGS) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - ;MPS-RS CEs (a cap carrier can be used to fill a RS later) - (wm-fact (key domain fact mps-type args? m ?mps t RS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact rs-filled-with args? m ?mps n ?rs-before&ZERO|ONE|TWO)) - ;MPS-CS CEs - (wm-fact (key domain fact mps-type args? m ?cs t CS)) - (wm-fact (key domain fact mps-team args? m ?cs col ?team-color)) - (wm-fact (key domain fact wp-on-shelf args? wp ?wp m ?cs spot ?spot)) - ; Formulate the goal only if it is not already formulated (prevents doubling - ; the goals due to matching with RS-1 and RS-2) - (not (goal (class GET-SHELF-TO-FILL-RS) (parent ?maintain-id) - (params robot ?robot cs ?cs wp ?wp spot ?spot - ))) - => - (printout t "Goal " GET-SHELF-TO-FILL-RS " formulated" crlf) - (bind ?distance (node-distance (str-cat ?mps -I))) - (assert (goal (id (sym-cat GET-SHELF-TO-FILL-RS- (gensym*))) - (class GET-SHELF-TO-FILL-RS) - (priority (+ ?*PRIORITY-PREFILL-RS* (goal-distance-prio ?distance))) - (parent ?maintain-id) (sub-type SIMPLE) - (params robot ?robot - cs ?cs - wp ?wp - spot ?spot - ) - (required-resources ?wp) - )) -) - - -(defrule goal-production-create-prefill-ring-station - ;Fill a ring station with the currently holding workpiece. - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class PREPARE-RINGS) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - (wm-fact (key domain fact wp-usable args? wp ?wp)) - (wm-fact (key domain fact holding args? r ?robot wp ?wp)) - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?mps t RS)) - (wm-fact (key domain fact mps-state args? m ?mps s ?state&~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact rs-filled-with args? m ?mps n ?rs-before&ZERO|ONE|TWO)) - (wm-fact (key domain fact rs-inc args? summand ?rs-before sum ?rs-after)) - ;CCs don't have a base color. Hence, models base with UNKOWN color - ; (not (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color))) - => - ;Check if this ring station should be filled with increased priority. - (bind ?priority-increase 0) - (do-for-all-facts ((?prio wm-fact)) (and (wm-key-prefix ?prio:key (create$ evaluated fact rs-fill-priority)) - (eq (wm-key-arg ?prio:key m) ?mps)) - (if (< ?priority-increase ?prio:value) - then - (bind ?priority-increase ?prio:value) - )) - ; - (if (eq ?state DOWN) - then - (bind ?priority-increase (- ?priority-increase 1)) - ) - (bind ?distance (node-distance (str-cat ?mps -I))) - (printout t "Goal " FILL-RS " formulated" crlf) - (assert (goal (id (sym-cat FILL-RS- (gensym*))) - (class FILL-RS) (sub-type SIMPLE) - (priority (+ ?*PRIORITY-PREFILL-RS* ?priority-increase (goal-distance-prio ?distance))) - (parent ?production-id) - (params robot ?robot - mps ?mps - wp ?wp - rs-before ?rs-before - rs-after ?rs-after - ) - (required-resources ?mps ?wp) - )) -) - - -(defrule goal-production-create-discard-unknown - "Discard a base which is not needed." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?parent) (class NO-PROGRESS) (mode FORMULATED)) - (goal (id ?urgent) (class URGENT) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;TODO: Model state IDLE - (wm-fact (key domain fact self args? r ?robot)) - (wm-fact (key domain fact holding args? r ?robot wp ?wp)) - ;only discard if ring stations have at least two bases loaded - ;(wm-fact (key domain fact rs-filled-with args? m ?mps n TWO|THREE)) - ;question: or would be more correct to create it and later - ; reject it because its not useful - ;only discard if there is no cap mounted (i.e. wp is not a finished product) - (or (and (and (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col RING_NONE))) - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order))) - (not (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)))) - => - (do-for-fact ((?wm wm-fact)) (wm-key-prefix ?wm:key (create$ monitoring safety-discard)) - (bind ?parent ?urgent) - (retract ?wm) - ) - (printout t "Goal " DISCARD-UNKNOWN " formulated" crlf) - (assert (goal (id (sym-cat DISCARD-UNKNOWN- (gensym*))) - (class DISCARD-UNKNOWN) (sub-type SIMPLE) - (priority ?*PRIORITY-DISCARD-UNKNOWN*) - (parent ?parent) - (params robot ?robot - wp ?wp - ) - (required-resources ?wp) - )) - ; (assert (goal-already-tried DISCARD-UNKNOWN)) -) - - -(defrule goal-production-create-produce-c0 -" Produce a C0 product: Get the correct base and mount the right cap on it. - The produced workpiece stays in the output of the used cap station after - successfully executing this goal. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) - (goal (id ?urgent) (class URGENT) (mode FORMULATED)) - ;To-Do: Model state IDLE|wait-and-look-for-alternatives - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-CS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (not (wm-fact (key domain fact wp-at args? wp ?any-wp m ?mps side INPUT))) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact cs-buffered args? m ?mps col ?cap-color)) - (wm-fact (key domain fact cs-can-perform args? m ?mps op MOUNT_CAP)) - ;MPS-BS CEs - (wm-fact (key domain fact mps-type args? m ?bs t BS)) - (domain-object (name ?bs-side&:(or (eq ?bs-side INPUT) (eq ?bs-side OUTPUT))) (type mps-side)) - (wm-fact (key domain fact mps-team args? m ?bs col ?team-color)) - ;To-Do: Model the bs active-side - ;Order CEs - (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - (wm-fact (key order meta competitive args? ord ?order) - (value ?competitive)) - - (wm-fact (key config rcll competitive-order-priority) (value ?comp-prio)) - - (wm-fact (key refbox team-color) (value ?team-color)) - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) - (value ?qd&:(> ?qr ?qd))) - (wm-fact (key refbox order ?order delivery-begin) (type UINT) - (value ?begin&:(< ?begin (+ (nth$ 1 ?game-time) ?*PRODUCE-C0-AHEAD-TIME*)))) - (wm-fact (key refbox order ?order delivery-end) (type UINT) - (value ?end&:(> ?end (+ (nth$ 1 ?game-time) ?*PRODUCE-C0-LATEST-TIME*)))) - ;Active Order CEs - ;This order complexity is not produced exclusively while another exclusive - ;complexity order is already started - (not (and (wm-fact (key domain fact wp-for-order args? wp ?ord-wp ord ?any-order)) - (wm-fact (key domain fact order-complexity args? ord ?any-order com ?other-complexity)) - (wm-fact (key config rcll exclusive-complexities) (values $?other-exclusive&:(member$ (str-cat ?other-complexity) ?other-exclusive))) - (wm-fact (key config rcll exclusive-complexities) (values $?exclusive&:(member$ (str-cat ?complexity) ?exclusive))))) - (or (and (wm-fact (key domain fact wp-spawned-for args? wp ?spawned-wp r ?robot)) - (wm-fact (key domain fact mps-state args? m ?bs s ~BROKEN&~DOWN)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (not (wm-fact (key domain fact wp-for-order args? wp ?any-ord-wp ord ?order)))) - (and (wm-fact (key domain fact holding args? r ?robot wp ?spawned-wp)) - (wm-fact (key domain fact wp-base-color args? wp ?spawned-wp col ?base-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp cap-color CAP_NONE)) - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)))) - (wm-fact (key config rcll allowed-complexities) (values $?allowed&:(member$ (str-cat ?complexity) ?allowed))) - (test (eq ?complexity C0)) - (not (goal (class PRODUCE-C0) - (parent ?parent) - (params robot ?robot - bs ?bs - bs-side ?bs-side $? - mps ?mps $? - order ?order - wp ?spawned-wp - ) - )) - => - (bind ?required-resources ?order ?spawned-wp) - ;If this order complexity should be produced exclusively ... - (if (any-factp ((?exclusive-complexities wm-fact)) - (and (wm-key-prefix ?exclusive-complexities:key (create$ config rcll exclusive-complexities)) - (neq FALSE (member$ (str-cat ?complexity) ?exclusive-complexities:values)))) - then - ;... then an exclusive order token is required. - (bind ?required-resources ?mps ?order ?spawned-wp PRODUCE-EXCLUSIVE-COMPLEXITY) - (printout t "Goal " PRODUCE-C0 " formulated, it needs the PRODUCE-EXCLUSIVE-COMPLEXITY token" crlf) - else - (printout t "Goal " PRODUCE-C0 " formulated" crlf)) - (bind ?parent ?production-id) - (bind ?priority-decrease 0) - (if (and (eq ?comp-prio "HIGH") ?competitive) - then - (bind ?parent ?urgent)) - (if (eq ?comp-prio "LOW") - then - (bind ?priority-decrease 1)) - (bind ?distance (node-distance (str-cat ?bs - (if (eq ?bs-side INPUT) then I else O)))) - (assert (goal (id (sym-cat PRODUCE-C0- (gensym*))) - (class PRODUCE-C0) (sub-type SIMPLE) - (priority (+ (- ?*PRIORITY-PRODUCE-C0* ?priority-decrease) (goal-distance-prio ?distance))) - (parent ?parent) - (params robot ?robot - bs ?bs - bs-side ?bs-side - bs-color ?base-color - mps ?mps - cs-color ?cap-color - order ?order - wp ?spawned-wp - ) - (required-resources (sym-cat ?mps -INPUT) ?required-resources) - )) -) - - -(defrule goal-production-create-mount-first-ring -" Start a higher order product by getting the base and mounting the first ring. - The workpiece remains in the output of the used ring station after - successfully finishing this goal. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) - - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?mps-rs t RS)) - (wm-fact (key domain fact mps-state args? m ?mps-rs s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps-rs col ?team-color)) - (wm-fact (key domain fact rs-filled-with args? m ?mps-rs n ?bases-filled)) - (wm-fact (key domain fact rs-ring-spec - args? m ?mps-rs r ?ring1-color&~RING_NONE rn ?bases-needed)) - (wm-fact (key domain fact rs-sub args? minuend ?bases-filled - subtrahend ?bases-needed - difference ?bases-remain&ZERO|ONE|TWO|THREE)) - (not (wm-fact (key domain fact rs-prepared-color args? m ?mps-rs col ?some-col))) - (not (wm-fact (key domain fact wp-at args? wp ?wp-rs m ?mps-rs side INPUT))) - (wm-fact (key domain fact mps-type args? m ?other-rs&~?mps-rs t RS)) - (wm-fact (key domain fact mps-team args? m ?other-rs col ?team-color)) - ; There is at least one other rs side, except for the target input, that - ; is free (because occupying all 4 sides at once can cause deadlocks) - (or (wm-fact (key domain fact mps-side-free args? m ?mps-rs side OUTPUT)) - (wm-fact (key domain fact mps-side-free args? m ?other-rs side ?any-side))) - ;MPS-BS CEs - (wm-fact (key domain fact mps-type args? m ?mps-bs t BS)) - (wm-fact (key domain fact mps-team args? m ?mps-bs col ?team-color)) - (domain-object (name ?bs-side&:(or (eq ?bs-side INPUT) (eq ?bs-side OUTPUT))) (type mps-side)) - ;Order CEs - (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) (value ?qd&:(> ?qr ?qd))) - ;Active Order CEs - ;No one started this order already - (or (and (wm-fact (key domain fact wp-spawned-for args? wp ?spawned-wp r ?robot)) - (wm-fact (key domain fact mps-state args? m ?mps-bs s ~BROKEN&~DOWN)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (not (wm-fact (key domain fact wp-for-order args? wp ?any-ord-wp ord ?order)))) - (and (wm-fact (key domain fact holding args? r ?robot wp ?spawned-wp)) - (wm-fact (key domain fact wp-base-color args? wp ?spawned-wp col ?base-color)) - (wm-fact (key domain fact wp-for-order args? wp ?spawned-wp ord ?order)) - (wm-fact (key domain fact wp-ring1-color args? wp ?spawned-wp col RING_NONE)))) - ;This order complexity is not produced exclusively while another exclusive - ;complexity order is already started - (not (and (wm-fact (key domain fact wp-for-order args? wp ?ord-wp&~?spawned-wp ord ?any-order)) - (wm-fact (key domain fact order-complexity args? ord ?any-order com ?other-complexity)) - (wm-fact (key config rcll exclusive-complexities) (values $?other-exclusive&:(member$ (str-cat ?other-complexity) ?other-exclusive))) - (wm-fact (key config rcll exclusive-complexities) (values $?exclusive&:(member$ (str-cat ?complexity) ?exclusive))))) - (or (wm-fact (key config rcll allowed-complexities) (values $?allowed&:(member$ (str-cat ?complexity) ?allowed))) - (allowed ?complexity) - ) - (test (neq ?complexity C0)) - (not (blocked ?complexity)) - ; Strategy CEs - (not (goal (class MOUNT-FIRST-RING) - (parent ?production-id) - (params robot ?robot $? - bs-side ?bs-side $? - order ?order - wp ?spawned-wp))) - (not (wm-fact (key strategy keep-mps-side-free args? m ?mps-rs side INPUT $?))) - => - (bind ?required-resources ?order ?spawned-wp) - ;If this order complexity should be produced exclusively ... - (if (any-factp ((?exclusive-complexities wm-fact)) - (and (wm-key-prefix ?exclusive-complexities:key (create$ config rcll exclusive-complexities)) - (neq FALSE (member$ (str-cat ?complexity) ?exclusive-complexities:values)))) - then - ;... then an exclusive order token is required. - (bind ?required-resources ?mps-rs ?order ?spawned-wp PRODUCE-EXCLUSIVE-COMPLEXITY) - (printout t "Goal " MOUNT-FIRST-RING " formulated, it needs the PRODUCE-EXCLUSIVE-COMPLEXITY token" crlf) - else - (printout t "Goal " MOUNT-FIRST-RING " formulated" crlf)) - (bind ?distance (node-distance (str-cat ?mps-bs - (if (eq ?bs-side INPUT) then I else O)))) - (assert (goal (id (sym-cat MOUNT-FIRST-RING- (gensym*))) - (class MOUNT-FIRST-RING) (sub-type SIMPLE) - (priority (+ ?*PRIORITY-MOUNT-FIRST-RING* (goal-distance-prio ?distance))) - (parent ?production-id) - (params robot ?robot - bs ?mps-bs - bs-side ?bs-side - bs-color ?base-color - mps ?mps-rs - ring-color ?ring1-color - rs-before ?bases-filled - rs-after ?bases-remain - rs-req ?bases-needed - order ?order - wp ?spawned-wp - ) - (required-resources (sym-cat ?mps-rs -INPUT) ?required-resources) - )) -) - - -(defrule goal-production-create-mount-next-ring -" Mount the next ring on a CX product: - - Take the started workpiece from the ring station output. - - Bring it to the ring station that can mount the next ring. - The workpiece remains in the output of the used ring station after - successfully finishing this goal. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (class INTERMEDEATE-STEPS) (id ?maintain-id) (mode FORMULATED)) - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?mps-rs t RS)) - (wm-fact (key domain fact mps-state args? m ?mps-rs s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps-rs col ?team-color)) - (wm-fact (key domain fact rs-filled-with args? m ?mps-rs n ?bases-filled)) - (wm-fact (key domain fact rs-ring-spec - args? m ?mps-rs r ?next-ring-color&~RING_NONE rn ?bases-needed)) - (wm-fact (key domain fact rs-sub args? minuend ?bases-filled - subtrahend ?bases-needed - difference ?bases-remain&ZERO|ONE|TWO|THREE)) - (not (wm-fact (key domain fact rs-prepared-color args? m ?mps-rs col ?some-col))) - - ;Order CEs - (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity&C2|C3)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?order-ring1-color)) - (wm-fact (key domain fact order-ring2-color args? ord ?order col ?order-ring2-color)) - (wm-fact (key domain fact order-ring3-color args? ord ?order col ?order-ring3-color)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) (value ?qd&:(> ?qr ?qd))) - ;WP CEs - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col ?wp-ring1-color)) - (wm-fact (key domain fact wp-ring2-color args? wp ?wp col ?wp-ring2-color)) - (wm-fact (key domain fact wp-ring3-color args? wp ?wp col ?wp-ring3-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - - ;The workpiece misses a ring - (test (or - (and (eq ?wp-ring1-color ?order-ring1-color) - (eq ?wp-ring2-color ?order-ring2-color) - (neq ?wp-ring3-color ?order-ring3-color) - (eq ?next-ring-color ?order-ring3-color)) - (and (eq ?wp-ring1-color ?order-ring1-color) - (neq ?wp-ring2-color ?order-ring2-color) - (eq ?next-ring-color ?order-ring2-color)))) - (or (and (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (wm-fact (key domain fact wp-at args? wp ?wp m ?prev-rs side OUTPUT))) - (and (wm-fact (key domain fact holding args? r ?robot wp ?wp)) - (wm-fact (key domain fact mps-type args? m ?prev-rs t RS)))) - (not (wm-fact (key domain fact wp-at args? wp ?wp-rs&:(neq ?wp-rs ?wp) m ?mps-rs side INPUT))) - (wm-fact (key config rcll allowed-complexities) (values $?allowed&:(member$ (str-cat ?complexity) ?allowed))) - ; Strategy CEs - (not (wm-fact (key strategy keep-mps-side-free - args? m ?mps-rs side INPUT cause ~?wp))) - (not (goal (class MOUNT-NEXT-RING) - (parent ?maintain-id) - (params robot ?robot $? - wp ?wp $? - order ?order))) - => - (bind ?ring-pos (member$ RING_NONE (create$ ?wp-ring1-color ?wp-ring2-color ?wp-ring3-color))) - (bind ?curr-ring-color (nth$ ?ring-pos (create$ ?order-ring1-color ?order-ring2-color ?order-ring3-color))) - (printout t "Goal " MOUNT-NEXT-RING " formulated (Ring " ?ring-pos")" crlf) - (assert (goal (id (sym-cat MOUNT-NEXT-RING- (gensym*))) - (class MOUNT-NEXT-RING) (priority (+ ?ring-pos ?*PRIORITY-MOUNT-NEXT-RING*)) - (parent ?maintain-id) (sub-type SIMPLE) - (params robot ?robot - prev-rs ?prev-rs - prev-rs-side OUTPUT - wp ?wp - rs ?mps-rs - ring1-color ?order-ring1-color - ring2-color ?order-ring2-color - ring3-color ?order-ring3-color - curr-ring-color ?curr-ring-color - ring-pos (int-to-sym ?ring-pos) - rs-before ?bases-filled - rs-after ?bases-remain - rs-req ?bases-needed - order ?order - ) - (required-resources (sym-cat ?mps-rs -INPUT) (sym-cat ?prev-rs -OUTPUT) ?wp) - )) -) - - -(defrule goal-production-create-produce-c1 -" Produce a C1 product: Get the workpiece with the mounted ring and mount - a cap on it. - The produced workpiece stays in the output of the used cap station after - successfully executing this goal. - - Note that the produce-c1, produce-c2, produce-c3 goal creation is - deliberately split into separate rules. This is done for readability and - to leave the option open to customize the strategy for CX products in - the future. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?maintain-id) (class INTERMEDEATE-STEPS) (mode FORMULATED)) - ;To-Do: Model state IDLE|wait-and-look-for-alternatives - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-CS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (not (wm-fact (key domain fact wp-at args? wp ?any-wp m ?mps side INPUT))) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact cs-buffered args? m ?mps col ?cap-color)) - (wm-fact (key domain fact cs-can-perform args? m ?mps op MOUNT_CAP)) - ;WP CEs - (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col ?ring1-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?rs t RS)) - (wm-fact (key domain fact mps-team args? m ?rs col ?team-color)) - ;Order CEs - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - (wm-fact (key domain fact order-complexity args? ord ?order com C1)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) - (value ?qd&:(> ?qr ?qd))) - (or (and (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (wm-fact (key domain fact wp-at args? wp ?wp m ?rs side OUTPUT))) - (wm-fact (key domain fact holding args? r ?robot wp ?wp))) - (not (goal (class PRODUCE-CX) - (parent ?maintain-id) - (params robot ?robot - wp ?wp $? - mps ?mps $? - order ?order))) - => - (printout t "Goal " PRODUCE-CX " formulated" crlf) - (assert (goal (id (sym-cat PRODUCE-CX- (gensym*))) (class PRODUCE-CX) - (priority ?*PRIORITY-PRODUCE-C1*) (sub-type SIMPLE) - (parent ?maintain-id) - (params robot ?robot - wp ?wp - rs ?rs - mps ?mps - cs-color ?cap-color - order ?order - ) - (required-resources (sym-cat ?mps -INPUT) (sym-cat ?rs -OUTPUT) ?wp) - )) -) - - -(defrule goal-production-create-produce-c2 -" Produce a C2 product: Get the workpiece with the mounted ring and mount - a cap on it. - The produced workpiece stays in the output of the used cap station after - successfully executing this goal. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (class INTERMEDEATE-STEPS) (id ?maintain-id) (mode FORMULATED)) - ;To-Do: Model state IDLE|wait-and-look-for-alternatives - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-CS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (not (wm-fact (key domain fact wp-at args? wp ?any-wp m ?mps side INPUT))) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact cs-buffered args? m ?mps col ?cap-color)) - (wm-fact (key domain fact cs-can-perform args? m ?mps op MOUNT_CAP)) - ;WP CEs - (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col ?ring1-color)) - (wm-fact (key domain fact wp-ring2-color args? wp ?wp col ?ring2-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?rs t RS)) - (wm-fact (key domain fact mps-team args? m ?rs col ?team-color)) - ;Order CEs - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - (wm-fact (key domain fact order-complexity args? ord ?order com C2)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) - (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) - (value ?qd&:(> ?qr ?qd))) - (or (and (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (wm-fact (key domain fact wp-at args? wp ?wp m ?rs side OUTPUT))) - (wm-fact (key domain fact holding args? r ?robot wp ?wp))) - (not (goal (class PRODUCE-CX) - (parent ?maintain-id) - (params robot ?robot - wp ?wp $? - mps ?mps $? - order ?order))) - => - (printout t "Goal " PRODUCE-CX " (C2) formulated" crlf) - (assert (goal (id (sym-cat PRODUCE-CX- (gensym*))) (class PRODUCE-CX) - (priority ?*PRIORITY-PRODUCE-C2*) (sub-type SIMPLE) - (parent ?maintain-id) - (params robot ?robot - wp ?wp - rs ?rs - mps ?mps - cs-color ?cap-color - order ?order - ) - (required-resources (sym-cat ?mps -INPUT) (sym-cat ?rs -OUTPUT) ?wp) - )) -) - - -(defrule goal-production-create-produce-c3 -" Produce a C3 product: Get the workpiece with the mounted ring and mount - a cap on it. - The produced workpiece stays in the output of the used cap station after - successfully executing this goal. -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (class INTERMEDEATE-STEPS) (id ?maintain-id) (mode FORMULATED)) - ;To-Do: Model state IDLE|wait-and-look-for-alternatives - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-CS CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (not (wm-fact (key domain fact wp-at args? wp ?any-wp m ?mps side INPUT))) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - (wm-fact (key domain fact cs-buffered args? m ?mps col ?cap-color)) - (wm-fact (key domain fact cs-can-perform args? m ?mps op MOUNT_CAP)) - ;WP CEs - (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col ?ring1-color)) - (wm-fact (key domain fact wp-ring2-color args? wp ?wp col ?ring2-color)) - (wm-fact (key domain fact wp-ring3-color args? wp ?wp col ?ring3-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col CAP_NONE)) - ;MPS-RS CEs - (wm-fact (key domain fact mps-type args? m ?rs t RS)) - (wm-fact (key domain fact mps-team args? m ?rs col ?team-color)) - ;Order CEs - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - (wm-fact (key domain fact order-complexity args? ord ?order com C3)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) - (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) - (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - - (wm-fact (key refbox game-time) (values $?game-time)) - (wm-fact (key refbox team-color) (value ?team-color)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) - (value ?qd&:(> ?qr ?qd))) - (or (and (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp))) - (wm-fact (key domain fact wp-at args? wp ?wp m ?rs side OUTPUT))) - (wm-fact (key domain fact holding args? r ?robot wp ?wp))) - (not (goal (class PRODUCE-CX) - (parent ?maintain-id) - (params robot ?robot - wp ?wp $? - mps ?mps $? - order ?order))) - => - (printout t "Goal " PRODUCE-CX " (C3) formulated" crlf) - (assert (goal (id (sym-cat PRODUCE-CX- (gensym*))) (class PRODUCE-CX) - (priority ?*PRIORITY-PRODUCE-C3*) (sub-type SIMPLE) - (parent ?maintain-id) - (params robot ?robot - wp ?wp - rs ?rs - mps ?mps - cs-color ?cap-color - order ?order - ) - (required-resources (sym-cat ?mps -INPUT) (sym-cat ?rs -OUTPUT) ?wp) - )) -) - - (defrule goal-production-create-reset-mps " Reset an mps to restore a consistent world model after getting a workpiece from it failed too often. @@ -1329,117 +458,6 @@ )) ) - -(defrule goal-production-create-discard-failed-put-slide -" Discard the currently held workpiece after filling it to a ring station - failed too often -" - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class NO-PROGRESS) (mode FORMULATED)) - (wm-fact (key refbox team-color) (value ?team-color)) - ;To-Do: Model state IDLE - (wm-fact (key domain fact self args? r ?robot)) - (wm-fact (key domain fact holding args? r ?robot wp ?wp)) - (wm-fact (key domain fact mps-type args? m ?mps t RS)) - ?t <- (wm-fact (key monitoring action-retried args? r ?self a wp-put-slide-cc m ?mps wp ?wp) - (value ?tried&:(>= ?tried ?*MAX-RETRIES-PICK*))) - - => - (printout t "Goal " DISCARD-UNKNOWN " formulated" crlf) - (assert (goal (id (sym-cat DISCARD-UNKNOWN- (gensym*))) - (class DISCARD-UNKNOWN) (sub-type SIMPLE) - (priority ?*PRIORITY-RESET*) - (parent ?production-id) - (params robot ?robot - wp ?wp - ) - (required-resources ?wp) - )) - (retract ?t) -) - -(defrule goal-production-create-deliver - "Deliver a fully produced workpiece." - (declare (salience ?*SALIENCE-GOAL-FORMULATE*)) - (goal (id ?production-id) (class DELIVER-PRODUCTS) (mode FORMULATED)) - (goal (id ?urgent) (class URGENT) (mode FORMULATED)) - ;To-Do: Model state IDLE|wait-and-look-for-alternatives - (wm-fact (key refbox team-color) (value ?team-color)) - (wm-fact (key refbox game-time) (values $?game-time)) - ;Robot CEs - (wm-fact (key domain fact self args? r ?robot)) - ;MPS-DS CEs - (wm-fact (key domain fact mps-type args? m ?ds t DS)) - (wm-fact (key domain fact mps-team args? m ?ds col ?team-color)) - ;MPS-CEs - (wm-fact (key domain fact mps-type args? m ?mps t CS|SS)) - (wm-fact (key domain fact mps-state args? m ?mps s ~BROKEN)) - (wm-fact (key domain fact mps-team args? m ?mps col ?team-color)) - ;WP-CEs - (wm-fact (key domain fact wp-base-color args? wp ?wp col ?base-color)) - (wm-fact (key domain fact wp-ring1-color args? wp ?wp col ?ring1-color)) - (wm-fact (key domain fact wp-ring2-color args? wp ?wp col ?ring2-color)) - (wm-fact (key domain fact wp-ring3-color args? wp ?wp col ?ring3-color)) - (wm-fact (key domain fact wp-cap-color args? wp ?wp col ?cap-color)) - (not (wm-fact (key domain fact wp-at args? wp ?any-wp m ?ds side INPUT))) - ;Order-CEs - (wm-fact (key domain fact wp-for-order args? wp ?wp ord ?order)) - (wm-fact (key domain fact order-complexity args? ord ?order com ?complexity)) - (wm-fact (key domain fact order-base-color args? ord ?order col ?base-color)) - (wm-fact (key domain fact order-ring1-color args? ord ?order col ?ring1-color)) - (wm-fact (key domain fact order-ring2-color args? ord ?order col ?ring2-color)) - (wm-fact (key domain fact order-ring3-color args? ord ?order col ?ring3-color)) - (wm-fact (key domain fact order-cap-color args? ord ?order col ?cap-color)) - (wm-fact (key domain fact order-gate args? ord ?order gate ?gate)) - (wm-fact (key refbox order ?order quantity-requested) (value ?qr)) - ;note: could be moved to rejected checks - (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) - (value ?qd&:(> ?qr ?qd))) - (or (and (wm-fact (key domain fact wp-at args? wp ?wp m ?mps side OUTPUT)) - (not (wm-fact (key domain fact holding args? r ?robot wp ?any-wp)))) - (wm-fact (key domain fact holding args? r ?robot wp ?wp))) - (not (wm-fact (key wp meta wait-for-delivery args? wp ?wp wait-for ?))) - (wm-fact (key order meta competitive args? ord ?order) (value ?competitive)) - (wm-fact (key config rcll competitive-order-priority) (value ?comp-prio)) - (wm-fact (key refbox order ?order delivery-begin) (type UINT) - (value ?begin&:(< ?begin (+ (nth$ 1 ?game-time) ?*DELIVER-AHEAD-TIME*)))) - (not (goal (class DELIVER) - (parent ?parent) - (params robot ?robot $? - order ?order - wp ?wp - ds ?ds - ds-gate ?gate $?))) - => - (printout t "Goal " DELIVER " formulated" crlf) - (bind ?parent ?production-id) - (bind ?priority-decrease 0) - (if (and (eq ?comp-prio "HIGH") ?competitive) - then - (bind ?parent ?urgent)) - (if (eq ?comp-prio "LOW") - then - (bind ?priority-decrease 1)) - (assert (goal (id (sym-cat DELIVER- (gensym*))) - (class DELIVER) (sub-type SIMPLE) - (priority (- ?*PRIORITY-DELIVER* ?priority-decrease)) - (parent ?parent) - (params robot ?robot - mps ?mps - order ?order - wp ?wp - ds ?ds - ds-gate ?gate - base-color ?base-color - ring1-color ?ring1-color - ring2-color ?ring2-color - ring3-color ?ring3-color - cap-color ?cap-color - ) - (required-resources (sym-cat ?mps -OUTPUT) ?order ?wp (sym-cat ?ds -INPUT)) - )) -) - (defrule goal-production-wait-for-mps-processing " If a mps is ready to process (IDLE and not wp at input) drive to output and wait for this mps @@ -1548,6 +566,7 @@ args? wp ?wp ord ?order) (value TRUE)) (not (wm-fact (key domain fact wp-usable args? wp ?wp))) + ?do <- (domain-object (name ?wp)) => (retract ?wp-for-order) (delayed-do-for-all-facts ((?wm wm-fact)) @@ -1557,4 +576,5 @@ ) (printout debug "WP " ?wp " no longer tied to Order " ?order " because it is not usable anymore" crlf) + (retract ?do) ) diff --git a/src/clips-specs/rcll/goal-reasoner.clp b/src/clips-specs/rcll/goal-reasoner.clp index bf1e4e168b..7a5c906e42 100644 --- a/src/clips-specs/rcll/goal-reasoner.clp +++ b/src/clips-specs/rcll/goal-reasoner.clp @@ -371,6 +371,7 @@ (params m ?mps ord ?order)) (wm-fact (id "/refbox/team-color") (value ?team-color&:(neq ?team-color nil))) ?od <- (wm-fact (key domain fact quantity-delivered args? ord ?order team ?team-color) (value ?val)) + ?odd <- (domain-fact (name refbox-order-quantity-delivered) (param-values ?order ?df-val)) (plan-action (goal-id ?goal-id) (action-name ?prepare-action) (state FINAL)) ?pre <- (wm-fact (key mps-handling prepare ?prepare-action ?mps args? $?prepare-params)) ?pro <- (wm-fact (key mps-handling process ?process-action ?mps args? $?process-params)) @@ -379,6 +380,7 @@ (if (eq ?outcome COMPLETED) then (modify ?od (value (+ ?val 1))) + (modify ?odd (param-values ?order (+ ?df-val 1))) ) (modify ?g (mode EVALUATED)) ) diff --git a/src/clips-specs/rcll/goals/simple.clp b/src/clips-specs/rcll/goals/simple.clp index 299c52900a..33d242567d 100644 --- a/src/clips-specs/rcll/goals/simple.clp +++ b/src/clips-specs/rcll/goals/simple.clp @@ -84,6 +84,9 @@ => (delayed-do-for-all-facts ((?p plan)) (eq ?p:goal-id ?goal-id) (delayed-do-for-all-facts ((?a plan-action)) (eq ?a:plan-id ?p:id) + (do-for-all-facts ((?g pddl-grounding)) (eq ?a:precondition ?g:id) + (retract ?g) + ) (retract ?a) ) (retract ?p) diff --git a/src/clips-specs/rcll/noop-actions.clp b/src/clips-specs/rcll/noop-actions.clp index f700951735..b9f5827853 100644 --- a/src/clips-specs/rcll/noop-actions.clp +++ b/src/clips-specs/rcll/noop-actions.clp @@ -19,6 +19,19 @@ ; Read the full text in the LICENSE.GPL file in the doc directory. ; +(defglobal + ?*MIN-EXEC-DURATION* = 4 +) + +;A timeout for an action +(deftemplate action-timer + (slot plan-id (type SYMBOL)) + (slot action-id(type NUMBER)) + (slot timeout-duration) + (multislot start-time) + (slot status) +) + (defrule action-execute-exogenous-noops ?pa <- (plan-action (plan-id ?plan-id) (id ?id) (state PENDING) (action-name ?action&bs-dispense-for-order @@ -35,6 +48,14 @@ |fulfill-order-c3) (executable TRUE) (param-values $?param-values)) + + (wm-fact (key game state) (value RUNNING)) + (wm-fact (key refbox game-time) (values $?now)) + ?pt <- (action-timer (plan-id ?plan-id) (status ?status) + (action-id ?id) + (start-time $?st) + ) + (test (timeout ?now ?st ?*MIN-EXEC-DURATION*)) => (printout t "Executing " ?action ?param-values crlf) (modify ?pa (state EXECUTION-SUCCEEDED)) diff --git a/src/clips-specs/rcll/refbox-worldmodel.clp b/src/clips-specs/rcll/refbox-worldmodel.clp index e30bbbe76d..81c7905f1c 100644 --- a/src/clips-specs/rcll/refbox-worldmodel.clp +++ b/src/clips-specs/rcll/refbox-worldmodel.clp @@ -26,11 +26,12 @@ => (bind ?beacon-name (pb-field-value ?p "peer_name")) (printout debug "Beacon Recieved from " ?beacon-name crlf) - (retract ?pf) + (retract ?pf) ) (defrule refbox-recv-GameState + (declare (salience 1000)) ?pf <- (protobuf-msg (type "llsf_msgs.GameState") (ptr ?p) (rcvd-from ?host ?port)) ?gt <- (wm-fact (key refbox game-time)) ?rp <- (wm-fact (id "/refbox/phase") (value ?phase) ) @@ -69,6 +70,10 @@ (assert (wm-fact (key refbox game-time) (is-list TRUE) (type UINT) (values ?sec (/ ?nsec 1000)))) (assert (wm-fact (id "/refbox/points/magenta") (type UINT) (value (pb-field-value ?p "points_magenta")) )) (assert (wm-fact (id "/refbox/points/cyan") (type UINT) (value (pb-field-value ?p "points_cyan")) )) + (assert (wm-fact (key domain fact refbox-game-time args? value ?sec))) + (assert (wm-fact (key domain fact refbox-points-magenta args? value (pb-field-value ?p "points_magenta")))) + (assert (wm-fact (key domain fact refbox-points-cyan args? value (pb-field-value ?p "points_cyan")))) + (assert (domain-fact (name refbox-team-color) (param-values ?new-team-color))) ) @@ -105,14 +110,16 @@ (loop-for-count (?c (+ 1 ?rings-count) 3) do (assert (wm-fact (key domain fact (sym-cat order- ring ?c -color) args? ord ?order-id col RING_NONE) (type BOOL) (value TRUE) )) ) - (assert - (wm-fact (key domain fact order-complexity args? ord ?order-id comp ?complexity) (type BOOL) (value TRUE) ) + (assert + (wm-fact (key domain fact order-complexity args? ord ?order-id com ?complexity) (type BOOL) (value TRUE) ) (wm-fact (key domain fact order-base-color args? ord ?order-id col ?base) (type BOOL) (value TRUE) ) (wm-fact (key domain fact order-cap-color args? ord ?order-id col ?cap) (type BOOL) (value TRUE) ) (wm-fact (key domain fact order-gate args? ord ?order-id gate (sym-cat GATE- ?delivery-gate)) (type BOOL) (value TRUE) ) (wm-fact (key refbox order ?order-id quantity-requested) (type UINT) (value ?quantity-requested) ) + (domain-fact (name refbox-order-quantity-requested) (param-values ?order-id ?quantity-requested)) (wm-fact (key domain fact quantity-delivered args? ord ?order-id team CYAN) (type UINT) (value 0)) + (domain-fact (name refbox-order-quantity-delivered) (param-values ?order-id 0)) (wm-fact (key domain fact quantity-delivered args? ord ?order-id team MAGENTA) (type UINT) (value 0)) (wm-fact (key refbox order ?order-id delivery-begin) (type UINT) (value ?begin) ) @@ -150,7 +157,7 @@ (bind ?m-type (sym-cat (pb-field-value ?m "type"))) (bind ?m-team (sym-cat (pb-field-value ?m "team_color"))) (bind ?m-state (sym-cat (pb-field-value ?m "state"))) - (if (not (any-factp ((?wm-fact wm-fact)) + (if (not (any-factp ((?wm-fact wm-fact)) (and (wm-key-prefix ?wm-fact:key (create$ domain fact mps-state)) (eq ?m-name (wm-key-arg ?wm-fact:key m))))) then @@ -164,12 +171,12 @@ ) ) ) - (do-for-fact ((?wm-fact wm-fact)) - (and (wm-key-prefix ?wm-fact:key (create$ domain fact mps-state)) + (do-for-fact ((?wm-fact wm-fact)) + (and (wm-key-prefix ?wm-fact:key (create$ domain fact mps-state)) (eq ?m-name (wm-key-arg ?wm-fact:key m)) (neq ?m-state (wm-key-arg ?wm-fact:key s))) (retract ?wm-fact) - (assert (wm-fact (key domain fact mps-state args? m ?m-name s ?m-state) (type BOOL) (value TRUE))) + (assert (wm-fact (key domain fact mps-state args? m ?m-name s ?m-state) (type BOOL) (value TRUE))) ) ) ) @@ -209,6 +216,7 @@ (wm-fact (key refbox field-ground-truth zone args? m ?name) (value ?zone)) (wm-fact (key refbox field-ground-truth yaw args? m ?name) (type FLOAT) (value ?yaw)) (wm-fact (key refbox field-ground-truth orientation args? m ?name) (type FLOAT) (value ?rot)) + (wm-fact (key domain fact refbox-field-ground-truth args? name ?name mtype ?type zone ?zone yaw ?yaw orientation ?rot)) ) (bind ?rcv-ground-truth TRUE) else @@ -247,3 +255,38 @@ ) ) ) + +(defrule refbox-manage-domain-facts-refbox-game-time + ?p <- (wm-fact (key domain fact refbox-game-time args? value ?sec)) + (not (wm-fact (key refbox game-time) (is-list TRUE) (type UINT) (values ?sec $?))) + => + (retract ?p) +) + +(defrule refbox-manage-domain-facts-refbox-points-magenta + ?p <- (wm-fact (key domain fact refbox-points-magenta args? value ?points)) + (not (wm-fact (key domain fact refbox points magenta) (type UINT) (value ?points))) + => + (retract ?p) +) + +(defrule refbox-manage-domain-facts-refbox-points-cyan + ?p <- (wm-fact (key domain fact refbox-points-cyan args? value ?points)) + (not (wm-fact (key domain fact refbox points cyan) (type UINT) (value ?points))) + => + (retract ?p) +) + + +(defrule refbox-manage-domain-facts-refbox-field-ground-truth + ?p <- (wm-fact (key domain fact refbox-field-ground-truth args? name ?name mtype ?type zone ?zone yaw ?yaw orientation ?rot)) + (or + (not (wm-fact (key refbox field-ground-truth name args? m ?name))) + (not (wm-fact (key refbox field-ground-truth mtype args? m ?name) (value ?type))) + (not (wm-fact (key refbox field-ground-truth zone args? m ?name) (value ?zone))) + (not (wm-fact (key refbox field-ground-truth yaw args? m ?name) (type FLOAT) (value ?yaw))) + (not (wm-fact (key refbox field-ground-truth orientation args? m ?name) (type FLOAT) (value ?rot))) + ) + => + (retract ?p) +)