1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%
    3% FILE: aPMS/pms.pl
    4%
    5%  AUTHORS : Massimiliano de Leoni, Andrea Marrella and Stefano Valentini
    6%  EMAIL  : deleoni@dis.uniroma1.it,marrella@dis.uniroma1.it,stefano_valentini82@libero.it
    7%  TYPE   : system independent code
    8%  TESTED : SWI Prolog 5.id_.1id_ http://www.swi-prolog.org
    9%
   10%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   11% 
   12%  A basic action theory (BAT) is described with:
   13%
   14% -- fun_fluent(fluent)     : for each functional fluent (non-ground)
   15% -- rel_fluent(fluent)     : for each relational fluent (non-ground)
   16%
   17%           e.g., rel_fluent(painted(C)).
   18%           e.g., fun_fluent(color(C)).
   19%
   20% -- prim_action(action)    : for each primitive action (ground)
   21% -- exog_action(action)    : for each exogenous action (ground)
   22%
   23%           e.g., prim_action(clean(C)) :- domain(C,country).
   24%           e.g., exog_action(painte(C,B)):- domain(C,country), domain(B,color).
   25%
   26% -- senses(action,fluent)  : for each sensing action
   27%
   28%           e.g, poss(check_painted(C),  painted(C)).
   29%
   30% -- poss(action,cond)      : when cond, action is executable
   31%
   32%           e.g, poss(clean(C),   and(painted(C),holding(cleanear))).
   33%
   34% -- initially(fluent,value): fluent has value in Sid_ (ground)
   35%
   36%          e.g., initially(painted(C), false):- domain(C,country), C\=3.
   37%                initially(painted(3), true).
   38%                initially(color(3), blue).
   39%
   40% -- causes_val(action,fluent,value,cond)
   41%          when cond holds, doing act causes functional fluent to have value
   42%
   43%            e.g., causes_val(paint(C2,V), color(C), V, C = C2).
   44%               or causes_val(paint(C,V), color(C), V, true).
   45%
   46% -- causes_true(action,fluent,cond)
   47%          when cond holds, doing act causes relational fluent to hold
   48% -- causes_false(action,fluent,cond)
   49%          when cond holds, doing act causes relational fluent to not hold
   50%
   51%            e.g., causes_true(paint(C2,_), painted(C), C = C2).
   52%               or causes_true(paint(C,_), painted(C), true).
   53%            e.g., causes_false(clean(C2),  painted(C), C = C2).
   54%               or causes_false(clean(C),  painted(C), true).
   55%
   56% A high-level program-controller is described with:
   57%
   58% -- proc(name,P): for each procedure P 
   59% -- simulator(N,P): P is the N exogenous action simulator
   60%
   61%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   62:- dynamic controller/1.   63
   64
   65/* SOME DOMAIN-INDEPENDENT PREDICATES TO DENOTE THE VARIOUS OBJECTS OF INTEREST IN THE FRAMEWORK */
   66
   67/* Available services */
   68services([1,2,3,4,5]).
   69service(S) :- domain(S,services).
   70
   71/* Tasks defined in the Process specification */
   72tasks([takephoto,evaluatephoto,compilequest,sendbygprs,go]).
   73task(T) :- domain(T,tasks).
   74
   75/* Capabilities relevant for the process of interest */
   76capabilities([camera,evaluation,compile,gprs]).
   77capability(C) :- domain(C,capabilities).
   78
   79/* The list of identifiers that may be used to distinguish different istances of the same task */ 
   80task_identifiers([id_1,id_2,id_3,id_4,id_5,id_6,id_7,id_8,id_9,id_10,id_11,id_12,id_13,id_14,id_15,id_16,id_17,id_18,id_19,id_20,id_21,
   81id_22,id_23,id_24,id_25,id_26,id_27,id_28,id_29,id_30,id_31,id_32,id_33,id_34,id_35,id_36,id_37,id_38,id_39,id_40,id_41,
   82id_42,id_42,id_44,id_45,id_46,id_47,id_48,id_49,id_50]).
   83
   84id(D) :- domain(D,task_identifiers).
   85
   86/* Definition of predicate workitem(T,D,I). It identifies a task TASK with id ID and input INPUT */
   87listelem(workitem(go,ID,INPUT)) :- id(ID),location(INPUT).
   88listelem(workitem(compilequest,ID,INPUT)) :- id(ID),location(INPUT).
   89listelem(workitem(evaluatephoto,ID,INPUT)) :- id(ID),location(INPUT).
   90listelem(workitem(takephoto,ID,INPUT)) :- id(ID),number(Nadd,2),location(LOC),INPUT = [LOC,Nadd].
   91listelem(workitem(sendbygprs,ID,input)) :- id(ID).
   92
   93worklist([]).
   94worklist([ELEM | TAIL]) :- worklist(TAIL),listelem(ELEM).
   95
   96
   97/* The capabilities required for each task */ 
   98required(takephoto,camera).
   99required(evaluatephoto,evaluation).
  100required(compilequest,compile).
  101required(sendbygprs,gprs).
  102
  103/* The capabilities provided by each service */
  104provide(1,camera).
  105provide(2,evaluation).
  106provide(2,camera).
  107provide(3,compile).
  108provide(4,evaluation).
  109provide(4,camera).
  110provide(5,compile).
  111
  112
  113/* There is nothing to do caching on (required because cache 1 is static) */
  114cache(_):-fail.
  115
  116/* Definition of predicate loc(i,j) identifying the current location of a service */
  117gridsize(2).
  118gridindex(V) :- 
  119	gridsize(S),
  120	get_integer(0,V,S).
  121location(loc(I,J)) :- gridindex(I), gridindex(J).
  122
  123/* The definition of integer numbers */
  124number(N,M) :- get_integer(0,N,M).
  125
  126/* square(X,Y): Y is the square of X */
  127square(X,Y) :- Y is X * X.
  128
  129/* member(ELEM,LIST): returns true if ELEM is contained in LIST */
  130member(ELEM,[HEAD|_]) :- ELEM=HEAD.
  131member(ELEM,[_|TAIL]) :- member(ELEM,TAIL).
  132listEqual(L1,L2) :- subset(L1,L2),subset(L2,L1).
  133
  134/*  DOMAIN-INDEPENDENT FLUENT */
  135
  136/* Basically, there has to be some definition for predicates causes_true and causes_false, at least one 
  137for each.  We have added  the following dummy code:  */ 
  138causes_true(_,_,_) :- false.
  139causes_false(_,_,_) :- false.
  140
  141/* Indicates that a list LWRK of workitems has been assigned to service SRVC */ 
  142rel_fluent(assigned(_,SRVC)) :- service(SRVC).
  143
  144/* assigned(LWRK,SRVC) holds after action assign(LWrk,Srvc) */         
  145causes_val(assign(LWRK,SRVC),assigned(LWRK,SRVC),true,true).        
  146
  147/* assigned(LWRK,SRVC) holds no longer after action release(LWRK,SRVC) */ 
  148causes_val(release(LWRK,SRVC),assigned(LWRK,SRVC),false,true).
  149
  150/* Indicates that task TASK with id ID has been begun by service SRVC */ 
  151rel_fluent(enabled(TASK,ID,SRVC)) :- task(TASK), service(SRVC), id(ID).
  152
  153/* enabled(T,D,N) becomes true if the service N calls the exogenous action readyToStart(T,D,N), indicating the 
  154starting of the task T with id D */ 
  155causes_val(readyToStart(TASK,ID,SRVC),enabled(TASK,ID,SRVC),true,true).
  156
  157/* enabled(T,D,N) becomes false if the service N calls the exogenous action finishedTask(T,D,N,V), indicating the 
  158ending of the task T with id D and output value V */ 
  159causes_val(finishedTask(TASK,ID,SRVC,_),enabled(TASK,ID,SRVC),false,true).
  160
  161/* free(N) indicates that service N is not currently executing any other task */ 
  162rel_fluent(free(SRVC)) :- service(SRVC).
  163
  164/* free(N) becomes true if the PMS engine calls the action release(LWRK,SRVC). LWRK is a worklist, SRVC is a service */ 
  165causes_val(release(_,SRVC),free(SRVC),true,true).
  166
  167/* free(N) becomes false if the PMS engine calls the action assign(LWRK,SRVC). LWRK is a worklist, SRVC is a service */           
  168causes_val(assign(_,SRVC),free(SRVC),false,true).
  169
  170
  171/*  ACTIONS and PRECONDITIONS*/
  172
  173/* Every task execution is the sequence of four actions:  
  174    (i)     The assignment of the task to a service.  
  175    (ii)    The notification to the service N to start executing the task T. It happens when the service N 
  176            calls the exogenous action readyToStart(T,D,N)).  
  177    (iii)   The PMS stops the service acknowledging the successful termination of its task. It happens 
  178            when the service N calls the exogenous action finishedTask(T,D,N,V).   
  179    (iv)    Finally, the PMS releases the service, which becomes free again.  
  180     
  181    We formalize these four actions as follows (these are the only actions used in our formalization):    */
  182
  183prim_action(assign(LWRK,SRVC)) :- worklist(LWRK),service(SRVC).
  184poss(assign(LWRK,SRVC),true) :- worklist(LWRK),service(SRVC).
  185
  186prim_action(ackTaskCompletion(TASK,ID,SRVC)) :- task(TASK), service(SRVC), id(ID).
  187poss(ackTaskCompletion(TASK,ID,SRVC), neg(enabled(TASK,ID,SRVC))).
  188
  189prim_action(start(TASK,ID,SRVC,INPUT)) :- listelem(workitem(TASK,ID,INPUT)), service(SRVC).
  190
  191poss(start(TASK,ID,SRVC,_INPUT),true) :- task(TASK),id(ID),service(SRVC).
  192
  193prim_action(release(LWRK,SRVC)) :- worklist(LWRK),service(SRVC).
  194poss(release(_LWRK,_SRVC), true).
  195
  196/*  DOMAIN-DEPENDENT FLUENT */
  197
  198/* at(SRVC) indicates that service SRVC is in position P */
  199fun_fluent(at(SRVC)) :- service(SRVC).
  200
  201/* at(N) assumes the value loc(I,J) if service N calls the exogenous action finishedTask(T,D,N,V) and V=loc(I,J) */  
  202causes_val(finishedTask(go,_ID,SRVC,V),at(SRVC),loc(I,J),V=loc(I,J)).
  203
  204
  205
  206fun_fluent(photoBuild(LOC)) :- location(LOC).
  207causes_val(finishedTask(TASK,_ID,SRVC,V),photoBuild(LOC),N,
  208    							and(TASK=takephoto,
  209							   			and(number(Nadd,2),
  210							      		and(V=[LOC,Nadd],
  211								  		and(at(SRVC)=LOC,
  212     									and(Nold=photoBuild(LOC),
  213								N is Nold+Nadd)))))
  214).
  215
  216
  217rel_fluent(evaluationOK(LOC)) :- location(LOC).
  218causes_val(finishedTask(TASK,_ID,_SRVC,V),evaluationOK(loc(I,J)), true,
  219    							and(TASK=evaluatephoto,
  220     								and(V=(loc(I,J),ok),
  221      									 and(N=photoBuild(loc(I,J)),
  222      											  	N>3)))).
  223
  224
  225rel_fluent(infoSent).
  226causes_val(finishedTask(TASK,_ID,_SRVC,V),infoSent, true, and(TASK=sendByGPRS, V=ok)).
  227
  228proc(hasConnection(SRVC),and(service(SRVC),hasConnectionHelper(SRVC,[SRVC]))).
  229
  230proc(hasConnectionHelper(SRVC,M), or(neigh(SRVC,1),
  231					some(n,
  232					     and(service(n),
  233					     and(neg(member(n,M)),
  234					     and(neigh(n,SRVC),
  235					     hasConnectionHelper(n,[n|M]))))))).
  236
  237proc(neigh(SRVC1,SRVC2),  
  238	some(x1,
  239	some(x2,
  240	some(y1,
  241	some(y2,
  242	some(k1,
  243	some(k2,
  244	and(at(SRVC1)=loc(x1,y1),
  245	and(at(SRVC2)=loc(x2,y2),
  246	and(square(x1-x2,k1),
  247	and(square(y1-y2,k2),
  248	sqrt(k1+k2)<7))))))))))).
  249
  250
  251/* INITIAL STATE:  */
  252
  253/*initially(free(SRVC),true) :- service(SRVC).*/
  254
  255/*TEMPORARY CODE*/
  256initially(free(1),true).
  257initially(free(2),false).
  258initially(free(3),false).
  259initially(free(4),false).
  260initially(free(5),false).
  261/*END TEMPORARY CODE*/
  262
  263initially(at(SRVC),loc(0,0)) :- service(SRVC).
  264initially(at_prev(SRVC),loc(0,0)) :- service(SRVC).
  265
  266initially(photoBuild(LOC),0) :- location(LOC).
  267initially(photoBuild_prev(LOC),0) :- location(LOC).
  268
  269initially(evaluationOK(LOC),false) :- location(LOC).
  270initially(evaluationOK_prev(LOC),false) :- location(LOC).
  271
  272initially(infoSent,false).
  273initially(infoSent_prev,false).
  274
  275initially(enabled(TASK,ID,SRVC),false) :- task(TASK), service(SRVC), id(ID).
  276initially(assigned(_LWRK,SRVC),false) :- service(SRVC).
  277
  278initially(finished,false).
  279
  280/* EXOGENOUS ACTIONS EXECUTED BY SERVICES */
  281
  282exog_action(readyToStart(TASK,ID,SRVC)) :- task(TASK), service(SRVC), id(ID).
  283exog_action(finishedTask(TASK,ID,SRVC,_V)) :- task(TASK), service(SRVC), id(ID).
  284
  285/* exogenous action which target is to reduce of a fixed number V the overall pics taken in location LOC */
  286exog_action(photoLost(V,LOC)) :- location(LOC),number(V,2).
  287causes_val(photoLost(_,_),exogenous,true,true).
  288
  289exog_action(disconnect(SRVC,loc(I,J))) :- service(SRVC), gridindex(I), gridindex(J).
  290causes_val(disconnect(_,_),exogenous,true,true).
  291
  292
  293/* PREDICATES AND ACTIONS FOR MONITORING ADAPTATION */
  294
  295/* at(N) assumes the value loc(I,J) if the exogenous action disconnect(N,loc(I,J)) is called */  
  296causes_val(disconnect(SRVC,loc(I,J)),at(SRVC),loc(I,J),true).
  297
  298/* photoBuild(LOC,N) reduces of a fixed number N the overall pics taken in the location LOC */  
  299causes_val(photoLost(N,LOC),photoBuild(LOC),M,and(photoBuild(LOC)=H,M is H-N)).
  300
  301prim_action(A) :- exog_action(A).
  302poss(A,true) :- exog_action(A).
  303
  304/* ADAPTATION FEATURES */
  305
  306fun_fluent(at_prev(SRVC)) :- service(SRVC).
  307fun_fluent(photoBuild_prev(LOC)) :- location(LOC).
  308rel_fluent(evaluationOK_prev(LOC)) :- location(LOC).
  309rel_fluent(infoSent_prev).
  310
  311causes_val(disconnect(_,_),at_prev(SRVC),LOC,at(SRVC)=LOC) :- service(SRVC),location(LOC).
  312causes_val(disconnect(_,_),photoBuild_prev(LOC),X,photoBuild(LOC)=X) :- location(LOC).
  313causes_val(disconnect(_,_),evaluationOK_prev(Loc),X,evaluationOK(Loc)=X) :- location(Loc).
  314causes_val(disconnect(_,_),infoSent_prev,X,infoSent=X).
  315
  316causes_val(photoLost(_,_),at_prev(SRVC),LOC,at(SRVC)=LOC) :- service(SRVC),location(LOC).
  317causes_val(photoLost(_,_),photoBuild_prev(LOC),X,photoBuild(LOC)=X) :- location(LOC).
  318causes_val(photoLost(_,_),evaluationOK_prev(Loc),X,evaluationOK(Loc)=X) :- location(Loc).
  319causes_val(photoLost(_,_),infoSent_prev,X,infoSent=X).
  320
  321proc(hasConnection_prev(SRVC), hasConnectionHelper_prev(SRVC,[SRVC])).
  322
  323proc(hasConnectionHelper_prev(SRVC,M), 
  324	or(neigh_prev(SRVC,1),
  325		some(n,and(service(n),
  326					and(neg(member(n,M)),
  327					and(neigh_prev(n,SRVC),
  328							hasConnectionHelper_prev(n,[n|M]))))))
  329).
  330
  331proc(neigh_prev(Srvc1,Srvc2),  some(x1,some(x2,some(y1,some(y2,some(k1,some(k2,and(at_prev(Srvc1)=loc(x1,y1),and(at_prev(Srvc2)=loc(x2,y2),and(square(x1-x2,k1),and(square(y1-y2,k2),sqrt(k1+k2)<7))))))))))).
  332
  333/* ADAPTATION DOMAIN-INDEPENDENT FEATURES */
  334
  335prim_action(finish).
  336poss(finish,true).
  337
  338rel_fluent(finished).
  339causes_val(finish,finished,true,true).
  340
  341rel_fluent(exogenous).
  342initially(exogenous,false).
  343
  344rel_fluent(adapted).
  345
  346prim_action(resetExo).
  347poss(resetExo,true).
  348
  349causes_val(resetExo,exogenous,false,true).
  350causes_val(adaptStart,adapted,false,true).
  351causes_val(adaptFinish,adapted,true,true).
  352
  353prim_action(adaptFinish).
  354poss(adaptFinish,true).
  355prim_action(adaptStart).
  356poss(adaptStart,true).
  357
  358%proc(relevant,
  359%  and(writeln('IS IT RELEVANT?'),
  360%    or(some(Srvc,and(service(Srvc),
  361%		  and(hasConnection_prev(Srvc), 
  362%                     neg(hasConnection(Srvc))))),
  363%       some(Loc,and(location(Loc),
  364%		  and(photoBuild_prev(Loc)=Y, 
  365%                      neg(photoBuild(Loc)=Y))))))).
  366
  367proc(relevant,
  368    		or(some(srvc,	and(service(srvc),
  369		  							and(hasConnection_prev(srvc), 
  370                      						neg(hasConnection(srvc))))
  371       					), % some
  372       			some(loc,and(location(loc),
  373		       						   neg(photoBuild_prev(loc)=photoBuild(loc))
  374		       							  )
  375		       			) % some
  376		       	) % or
  377).
  378
  379
  380proc(goalReached,neg(relevant)).
  381
  382
  383proc(adapt,[adaptStart, ?(report_message(user, 'About to adapt...')),
  384	  	 pconc([adaptingProgram, adaptFinish],
  385	 		while(neg(adapted), [?(writeln('waiting')),wait]))
  386	   ]
  387).	
  388
  389
  390proc(adaptingProgram,  
  391	searchn([?(true),searchProgram, ?(report_message(user, 'Adaptation program found!'))], 
  392				[ assumptions([ 	[ assign([workitem(T,D,_I)],N), readyToStart(T,D,N) ],
  393				 		       			 	[ start(T,D,N,I), finishedTask(T,D,N,I) ]
  394						      			])
  395				]
  396				)
  397). 
  398
  399proc(searchProgram,plans(2,2)).
  400
  401proc(plans(M,N),[?(M<(N+1)),ndet(
  402				[actionSequence(M),?(goalReached)],
  403				[?(SUCCM is M+1),plans(SUCCM,N)]
  404			    )]).
  405
  406proc(actionSequence(N),ndet(
  407				[?(N=0)],
  408				[?(N>0),pi([t,i,n], 
  409				 [ ?(isPickable([workitem(t,id_30,i)],n)),
  410				   assign([workitem(t,id_30,i)],n),
  411				   start(t,id_30,n,i),
  412				   ackTaskCompletion(t,id_30,n),
  413				   release([workitem(t,id_30,i)],n)
  414				  ]
  415			     ), 
  416				?(PRECN is N-1), actionSequence(PRECN)]
  417			   )).
  418
  419
  420
  421/* report_message(user,[]) */
  422
  423/* ABBREVIATIONS - BOOLEAN FUNCTIONS */
  424
  425proc(isPickable(X,N), 
  426	or(X=[], 
  427		and(free(N),
  428		and(X=[A|TAIL],
  429		and(listelem(A),
  430		and(A=workitem(T,_D,_I),
  431		and(isExecutable(T,N),
  432		isPickable(TAIL,N))))))
  433	)
  434).
  435
  436
  437/* Particular attention is needed with respect to the function isExecutable(X,N). The target of this function
  438is to verify if task X can be executed by service N. It means that all capabilities needed by task X must
  439be provided by service N. The function follows three steps:
  440    1) It captures all the capabilities requested by task X recording them in a list A
  441    2) It captures all the capabilities performed by service N recording them in a list C
  442    3) It verifies if capabilities of list A are contained in list C; in that case it returns true */     
  443
  444proc(isExecutable(T,S), and(findall(B,required(T,B),A),and(findall(B,provide(S,B),C),subset(A,C)))).
  445
  446
  447/* THIS IS THE MAIN PROCEDURE FOR INDIGOLOG */
  448
  449proc(main,  mainControl(N)) :- controller(N), !.
  450proc(main,  mainControl(3)). % default one
  451
  452proc(manageAssignment(X), [atomic([pi(n,[?(isPickable(X,n)), assign(X,n)])])]).
  453
  454proc(manageExecution(X), pi(n,[?(assigned(X,n)=true),manageExecutionHelper(X,n)])).
  455
  456proc(manageExecutionHelper([],_N),[]).
  457
  458proc(manageExecutionHelper([workitem(T,D,I)|TAIL],N), 
  459	[start(T,D,N,I), ackTaskCompletion(T,D,N), manageExecutionHelper(TAIL,N)]).
  460
  461proc(manageTermination(X), [atomic([pi(n,[?(assigned(X,n)=true), release(X,n)])])]).
  462
  463proc(manageTask(X), [manageAssignment(X),manageExecution(X),manageTermination(X)]).
  464
  465/* This is the process represented by the activity diagram */
  466
  467proc(mainControl(5), prioritized_interrupts(
  468	[interrupt(and(neg(finished),exogenous), monitor),
  469	 interrupt(true, [process,finish]),
  470	 interrupt(neg(finished), wait)
  471	])).
  472
  473
  474proc(monitor,[?(writeln('Monitor')),
  475		  ndet(
  476			[?(neg(relevant)),?(writeln('NonRelevant'))],
  477			[?(relevant),?(writeln('Relevant')),adapt]
  478		  ), resetExo
  479		]).
  480
  481proc(process, 
  482[rrobin([[manageTask([workitem(compilequest,id_1,loc(1,1))]),rrobin([manageTask([workitem(takephoto,id_2,loc(1,1))]),manageTask([workitem(takephoto,id_3,loc(1,1))])])],
  483[rrobin([
  484	manageTask(
  485		[workitem(go,id_4,loc(2,2)),
  486		 workitem(takephoto,id_5,loc(2,2))]),
  487        manageTask(
  488		[workitem(go,id_6,loc(2,2)),
  489		 workitem(compilequest,id_7,loc(2,2))])]),
  490	manageTask([workitem(takephoto,id_8,loc(2,2))])
  491	]])]).
  492
  493
  494
  495%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  496%  INFORMATION FOR THE EXECUTOR
  497%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  498% Translations of domain actions to real actions (one-to-one)
  499actionNum(X,X).
  500
  501%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  502% EOF
  503%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%