;; LISP ROUTINES FOR CREATING A GRIDWORLD (ROADS AND OBJECTS). ;; ALLOWS FOR QUANTITATIVE INFO, & FUNCTIONAL EFFECTS, INCL. TIME/VALUES ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; *** SHOULD ADD A FUNCTION FOR ADDING GENERAL KNOWLEDGE INDEPENDENTLY ;; OF def-roadmap, def-object and place-object, SINCE CONDITIONAL ;; KNOWLEDGE OF MORE GENERAL FORMS (E.G., WHERE THE ANTECEDENT IS ;; NOT SIMPLY A TYPE CONSTRAINT) IS PERMITTED IN WORLD KNOWLEDGE. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; WE STORE ALL SPECIFIC FACTS IN *WORLD-FACTS*, NOT LOCALLY. ; (General facts are still in *general-knowledge*, though we might ; eventually distinguish general facts from general knowledge) ; ; We have also changed storrage of local facts (as 'facts property ; of locations) to just storing *world-facts*. ; If appropriate, the user needs to supply lists *left-comoving-preds* ; and *right-comoving-preds*, to allow inference of all local objects. (defparameter *roadmap-knowledge* nil); will become a list of map ; facts when def-roadmap is run (defparameter *general-knowledge* nil); will become a list of general ; facts about object types, and ; possibly other non-unit Horn ; clauses added by the user; (defparameter *extra-initial-knowledge* nil); Extra initial knowledge ; that may be supplied to ME when ; the initial place-obj is done for ; object ME. (It is "extra" in the ; sense that ME is presumed to know ; the roadmap knowledge, and also ; any locally apparent facts at ; the point where it is placed). ; The extra initial knowledge ; should be supplied as curr-facts ; in the place-obj command (or ; the user could explicitly add ; facts to *extra-initial-knowledge* ; before doing 'initialize-state-node') (defparameter *world-facts* nil); roadmap knowledge plus all other ; ground facts; these are collected ; together when objects are placed ; in the gridworld and when the ; initial state is computed in ; 'initialize-state-node' ; (see "gridworld-planning.lisp") (defparameter *protected-facts* nil); Initially, before any inferences ; are done, these are the same ; as *world-facts*; later on, ; the *protected-facts* are updated ; with the effects of actions that ; are actually carried out, but they ; are not augmented with inferences, ; so that in new states inferences ; can be computed from scratch ; (avoiding the need to explicitly ; identify and retract inferences ; that have become invalid). (defvar *occluded-preds* nil); predicates for local facts that are ; not immediately known to ME (unless ; the 1st (subject) argument is ME) (defparameter *left-comoving-preds* nil) (defparameter *right-comoving-preds* nil) (defun def-roadmap (points roads); revised Apr 20/08 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; Create a graph-like "roadmap", consisting of points (nodes) and ; connections (edges) beween pairs of points. The connections are ; labeled, where we think of these labels as road names; at most ; 2 edges impinging on a node may have any particular name. (Having ; 2 edges with the same name at a node means that we can follow ; a road through an "intersection" -- or, if these are the only ; 2 edges -- past a "point of interest", usually one where some ; object is located.) ; ; points: a list of distinct node names, such as Point1, Point2, ; Cross-roads1, Dead-end3, etc.; ; roads: a list of lists, each beginning with a road name, ; followed by a sequence of points that this road reaches; ; a road must not reach any point twice, because we want ; "taking road x from point y to point z" to correspond to ; a unique path; theoretically, 'points' may include points ; not reached by any road; a "minimalist" roadmap would be ; one that has just one point (where we place ME), and no ; roads. ; ; METHOD: ; 1. Check to make sure roads have at least one segment (i.e., ; 2 points), and roads are not self-intersecting; {a road ; is self-intersecting iff after removal of any duplicate ; points, the list of points defining the road is shorter}; ; Report any discrepancies between the points given as ; first argument and points occurring on roads; (however, ; such discrepancies are allowed); ; ; 2. Create a graph structure by attaching 'next' ; properties to points, where such a property consists ; of a list of (road-name adjacent-point) pairs; this can ; be done in an obvious way by sequentially processing ; the given roads; ; 3. Create the *roadmap-knowledge* list of facts about roads, ; points, and what points are on what roads. ; (let (pp name road-points point isolated-points unlisted-points rr ) (dolist (r roads); error checking (setq name (car r)) (setq pp (remove-duplicates (cdr r))) (when (< (length pp) 2) (format t "~%***Road ~a has no segments" name) (return-from def-roadmap 'ERROR-TERMINATION) ) (when (< (length pp) (length (cdr r))) (format t "~%***Road ~a self-intersects" name) (return-from def-roadmap 'ERROR-TERMINATION) ) (setq road-points (union pp road-points)) ) (setq isolated-points (set-difference points road-points)) (setq unlisted-points (set-difference road-points points)) (dolist (p road-points) (remprop p 'next)); cleanup for safety (dolist (p isolated-points) (remprop p 'next)); cleanup for safety (if isolated-points (format t "~%### ISOLATED POINTS: ~a" isolated-points) ) (if unlisted-points (format t "~%### UNLISTED POINTS ON ROADS: ~a" unlisted-points) ) (dolist (r roads); graph creation (setq name (pop r)) (dotimes (i (- (length r) 1)); number of road segments (setq point (pop r)) (push (list name (car r)) (get point 'next)) (push (list name point) (get (car r) 'next)) )) ; Create a roadmap knowledge list for the Motivated Explorer (ME): (setq *roadmap-knowledge* nil); for safety (dolist (r roads); predicate 'road' about each road-name (push (list 'road (car r)) *roadmap-knowledge*) ) (dolist (p (append road-points isolated-points)) ; predicate 'point' about each point (push (list 'point p) *roadmap-knowledge*) (setq rr (get p 'next)) (dolist (r rr); for each point p on a road r, say that p is on r (push (list 'is_on p (car r)) *roadmap-knowledge*) ; we could also add connection-knowledge between pairs of ; points, but we know that if p1 is on r and p2 is on r, ; then r connects p1 and p2 (though perhaps in multiple steps) )) (setq *world-facts* *roadmap-knowledge*) (setq *protected-facts* *roadmap-knowledge*) )); end of def-roadmap ;; EXAMPLE OF CREATING ROADMAP: ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; (def-roadmap '(a b c d e) '((r1 a b c d) (r2 b d))) ;; ;; ### ISOLATED POINTS: (E) ;; NIL ;; [2] CL-USER(29): (format t "~%~a" *roadmap-knowledge*) ;; ;; ((POINT E) (IS_ON A R1) (POINT A) (IS_ON B R1) (IS_ON B R1) ;; (IS_ON B R2) (POINT B) (IS_ON C R1) (IS_ON C R1) (POINT C) ;; (IS_ON D R1) (IS_ON D R2) (POINT D) (ROAD R2) (ROAD R1)) ;; NIL (defun def-object (obj-type properties) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; obj-type: an atomic identifier for a type, e.g., 'sasquatch'; ; properties: a list of abbreviated general, permanent properties ; such as ; '(is_animate is_furry (has_IQ 50)); ; This is expanded so as to produce a conditional whose ; antecedent applies the type predicate to a variable and ; whose consequent applies the given predicate in each ; property first to the variable and then to any additional ; arguments that are given; thus we will get ; ((sasquatch ?x) => (is_animate ?x)) ; ((sasquatch ?x) => (is_furry ?x)) ; ((sasquatch ?x) => (has_IQ ?x 50)) ; (Note: the originally planned temporal arguments have been ; omitted. These might still be added, but at this point it ; seems more convenient to omit them.) ; (let ((ante (list obj-type '?x)) conse) (dolist (p properties) (setq conse (if (atom p) (list p '?x) (cons (car p) (cons '?x (cdr p))) )) (push (list ante '=> conse) *general-knowledge*) ) )); end of def-object ;; EXAMPLE OF DEFINING AN OBJECT TYPE: ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; [2] CL-USER(32): (def-object 'sasquatch '(is_animate is_furry (has_IQ 50))) ;; ;; [2] CL-USER(33): *general-knowledge* ;;(((SASQUATCH ?X) => (HAS_IQ ?X 50)) ((SASQUATCH ?X) => (IS_FURRY ?X)) ;; ((SASQUATCH ?X) => (IS_ANIMATE ?X))) (defun place-object (name obj-type point time-pt associated-things ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ curr-facts propos-attitudes); revised Apr 20/08 ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; We name an entity (of a specified type) and place it at ; some point in the Gridworld (and make the fact that it is of ; that type, and `is_at' that point part of the list that is ; the value of the `facts' property of `point'), at a specified ; 'time-pt' and we supply three kinds of additional information ; for it (where these become available to ME as knowledge "packets" ; if ME is at that point): ; - things that it currently "has" -- a list of typed entities ; such as ((key key1) (sword sword1) (banana banana3)); ; these may be regarded as *possessions* in the case of animate ; beings, or as contained or attached objects, in the case of ; inanimate objects such as trees or boxes; for example, ; a type predication like (key Key3) supplied under this ; heading means that the named entity has Key3, and that ; thing is a key; (see below for the representation of these ; facts); the type facts, possession facts, and `is_at' facts ; are all placed on the list comprising the *world-facts*; ; - current-state facts about it; e.g., (hungry Grunt), or ; (likes Grunt Tweety); in this version we do not add time ; arguments, but directly place the given facts in *world-facts*. ; N.B.: IF THE OBJECT PLACED IS ME, THEN THE CURR-FACTS MAY ALSO ; INCLUDE FACTS THAT DO *NOT* HAVE ME IN SUBJECT POSITION; THESE ; ARE TREATED AS "EXTRA" INITIAL KNOWLEDGE OF ME (IN ADDITION TO ; ROADMAP KNOWLEDGE, SELF-KNOWLEDGE AND ANY ADDITIONAL LOCALLY ; APPARENT FACTS); ; - propositional attitudes such as (knows Grunt (has Robbie ; Banana)); another example: (wants Grunt (has Grunt Banana1)); ; it is even possible to have nested knowledge facts or goal ; facts such as (knows Grunt (knows Robbie (want Grunt (has ; Grunt Banana1)))), i.e., Grunt knows that Robbie knows that ; Grunt wants to have the banana; but such complex facts ; would more likely be produced by inference than by manual ; input. Again these facts are put in *world-facts*; ; ; Note: `time-pt' is a number such as 0, but this is used in ; the present version of the code just to set *now*, not in any ; predicates (time remains implicit in predicates), ; (let (facts) ; type predication about 'name': (push (list obj-type name) facts) (push (list 'is_at name point) facts) ; set global *here* and *now* parameters if name is 'ME: (if (eq name 'ME) (setq *here* point *now* time-pt)) (dolist (p associated-things); the things that 'name' "has" (push p facts) (push (list 'is_at (second p) point) facts) (push (list 'has name (second p)) facts) ) (dolist (f curr-facts) (push f facts) (if (and (eq name 'ME) (not (eq (second f) 'ME))) (push f *extra-initial-knowledge*) )) (dolist (f propos-attitudes) (push f facts)) (setq facts ; guard against duplication (remove-duplicates facts :test #'equal) ) (setq *world-facts* (unionf facts *world-facts*)) ; In updating *protected-facts*, we could just set them equal ; to *world-facts*; but we update them independently just in ; case we ever want to place a new object in the gridworld ; while already in the middle of a gridworld run: (setq *protected-facts* (unionf facts *protected-facts*)) facts ; output the new facts )); end of place-object ;; EXAMPLE OF PLACING AN OBJECT: ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; [3] CL-USER(52): (place-object 'Grunt 'sasquatch 'b 0 '((banana Banana1) ;; (key Key4)) '((hungry Grunt) (likes Grunt Tweety)) ;; '((knows Grunt (has ME Banana2)))) ;; ;; (format t "~%~a" (get 'Grunt 'facts)) ;; ;; ((KNOWS GRUNT (HAS ME BANANA2)) (LIKES GRUNT TWEETY) ;; (HUNGRY GRUNT) (HAS GRUNT KEY4) (HAS GRUNT BANANA1) ;; (IS_AT GRUNT B) (SASQUATCH GRUNT)) ;; NIL ;; [3] CL-USER(54): (format t "~%~a" (get 'Key4 'facts)) ;; ;; ((KEY KEY4)) ;; NIL ;; [3] CL-USER(55): (format t "~%~a" (get 'Banana2 'facts)) ;; ;; NIL ;; NIL ;; [3] CL-USER(56): (format t "~%~a" (get 'Banana1 'facts)) ;; ;; ((BANANA BANANA1)) ;; NIL