; ********************************************************************** ; * The procedures in this file output a valid sequence of actions * ; * and observations for a given knowledge base and set of action * ; * definitions. * ; * They take a set of action descriptions * ; * (preconditions and effects), an initial belief state, an * ; * integer to indicate how many action/observation pairs to * ; * generate, and an integer to indicate how many observations * ; * should be generated per action. They output a sequence of * ; * action/observation pairs * ; * * ; * Authors: Megan Nance, Brian Hlubocky, Afsaneh Shirazi * ; * Date: September, 2004 * ; * * ; ********************************************************************** (setq dirname "/home/eyal/nance/Generator/") ;(setq dirname "C:/Documents and Settings/nance/My Documents/Generator/") ;the following code taken from STRIPS filter code written by Eyal Amir ;---------------------------------------------------------------------- (defun recursive-substitute (new-item old-item tree) (if tree ; else nil (if (not (listp tree)) (if (equal old-item tree) new-item tree) ; stop (cons (recursive-substitute new-item old-item (car tree)) (recursive-substitute new-item old-item (cdr tree))) ) )) ;---------------------------------------------------------------------- (defun get-subsequent (start lst) (nth (+ 1 (position start lst)) lst) ) ;---------------------------------------------------------------------- (defun get-fluents (formula) (setq fluents (if formula ; else nil (if (listp formula) (if (or (equal (car formula) 'and) (equal (car formula) 'or) (equal (car formula) 'not)) (loop for obj in (cdr formula) append (get-fluents obj)) (list formula)) (list formula)))) (remove-duplicates fluents :from-end T :test #'equal)) ;========================================================================= (defun getContent (filename) (setq filestr (open filename :direction :input)) (format *standard-output* "reading file : ~S~%" filename) (setq content (read filestr)) ; reads a list from the file (close filestr) content ) ;========================================================================= (defun write-to-file (lst filename comment) (setq outfilestr (open filename :direction :output :if-exists :supersede :if-does-not-exist :create)) (format outfilestr comment) (prin1 lst outfilestr) (close outfilestr) ) ;========================================================================= (defun all-permutations (variables objects) (if (equal nil variables) (list nil) (let ((var nil)) (setq var (car variables)) (setq permutations-togo (all-permutations (cdr variables) objects)) (loop for obj in objects append (loop for perm in permutations-togo collect (cons (list var obj) perm))) ) ) ) ;========================================================================= (defun get-permutation (combination) (loop for item in combination collect (cadr item)) ) ;========================================================================= (defun propositionalize-action (action-def objects) (let ((action-name nil) (params nil) (preconds nil) (effects nil)) (setq action-name (cadr action-def)) (setq params (get-subsequent ':parameters action-def)) (setq preconds (get-subsequent ':precondition action-def)) (setq effects (get-subsequent ':effect action-def)) (setq combinations (all-permutations params objects)) (loop for comb in combinations collect (let ((curr-action action-def)) (loop for substitution in comb do (setq curr-action (recursive-substitute (cadr substitution) (car substitution) curr-action))) (substitute (cons action-name (get-permutation comb)) action-name curr-action)) ) ) ) ;========================================================================= (defun propositionalize (domain objects) (loop for clause in domain append (if (and (listp clause) (equal ':action (car clause))) (propositionalize-action clause objects) (list clause)) ) ) ;====================================================================== (defun propositionalize-pred (pred objects) (let ((params nil)) (setq params (cdr pred)) (setq combinations (all-permutations params objects)) (loop for comb in combinations collect (let ((curr-pred pred)) (loop for substitution in comb do (setq curr-pred (recursive-substitute (cadr substitution) (car substitution) curr-pred))) curr-pred) ) ) ) (defun propositionalize-predicates (predicates objects) (loop for pred in predicates append (propositionalize-pred pred objects) ) ) ;;;end of STRIPS filter code by Eyal Amir ;========================================================================= ;;the following code written by Megan Nance and Brian Hlubocky, September 2004 ; -------- search_action -------- ; input: the action to be generated ; output: the fully specified and validated action, or nil (defun search-action (action) ;make sure preconds are in CNF (setq action (substitute (convert-to-cnf (nth 5 action)) (nth 5 action) action :test #'equal)) (setq action (search-action-rec action 1)) ;call function to specify action parameters action ) ; -------- search_action_rec -------- ; input: the partially specified action, the index to the ; current precondition ; output: the fully specified and validated action, or nil (defun search-action-rec (action precondIndex) ; (print (nth precondIndex (nth 5 action))) (setq returnVal nil) (setq currPreconds (nth 5 action)) ;;entire list of preconds for current action (if (< precondIndex (list-length currPreconds)) (if (equal (car (nth precondIndex currPreconds)) 'OR) ;if the current precond is a disjunction (setq returnVal (match-or-precondition action precondIndex)) (setq returnVal (match-predicate-precondition action precondIndex))) (setq returnVal action)) returnVal ) ; NOTE: I don't think we need to use KB indices since the loop ; mechanism should keep track of where we are at without a ; performance problem. (defun match-or-precondition (action precondIndex) ;;RANDOM ; for each clause that IS a disjunction and that ; matches a precondition by name... ; (print "MATCH-OR") (setq currPreconds (nth 5 action)) ;entire list of preconds of action with current instantiations (setq currEffects (nth 7 action)) ;entire list of effects of action with current instantiations (setq precond (nth precondIndex currPreconds)) ;current clause in preconds that we are instantiating (setq returnVal nil) (setq precondElems (cdr precond)) ; (print action) (loop while (AND precondElems (NOT returnVal)) ;want to loop for each element in the disjunction do (let* ((unifyList nil) (rs1 (make-random-state t))) (setq literal (nth (random (list-length precondElems) rs1) precondElems)) ;;get random element from disjunction (setq precondElems (delete literal precondElems :test #'equal)) ;;remove from list so we only check it once (setq precondArgs (cond ((equal (car literal) 'not) (cdadr literal)) ;precondArgs is list of parameters that we try to unify with *kb* (t (cdr literal)))) (loop for clause in *kb* ;loop through each literal in KB and collect those that unify do (if (listp clause) (if (listp literal) (if(and (not (equal (car clause) 'or)) (or (and (equal (car literal) 'not) (equal (car clause) 'not) (equal (cadr literal) (cadr clause))) (and (not (equal (car literal) 'not)) (not (equal (car clause) 'not)) (equal (car literal) (car clause))))) (let ((kbArgs (cond ((equal (car clause) 'not) (cdadr clause)) ;kbArgs is list of parameters in clause that (t (cdr clause))))) ;we are trying to unify with from *kb* (if (args-do-unify precondArgs kbArgs) ;if we can unify the argument lists (setq unifyList (append unifyList (list kbArgs))))))))) ;append args to list of those that unify (loop while (AND unifyList (NOT returnVal)) ;loop while there are still elements to try, and we have not already returned a good action do (setq unifyArgs (nth (random (list-length unifyList) rs1) unifyList)) ;pick random argument list that we already know does unify (setq unifyList (delete unifyArgs unifyList :test #'equal)) ;remove this list, since we will only try it once (let ((editedAction action) ;set copy of action that we can modify (editedParams (nth 3 action))) (loop for i from 0 to (- (list-length unifyArgs) 1) ;substitute into parameters list do (setq editedParams (substitute (nth i unifyArgs) (nth i precondArgs) editedParams))) (setq editedPreEff (subst-params unifyArgs precondArgs currPreconds currEffects)) ;make correct substitutions in effects and preconds lists (setq editedAction (substitute (car editedPreEff) currPreconds editedAction :test #'equal)) ;editedAction now has new preconds lists (setq editedAction (substitute (cdr editedPreEff) currEffects editedAction :test #'equal)) ;editedAction now has new effects lists (setq editedAction (substitute editedParams (nth 3 action) editedAction :test #'equal)) ;editedAction now has new params list (setq returnVal (search-action-rec editedAction (+ 1 precondIndex))) )) )) returnVal ) ; NOTE: I don't think we need to use KB indices since the loop ; mechanism should keep track of where we are at without a ; performance problem. (defun match-predicate-precondition (action precondIndex) ;;RANDOM!! ; for each clause that is not a disjunction and that ; matches a precondition by name... ;(print action) (let* ;(print "match normal") ((returnVal nil) (currPreconds (nth 5 action)) ;entire list of preconds of action with current instantiations (currEffects (nth 7 action)) ;entire list of effects of action with current instantiations (precond (nth precondIndex currPreconds)) ;current clause in preconds that we are instantiating (precondArgs (cond ((equal (car precond) 'not) (cdadr precond)) ;precondArgs is list of parameters that we (t (cdr precond)))) ;are trying to unify with from *kb* (unifyList nil) (rs1 (make-random-state t))) ;(print precond) (loop for clause in *kb* do (if (listp clause) (if(and (not (equal (car clause) 'or)) (or (and (equal (car precond) 'not) (equal (car clause) 'not) (equal (cadr precond) (cadr clause))) (and (not (equal (car precond) 'not)) (not (equal (car clause) 'not)) (equal (car precond) (car clause))))) (let ((kbArgs (cond ((equal (car clause) 'not) (cdadr clause)) ;kbArgs is list of parameters in clause that we (t (cdr clause))))) ;are trying to unify with from *kb* (if (args-do-unify precondArgs kbArgs) ;if we can unify the argument lists (setq unifyList (append unifyList (list kbArgs)))))))) ;make list of all predicates that will unify from *kb* ;(print unifyList) (loop while (AND unifyList (NOT returnVal)) do (setq unifyArgs (nth (random (list-length unifyList) rs1) unifyList)) ;pick random argument list that we already know does unify (setq unifyList (delete unifyArgs unifyList :test #'equal)) ;remove this list, since we will only try it once ;(print "UNIFYARGS") ;(print unifyArgs) ;(print precondArgs) (setq editedAction action) ;set copy of action that we can modify (setq editedParams (nth 3 action)) (loop for i from 0 to (- (list-length unifyArgs) 1) ;substitute into parameters list do (setq editedParams (substitute (nth i unifyArgs) (nth i precondArgs) editedParams))) (setq editedPreEff (subst-params unifyArgs precondArgs currPreconds currEffects)) ;make correct substitutions in effects and preconds lists (setq editedAction (substitute (car editedPreEff) currPreconds editedAction :test #'equal)) ;editedAction now has new preconds lists (setq editedAction (substitute (cdr editedPreEff) currEffects editedAction :test #'equal)) ;editedAction now has new effects lists (setq editedAction (substitute editedParams (nth 3 action) editedAction :test #'equal)) ;editedAction now has new params list ;(print editedAction) (setq returnVal (search-action-rec editedAction (+ 1 precondIndex))) ;(print returnVal) ;(print "RETURNED") ;(print unifyList) ) ) ; (if returnVal ; (return returnVal) ; (setq precond (nth precondIndex (nth 5 action)) currPreconds (nth 5 action) currEffects (nth 7 action)) returnVal ) ;checks to see if precondArgs unify with kbArgs ; parameters preceded by '?' are considered to be unistantiated ;returns T if lists unify, nil otherwise (defun args-do-unify (precondArgs kbArgs) ; (print precondArgs) ; (print kbArgs) (cond ((AND (NOT precondArgs) (NOT kbArgs)) T) ;both lists are empty ((OR (NOT kbArgs) (NOT precondArgs)) nil);only one list is empty. so lists weren't of the same length ((equal (car precondArgs) (car kbArgs)) (args-do-unify (cdr precondArgs) (cdr kbArgs))) ((numberp (car precondArgs)) ;preconds parameter is instantiated and is a number (if(not (equal (car precondArgs) (car kbArgs))) nil T)) ((equal (char (string (car precondArgs)) 0) '#\?) (args-do-unify (cdr precondArgs) (cdr kbArgs))) (T nil)) ) ;========================================================================= ;short recursive function to apply substitution to all sublists; have to skip over 'NOT, 'OR, and 'AND ;since those are not lists and would cause the function to error ;added by Megan (defun subst-all (lst new old) (cond ((NULL lst) lst) ((equal (car lst) NIL) (car lst)) ((listp (car lst)) (if (OR (equal (caar lst) 'NOT) (equal (caar lst) 'OR) (equal (caar lst) 'AND)) (cons (append (list (caar lst)) (subst-all (list(cadar lst)) new old) (subst-all (cddar lst) new old)) (append (subst-all (list (cadr lst)) new old) (subst-all (cddr lst) new old))) (cons (substitute new old (car lst)) (subst-all (cdr lst) new old)))) (T (cons (substitute new old (car lst)) (subst-all (cdr lst) new old)))) ;;was (cons (substitute new old (car lst)) etc) ) ;========================================================================= ;replace gen-elements with spec-elements in lists lst1 and lst2 ;gen-elements and spec-elements should be lists, where the first element ;in gen-elements should be replaced with the first element in spec-elements, ;and so on, in both lst1 and lst2 ;added by Megan (defun subst-params (spec-elements gen-elements lst1 lst2) (if (OR (equal (car lst1) 'AND) (equal (car lst1) 'OR)(equal (car lst1) 'NOT)) (setq lst1front (list (car lst1)) lst1 (cdr lst1)) (setq lst1front nil)) (if (OR (equal (car lst2) 'AND) (equal (car lst2) 'OR) (equal (car lst1) 'NOT)) (setq lst2front (list (car lst2)) lst2 (cdr lst2)) (setq lst2front nil)) (if (not (equal spec-elements nil)) (if (eql (length spec-elements) (length gen-elements)) (loop while spec-elements do (setq lst1 (subst-all lst1 (car spec-elements) (car gen-elements))) (setq lst2 (subst-all lst2 (car spec-elements) (car gen-elements))) (setq spec-elements (cdr spec-elements)) (setq gen-elements (cdr gen-elements))) (prin1 "List lengths are not equal!"))) (setq lst1 (append lst1front lst1)) (setq lst2 (append lst2front lst2)) (setq returnlst (cons lst1 lst2)) ) ;------------------------------------------------------------------------------- ;;Procedures used to generate predicates that we know are satisfied based on domain-constraint ;; axioms and the KB. For example, for the axiom ;; ((NOT(clear [x y] [a b]))<==>(all spaces between [x y] and [a b] exclusive are empty)) ;; when we have a specified [x y] and [a b], we just look through the KB to make sure that all the ;; needed statements about spaces being empty are present. If so, then we can add the corresponding ;; "clear" statement ;;assume we have access to global knowledge base *kb*, which we will be updating (defun update-constraints (constrLst) (loop for item in constrLst do (setq curr-constr (cadr (cadadr item))) ;;current constraint we are looking at (setq curr-conditions (car (cddadr item))) ;;conditions for that constraint (if (NOT (equal (car curr-conditions) 'AND)) (setq curr-conditions (list curr-conditions)) (setq curr-conditions (cdr curr-conditions))) ;;'OR case?? need to consider? (if (subsetp curr-conditions *kb* :test #'equal) ;;if conditions are met by *kb* (if (NOT (member curr-constr *kb* :test #'equal)) ;;and constraint isn't already in knowledge base (setq *kb* (append *kb* (list curr-constr)))) ;;then add constraint to *kb* (if (member curr-constr *kb* :test #'equal) ;;if conditions aren't met but constraint is in *kb* (setq *kb* (delete curr-constr *kb* :test #'equal))) ;;remove constraint from *kb* ) ) ) ;--------------------------------------------------------------------------- ;;;the following code taken from: ;;;http://norvig.com/ltd/test/cnf.lisp ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: DTP; Base: 10 -*- ;;; This file was stolen from Matt Ginsberg's MVL 3/8/93 ;;;---------------------------------------------------------------------------- ;; stuff to manipulate propositions ;; functions defined: ;; ;; cnf (p) returns conjunctive normal form ;; dnf (p) disjunctive normal form ;; standardize-operators removes => <= <=> if iff ;; conjunctive normal form. Remove the nonstandard operators from p and ;; then look at (car p): ;; 1. If it's NOT, then (cnf p) is the result of negating each term ;; inside (dnf (not (p))). ;; 2. If it's OR, then we have to combine the results of cnf'ing each ;; of the disjuncts. cnf-merge-lists does this, one disjunct at a ;; time. ;; 3. If it's AND, we just call the cnf'er and nconc the results ;; together. ;; 4. If it's none of these, it must be a term and we return ((p)). ;;short wrapper function to add 'AND and 'OR to list, written by Megan, 7/15/2004 (defun convert-to-cnf (p) (setq cnf-form (cnf p)) (setq cnf-form (cons 'AND (mapcar #'(lambda(x) (if (NOT (equal (list-length x) 1)) (cons 'OR x) (car x))) cnf-form))) ) (defun cnf (p) (case (car (setq p (standardize-operators p))) (not (mapcar #'(lambda (l) (mapcar #'logical-negate l)) (dnf (second p)))) (or (let (ans) (dolist (item (cdr p) (nreverse ans)) (setq ans (cnf-merge-lists (cnf item) ans))))) (and (mapcan #'cnf (cdr p))) (otherwise (list (list p)))) ) ;; given a partial cnf expression d, and a new cnf exp c to be merged, ;; construct a list of all entries that have an entry from d followed by ;; one from c. As we go through, the list is maintained backwards, so ;; that we have terms with entries late in d early in the returned ;; answer. Three cases: ;; 1. If c is NIL, there is nothing to do. Return d. ;; 2. If d is NIL, there is still nothing to do, but we reverse c to ;; get d into "backwards" form. ;; 3. Otherwise, work through c and for each entry in it, work through ;; d, appending each entry of d onto that entry of c and pushing the ;; result onto the answer being accumulated. Note that this maintains ;; the "backwardness" of the answer. We make sure that each term in ;; the final answer is a fresh copy. (defun cnf-merge-lists (c d) (cond ((null c) d) ((null d) (nreverse c)) (t (let (ans) (dolist (item c ans) (push (append (car d) item) ans) (dolist (x (cdr d)) (push (append x (copy-list item)) ans))))))) ;; remove nonstandard connectives from p. Handles =>, <=, <=>, if and ;; iff. ;; 1. (=> p1 ... pn q) means (if (and p1 ... pn) q), or ;; (or (not (and p1 ... pn)) q). ;; 2. (<= q p1 ... pn) means (if (and p1 ... pn) q) as well. ;; 3. (if p q) means (or (not p) q) ;; 4. (iff p q) means (or (and p q) (and (not p) (not q))); <=> is ;; similar. (defun standardize-operators (p) (case (car p) (|=>| `(or (not (and . ,(butlast (cdr p)))) ,(car (last p)))) (|<=| `(or ,(second p) (not (and . ,(cddr p))))) (if `(or ,(third p) (not ,(second p)))) ((|<=>| iff) `(or (and ,(second p) ,(third p)) (and ,(logical-negate (second p)) ,(logical-negate (third p))))) (otherwise p))) ;; dnf is a lot like cnf. (defun dnf (p) (case (car (setq p (standardize-operators p))) (not (mapcar #'(lambda (l) (mapcar #'logical-negate l)) (cnf (second p)))) (and (let (ans) (dolist (item (cdr p) (nreverse ans)) (setq ans (cnf-merge-lists (dnf item) ans))))) (or (mapcan #'dnf (cdr p))) (otherwise (list (list p))))) (defun logical-negate (p) (if (eq 'not (car p)) (cadr p) (list 'not p))) ;;;end of code from http://norvig.com/ltd/test/cnf.lisp ;======================================================= ;======================================================= ;The following code written by Afsaneh Shirazi, edited by Megan Nance, September 2004 (defun propositionalize-p (domain objects) (loop for clause in domain append (if (and (listp clause) (equal ':predicates (car clause))) (propositionalize-predicates (cdr clause) objects) nil) ) ) ;--------------------------------------------------------------------------- (defun meval-precond (precond state) (setq predprop (car precond)) (if (equal predprop 'and ) (equal nil (find-if #'(Lambda (X) (Not (Meval-Precond X State))) (cdr Precond))) (if (equal Predprop 'or) (not (equal nil (Find-If #'(lambda(x) (meval-precond x state)) (Cdr Precond)))) (if (equal Predprop 'not) (not (Meval-Precond (Cadr Precond) State)) (not (equal nil (find-if #'(lambda (x) (equal x precond)) state))))))) ;--------------------------------------------------------------------------- (defun meval-effect (effect) (setq effprop (car effect)) (if (equal effprop 'and ) (loop for item in (mapcar #'(Lambda (x) (meval-effect x)) (cdr effect)) append item) (if (equal effprop 'or) (meval-effect (nth (random (length (cdr effect))) (cdr effect))) (list effect)))) ;--------------------------------------------------------------------------- (defun collect-positive (efflist) (remove-if #'(lambda (x) (equal 'not (car x))) efflist) ) ;--------------------------------------------------------------------------- (defun collect-negative (efflist) (setq lst (remove-if-not #'(lambda (x) (equal 'not (car x))) efflist)) (mapcar #'(lambda (x) (cadr x)) lst) ) ;--------------------------------------------------------------------------- (defun list-diff (list1 list2) (remove-if #'(lambda (x) (find-if #'(lambda (y) (equal x y)) list2)) list1) ) ;--------------------------------------------------------------------------- ;function to generate observations of specified length, ;taken from worldState, which are things that the generator ;knows to be true from the actions it has generated thus far ; (the generator will keep track of the preconditions and effects of ; the actions in the sequence thus far). ;This function will not return any disjunctions, since right now ; we only want things that we *know* are true (this can be changed). ;Written by Megan Nance, 1/12/05 (defun get-obs (num) (if (OR (equal num 0) (equal num nil)) (setq observation nil) (let* ((rs1 (make-random-state t)) (tempState *worldState*) (stateLength (list-length tempState))) (setq observation nil) (if (equal (car tempState) 'AND) (setq tempState (cdr tempState))) (loop while (AND (> num 0) tempState) do (setq item (nth (random stateLength rs1) tempState)) (if (AND (NOT (equal (car item) 'OR)) (NOT (equal item NIL))) (setq num (- num 1) observation (append observation (list item)))) (setq tempState (remove item tempState :test #'equal) stateLength (- stateLength 1))) ) ) (if observation (setq observation (append '(AND) observation))) observation ) ;------------------------------------------------------------------------------------ ;function RANDOM-GEN ;input parameters: ; 1 - name of .pddl file where action definitions can be found. ; 2 - length of action sequence to be generated (number of action/observation pairs) ; 3 - flag to indicate if domain is already propositionalized or not (T or nil) ; 4 - name of .objs file where object names can be found (for propositionalizing) ; 5 - name of .pddl file that contains state constraints ; 6 - integer to indicate how long observations should be (0 or nil gives "NIL" as observation) (defun random-gen (domainName length propositional objectsName constraintsName ;;RANDOM!! ; outFileName num) (let* ((rs1 (make-random-state t))) (setq domainFile (format nil "~A.pddl" domainName)) (setq domain (getContent domainFile)) (setq sequence nil) (setq stateFile (format nil "~A.state" domainName)) ;global variable to keep track of the current beliefState (or knowledge base) (defvar *kb* nil) (setq *kb* (getContent stateFile)) ;global variable to keep track of exactly what the generator knows to be true (defvar *worldState* nil) (if constraintsName ;;we have domain constraints (setq constraintsFile (format nil "~A.pddl" constraintsName) constraints (getContent constraintsFile)) ;;easier to make global?? too large to do this way?? (setq constraints nil)) (print "ADDED INITIAL CONSTRAINTS") (loop for i from 1 to length do (print i) ;;if we have domain constraints, update them (if (AND constraints (NOT (equal i 1))) ;;constraints already added for first time... (update-constraints constraints)) ;pick random action... (setq n (list-length domain)) ;;get number of elements in domain (setq counter nil) (setq result nil) (loop while (AND (NOT result) (not (equal (list-length counter) n))) do (setq nextAction (random n rs1)) (if (listp (nth nextAction domain)) (if (AND (equal (car (nth nextAction domain)) ':action) (NOT (subsetp (list (list nextAction)) counter :test #'equal))) ;pick a random action out of the domain file ;that we haven't tried yet (setq result (search-action (nth nextAction domain))))) ;pass to function that will try to find ;if preconds of this action are satisfied (if (NOT (subsetp (list (list nextAction)) counter :test #'equal)) (setq counter (append counter (list (list nextAction))))) ;add number we tried to list, so we don't try it again ) (if result (let ((preconds (nth 5 result)) ;get preconds of instantiated action (effectlist (nth 7 result))) ;get effects of instantiated action (setq sequence (append sequence (list (append (list (nth 1 result)) (nth 3 result))))) (if (equal (car preconds) 'AND) (setq preconds (cdr preconds)) ;if need to, remove 'AND from front of preconds list (if (NOT (listp (car preconds))) (setq preconds (list preconds)))) ;first element of preconds wasn't a list, but also wasn't 'AND (if (equal (car effectList) 'AND) (setq effectlist (cdr effectlist)) ;if need to, remove 'AND from front of effects list (if (NOT (listp (car effectList))) (setq effectList (list effects)))) ;first element of effectList wasn't a list, but also wasn't 'AND - one element, needs to be in a list (setq positives (collect-positive effectlist)) ;get positive literals from effects (setq negatives (collect-negative effectlist)) ;get negative literals from effects (setq *kb* (append '(AND) (append positives (list-diff (list-diff (cdr *kb*) negatives) positives)))) ;;update *kb* (if *worldState* ;;update *worldState* (if (equal (car *worldState*) 'AND) (setq *worldState* (append '(AND) (append positives (list-diff (list-diff (append (cdr *worldState*) preconds) negatives) positives)))) (setq *worldState* (append '(AND) (append positives (list-diff (list-diff (append *worldState* precond) negatives) positives))))) (setq *worldState* (append '(AND) (append positives (list-diff (list-diff preconds negatives) positives))))) (setq observation (get-obs num)) (setq sequence (append sequence (list observation))) ) ))) ;(write-to-file *kb* (concatenate 'string dirname "testing_gen_random/output_seq2.pddl") "") ;(write-to-file sequence (concatenate 'string dirname "testing_gen_random/chess50_seq2.seq") "") sequence ) ;;end of code by Afsaneh Shirazi (print (time (random-gen (concatenate 'string dirname "chess-domain-wb") 50 nil (concatenate 'string dirname "chess-all") ; nil (concatenate 'string dirname "constraints") 0)))