;;; -*- Mode: LISP; Syntax: Common-lisp; Package: sipe-cl; Base: 10; Default-character-style: (:FIX :ROMAN :large); -*-

;;;>                       SIPE TM
;;;>    Unpublished-rights reserved under the copyright laws of the United States.
;;;>******************************************************************************************
;;;>    This data and information is proprietary to, and a valuable trade
;;;>    secret of, SRI International.  It is given in confidence by SRI
;;;>    International.  Its use, duplication, or disclosure is subject to the
;;;>    restrictions set forth in the License Agreement under which it has
;;;>    been distributed.
;;;>******************************************************************************************
;;;>
;;;>      Unpublished Copyright (c) 1986-1995 SRI International, David E. Wilkins
;;;>	            SIPE is a Trademark of SRI International 
;;;>

(in-package :sipe)

;this is the blocks world with some enhancements.  For example,
;a block may have more than one block on top of it.

(setq numerical-enabled? nil)
(setq REMOVE-REDUNDANT-ACTIONS-FREQUENCY 1)
(DEFINE.DOMAIN)


CLASS: OBJECTS
SUBCLASSES: SUPPORTS, BLOCKS
END CLASS

CLASS: SUPPORTS
PARENT-CLASS: OBJECTS
INSTANCES: TABLE
END CLASS

CLASS: BLOCKS
PARENT-CLASS: OBJECTS
SUBCLASSES: REDBLOCKS,BLUEBLOCKS
INSTANCES: A,B,C,D,E
END CLASS

OBJECT:  A
PARENT-CLASS: BLOCKS
PROPERTIES:
 COLOR  =  GREEN,
 SIZE = 5
END OBJECT

CLASS: REDBLOCKS
PARENT-CLASS: BLOCKS
Instances: R1,R2
END CLASS

CLASS: BLUEBLOCKS
PARENT-CLASS: BLOCKS
INSTANCES: B1,B2,B3
END CLASS

STOP

(DEFINE.DOMAIN)
PREDICATES:


;following give Sussman anomaly once removed with 4 blocks
;comment out all other ONpredicates
;(ON C A)
;(ON A D)
;(ON D TABLE)
;(ON B TABLE)

;in this problem you must undo the (ON A B) already achieved
;(ON A B)
;(ON C TABLE)
;(ON B TABLE)

;this is the Sussman anomaly, must not
;do (ON B C) immediately for optimal solution
(ON C A)
(ON A TABLE)
(ON B TABLE)

;another fun problem for ordering conjuncts right is reverse the stack:
;(ON C B)
;(ON B A)
;(ON A TABLE)

;replace D,E on table with on B1 here to test reasoning about 
; 3 blocks on top of another (r1 already on b1)
(ON D TABLE)
(ON E TABLE)
;(ON E B1) 
;(ON D B1) 

;;some colored blocks for other problems
(ON R1 B1)
(ON B1 TABLE)
(ON B2 TABLE)
(ON R2 TABLE)

;true in all problems
(CLEAR TABLE)

END PREDICATES
STOP
(DEFINE.DOMAIN)


OPERATOR: PUTON1
ARGUMENTS: BLOCK1, OBJECT1 IS NOT BLOCK1;
PURPOSE: (ON BLOCK1 OBJECT1)
PLOT:
PARALLEL
 BRANCH 1:
	GOALS: (CLEAR OBJECT1)
 BRANCH 2:
	GOALS: (CLEAR BLOCK1)
END PARALLEL

PROCESS
 ACTION: PUTON;
 ARGUMENTS: BLOCK1,OBJECT1
 RESOURCES: BLOCK1
 EFFECTS: (ON BLOCK1 OBJECT1)
END PLOT
END OPERATOR
;all problems also solved without a RESOURCE declaration




OPERATOR: CLEARTOP-RECURSE
ARGUMENTS: OBJECT1,OBJECT2 IS NOT OBJECT1, BLOCK1
PURPOSE: (CLEAR OBJECT1)
PRECONDITION: (ON BLOCK1 OBJECT1)
PLOT:

 PROCESS
  ACTION: PUTON1
  ARGUMENTS: BLOCK1, OBJECT2
  EFFECTS: (ON BLOCK1 OBJECT2)

 GOAL: (CLEAR OBJECT1)
END PLOT 
END OPERATOR


;following not needed,  here to show use of PARALLEL-LOOP
OPERATOR: CLEARTOP
ARGUMENTS: BLOCK2,OBJECT2 IS NOT BLOCK2, BLOCK1
PURPOSE: (CLEAR BLOCK2)
PRECONDITION: (ON BLOCK1 BLOCK2)
PLOT:

 PROCESS
  ACTION: PARALLEL-LOOP
  GOALS: (ON BLOCK1 OBJECT2)
  PATTERN: (ON BLOCK1 BLOCK2)
  ARGUMENTS: object2

 PROCESS
  ACTION: cleared
  ARGUMENTS: BLOCK2
  EFFECTS: (CLEAR BLOCK2)
;;cannot deduce (CLEAR BLOCK2) from any individual action in loop

END PLOT 
END OPERATOR
;here the GOAL will always be true after the parallel loop, but
; is posted again so the execution monitor will protect it until purpose achieved
;if resource-critic moves links to purpose, then must add
;  protect-until: (CLEAR BLOCK2);  GOAL: (CLEAR BLOCK2); to PARALLEL-LOOP plot
;so that get right purposes






;;;; ====================== Deductive operators =================================



init-operator: DCLEAR-init
ARGUMENTS: BLOCK1, OBJECT1, OBJECT3 CLASS EXISTENTIAL
TRIGGER: (ON BLOCK1 OBJECT1)
CONDITION: -(ON OBJECT3 BLOCK1)
EFFECTS: (CLEAR BLOCK1)
END init-operator
;deduce clears for initial world: for every block that is on something, check that it is clear
;  a block not on anything will not have a CLEAR deduced, must give it explicitly
;; must still have (clear table) initially
;;if you want to later change ititial world, 
;;  must update all ONs and NOT ONs and NOT CLEARS correctly (only new positive CLEARs deduced).

STATE-RULE: DCLEAR
ARGUMENTS: OBJECT1,OBJECT2 CLASS BLOCKS, OBJECT3 CLASS EXISTENTIAL
TRIGGER: -(ON OBJECT1 OBJECT2)
CONDITION: -(ON OBJECT3 OBJECT2)
EFFECTS: (CLEAR OBJECT2)
END STATE-RULE
;this works in all problems, including prob4 with 2 and 3  blocks on top of B1 (for right reasons)
;Does not do optimal job with redblocks in parallel without the CLASS BLOCKS on OBJECT2
;which forces things to move off of blocks.

CAUSAL-RULE: NOTON
ARGUMENTS: OBJECT1,OBJECT2,OBJECT3
TRIGGER: (ON OBJECT1 OBJECT2)
PRECONDITION: (ON OBJECT1 OBJECT3)
EFFECTS: -(ON OBJECT1 OBJECT3)
END CAUSAL-RULE
;may want to make object3 universal if blocks could have been on more than one block originally

STATE-RULE: ONCLEAR
ARGUMENTS: OBJECT1,BLOCK1
TRIGGER: (ON OBJECT1 BLOCK1)
EFFECTS: -(CLEAR BLOCK1)
END STATE-RULE


STOP

(init.deduce)


(DEFINE.PROBLEM)

;all blocks problems now get optimal solutions when parallel links are enabled
PROBLEM: three-conj
PARALLEL
 BRANCH 1:
	GOAL: (ON A B)
 BRANCH 2:
	GOAL: (ON B C)
 BRANCH 3:
	GOAL: (ON C TABLE)
END PARALLEL
END PROBLEM


;get optimal plan no matter which order the conjuncts are in.
;get optimal plan for all starting positions, reasoning about
;proposed linearizations does right thing in reverse stacking case


PROBLEM: two-conj
PARALLEL
 BRANCH 1:
	GOAL: (ON A B)
 BRANCH 2:
	GOAL: (ON B C)
END PARALLEL
END PROBLEM

PROBLEM: two-conj-reverse
PARALLEL
 BRANCH 1:
	GOAL: (ON B C)
 BRANCH 2:
	GOAL: (ON A B)
END PARALLEL
END PROBLEM

PROBLEM: simple-color
GOAL: (ON BLUEBLOCK1 REDBLOCK1)
END PROBLEM

;these show off use of variable and constraints in specifying problem
;following one requires intelligent choice of R1 on R2 to phantomize
;in parallel branch and get optimal solution

PROBLEM: red-blue
PARALLEL
BRANCH 1:
	GOALS: (ON BLUEBLOCK3 BLUEBLOCK4)
BRANCH 2:
	GOALS: (ON REDBLOCK3 REDBLOCK4)
END PARALLEL
END PROBLEM

;this is interesting because everything is variables.  Triggered many bugs in 1981.
;takes advantage of using replanning actions in critics, since plans get shortened
;when previous expansions to clear something can be removed after instantiations
;followed by linearizations make suboptimal plans
 ;with linearization of resource conflicts, splices out suboptimal plan to get optimal one
;With remove-redundant-actions get optimal plan for all blocks probs
;  with both recursive and iterative cleartop.
;with the iterative cleartop (with or without remove-redundant-actions),
;  gets best solution since we are phantomizing to the ON and not to a deduced effect


PROBLEM: immediate
GOAL: (ON REDBLOCK1 BLUEBLOCK1)
END PROBLEM
;above should test immediate phantomization

PROBLEM: ex-test
PARALLEL
BRANCH 1:
	GOALS: (ON A C);
BRANCH 2:
	GOALS: (ON BLUEBLOCK1 REDBLOCK1);
END PARALLEL
END PROBLEM

;these two are for testing execution monitor on parallel branches that
;initially do not interact but may during unexpected execution.
;The former one can have the colored block goal solved by reinstantiation
;if the redblock is unexpectedly covered, but in the latter this should
;fail since R2 is the only redblock that will work.


PROBLEM: ex-test1
PARALLEL
BRANCH 1:
	GOALS: (ON A C);
BRANCH 2:
    GOAL
    ARGUMENTS: BLUEBLOCK2, REDBLOCK2 IS NOT R1;
    GOALS: (ON BLUEBLOCK2 REDBLOCK2);
END PARALLEL
END PROBLEM


PROBLEM: sequence
GOALS: (ON A C);
GOALS: (on b1 b2);
END PROBLEM


STOP

;;here is a form to evaluate to test what-if capability, for just-solved plan on screen
;(what-if lastplanhead '((on d a) (on e b)) *current-context*)