/* APPENDIX C Section C.6 A Delivery Example in Golog To run a program mentioned in Section 5.6 do the following. First, load the online interpreter. Second, load this file and call the offline interpreter with arguments: bp(mail1,12,Pol,Val,Prob,myresults). bp(mail2,12,Pol,Val,Prob,myresults). Horizons longer than 12 are ok, but horizons less than 12 are too short to complete both deliveries mentioned in the example. */ /* Note that Golog programs formulated in this file cannot be run with an off-line BestDo interpreter because a delivery domain is represented here using actions with temporal arguments and BestDo works only with actions without temporal argument. To run Golog programs given in this file, first, you need to load the online interpreter. It supports actions that have temporal argument and provides compatibility with an offline interpreter. Then load this file and call the offline interpreter with the following arguments: bp(gologProgram,Horizon,Pol,Val,Prob,myresults). */ :- set_flag(all_dynamic, on). :- dynamic(proc/2). :- pragma(debug). :- dynamic(stophere/1). % useful for debugging :- set_flag(stophere/1, spy, on). % type debug to turn debugger on and use "l" :- set_flag(stophere/1, leash, stop).%to leap from one break-point to another /* :- set_flag(reward/2, spy, on). % useful for debugging of rewards :- set_flag(reward/2, leash, stop). % to enable debugging remove comments */ stophere(yes). /* A Coffee and Mail Delivery Robot Based on Decision Theoretic Golog. */ /* Common abbreviations: wC - wantsCoffee tT - travelTime of - office cr - Craig fa - Fahiem lg - lounge yv - Yves vi - visitor st - Steven ma - Maurice */ /* GOLOG Procedures */ range(people3, [cr,fa,lg]). range(people4, [cr,fa,ma,lg]). range(people41, [cr,fa,st,lg]). range(people5, [cr,fa,st,ma,lg]). range(people51, [cr,fa,st,ma,yv]). range(people6, [cr,vi,fa,st,ma,yv]). range(people7, [cr,vi,lg,fa,st,ma,yv]). range(people, [ann,bill,joe]). range(profs,[cr,fa]). range(long, [itrc,ray,cr,vi,fa,lg,st,ma,yv]). range(lp271, [st,ma,yv]). range(lp276, [fa,vi]). range(lp290b, [cr]). range(lp269, [lg]). range(offices3, [lp271,lp276,lp290b]). range(offices4, [lp271,lp276,lp290b,lp269]). inRange(P,R) :- range(R,L), member(P,L). /* For example, call deliver(people) */ proc(deliver(List), pickBest(p, List, pi(t, deliverCoffee(p,t))) # pickBest(p, List, pi(t, deliverMail(p,t))) ). proc(mc1, while( some(person, some(t1, some(t2, some(number, (wantsCoffee(person,t1,t2) v mailPresent(person,number)) & -status(person,out) )))), ( pickBest(p, people3, ?(some(t1, some(t2, wantsCoffee(p,t1,t2))) & -status(p,out)) : pi(t, ?(now(t)): deliverCoffee(p,t)) ) # pickBest(p, people3, ?(some(n, mailPresent(p,n)) & -status(p,out)) : pi(t, ?(now(t)): deliverMail(p,t)) ) ) : pi(t, ?(now(t)) : goto(mo,t)) : leaveItems ) ). /* In the following procedure R can be people3, people4, etc */ proc(cof(R), while( some(person, inRange(person,R) & some(t1, some(t2, wantsCoffee(person,t1,t2) & -status(person,out) ))), loc(pickBest(p, R, ?(some(t1, some(t2, wantsCoffee(p,t1,t2))) & -status(p,out)) : pi(t, ?(now(t)): deliverCoffee(p,t)) ) : pi(t, ?(now(t)) : goto(mo,t)) : leaveItems ) ) ). /* In the following procedure R can be offices3 or offices4. */ proc(coffee(R), while( some(office, inRange(office, R) & some(person, inRange(person,office) & some(t1, some(t2, wantsCoffee(person,t1,t2) & -status(person,out) )))), pickBest(room, R, limit(pickBest(p,room, ?(some(t1, some(t2, wantsCoffee(p,t1,t2))) & -status(p,out)) : pi(t, ?(now(t)): deliverCoffee(p,t)) ) /*endPickBest*/ : /* pi(t, ?(now(t)) : goto(mo,t)) : leaveItems*/ pi(t, ?(now(t)) : if( -carrying(coffee), /* THEN */ goto(mo,t), /* ELSE */ nil % door closed or give failed /* or "noOp(tt)" - needs time argument */ ) /*endIF*/ ) ) /*endLimit*/ ) /*endPickBest*/ ) : if(robotLoc(mo), nil, pi(t,?(now(t)) : goto(mo,t))) ). proc(deliverTo(P,T), if( robotLoc(mo) & -some(item,carrying(item)), /* THEN */ pickItems(P,T) : deliverTo(P,T), /* ELSE */ if( some(item,(carrying(item))), /* THEN */ goto(of(P),T) : pi(tN, ?(now(tN)) : /* pi(wait, ?(wait $>=0) : pi(time, ?(time $= tN+wait) : */ giveItems(P,tN) : goto(mo,tN) : leaveItems ), /* ELSE */ goto(mo,T) : pi(tN, ?(now(tN)) : deliverTo(P,tN)) ) ) ). proc(pickItems(P,T), if( some(n,some(t1,some(t2, mailPresent(P,n) & wantsCoffee(P,t1,t2) ))), /* THEN pickup both mail and cofee */ pickup(coffee,T) : pickup(mailTo(P),T), /* ELSE pickup only one item */ if( some(n,mailPresent(P,n)), /* THEN take only mail */ pickup(mailTo(P),T), /* ELSE take just coffee */ pickup(coffee,T) ) ) ). proc(giveItems(P,T), if( carrying(coffee) & carrying(mailTo(P)), /* Give both items */ give(coffee,P,T) : give(mailTo(P),P,T), /* otherwise give just one of items */ if( carrying(mailTo(P)), give(mailTo(P),P,T), give(coffee,P,T) ) ) ). proc(leaveItems, while(some(item, carrying(item)), pi(item, ?(carrying(item)) : pi(tN, ?(now(tN)) : putBack(item,tN) )) ) ). proc(deliverCoffee(P,T), if(robotLoc(mo), /* THEN */ if( carrying(coffee), serveCoffee(P,T), pickup(coffee,T) : serveCoffee(P,T) ), /* ELSE */ if(-carrying(coffee), goto(mo,T) : pi(t, ?(now(t)) : pickup(coffee,t) : serveCoffee(P,t)), serveCoffee(P,T) ) ) ). /* Serve immediately on arrival */ proc(serveCoffee(P,T), if(robotLoc(of(P)), /* THEN */ give(coffee,P,T), /* ELSE */ goto(of(P),T) : pi(t, ?(now(t)) : give(coffee,P,t)) ) ). /* Wait before serving */ proc(serveCW(P,T), if(robotLoc(of(P)), /* THEN */ pi(wait, ?(0 $<= wait) : pi(t, ?(t $= T+wait) : give(coffee,P,t))), /* ELSE */ goto(of(P),T) : pi(time, ?(0 $<= time) : pi(wait, ?(0 $<= wait) : pi(t, ?(now(t)) : ?(time $= t+wait) : give(coffee,P,time) ))) ) ). proc(deliverMail(P,T), if(robotLoc(mo), /* THEN */ if( carrying(mailTo(P)), serveMail(P,T), pickup(mailTo(P),T) : serveMail(P,T) ), /* ELSE */ if(-carrying(mailTo(P)), goto(mo,T) : pi(t, ?(now(t)) : pickup(mailTo(P),t) : serveMail(P,t)), serveMail(P,T) ) ) ). proc(serveMail(P,T), if(robotLoc(of(P)), /* THEN */ give(mailTo(P),P,T), /* ELSE */ goto(of(P),T) : pi(t, ?(now(t)) : give(mailTo(P),P,t)) ) ). /* This procedure is designed to test the mail delivery example from Section 5.6. It does the same as the following procedure mail2 iff in the initial situation only mailPresent(cr,1,s0) and mailPresent(fa,1,s0) are true (i.e., cr and fa do NOT want any coffee). */ proc(mail1, while( some(p, some(n, mailPresent(p,n) & -hasMail(p) & -status(p,out) )), pickBest(p, profs, ?( some(n, mailPresent(p,n)) & -status(p,out) & -hasMail(p) ) : pi(t, deliverMail(p,t) ) : pi(t, ?(now(t)) : goto(mo,t)) : leaveItems ) ) ). /* The procedure mail2 is supposed to find which sequence (mcr : mfa) vs. (mfa : mcr) of deliveries yields the highest total expected value. Note that the first literal in the termination condition of the while-loop in mail2 (or mail1) must be positive (to ground variables before negation-as-failure will be applied to them). The procedure mail2 delivers both mail and coffee (if requested); to test the mail delivery example from Section 5.6 make sure that in the initial situation only mailPresent(cr,1,s0) and mailPresent(fa,1,s0) are true (i.e., cr and fa do NOT want any coffee). */ proc(mail2, while( some(p, some(n, mailPresent(p,n) & -status(p,out) & -hasMail(p) )), pickBest(p, profs, ?(some(n, mailPresent(p,n) & -status(p,out) & -hasMail(p) )) : pi(t, deliverTo(p,t) ) ) ) ). proc(mcr, pi(t, deliverTo(cr,t) ) ). proc(mfa, pi(t, deliverTo(fa,t) ) ). proc(goto(L,T), pi(rloc,?(robotLoc(rloc)) : pi(deltat,?(tT(rloc,L,deltat)) : goBetween(rloc,L,deltat,T)))). /* Going from a location to the same location may take non-zero time if the location is a hallway. But normally, if a source and a destination are the same and the travel time between them is 0, then goBetween does nothing. */ proc(goBetween(Loc1,Loc2,Delta,T), if( Loc1=Loc2 & Delta=0, nil, startGo(Loc1,Loc2,T) : pi( time, ?(now(time)) : if( time=T, % THEN (offline) pi(t, ?(t $= T + Delta) : endGo(Loc1,Loc2,t) ) , % ELSE (online) endGo(Loc1,Loc2,time) ) ) ) ). /* proc(goBetween(Loc1,Loc2,Delta,T), if( Loc1=Loc2 & Delta=0, nil, startGo(Loc1,Loc2,T) : pi(time, ?(time $= T + Delta) : endGo(Loc1,Loc2,time) ) ) ). */ /* Nondeterministic Actions */ /* Robot's actions */ nondetActions(endGo(L1,L2,T),S,[endGoS(L1,L2,T),endGoF(L1,hall,TF)]) :- L1 \== hall, tT(L1, hall, Delta), start(S,TS), TF $= TS + Delta ; /* OR */ L1 == hall, start(S,TS), TF $= TS + 20. /* A failed endGo action takes some time even if we started in the hall. This is not a very smart guess, though.*/ nondetActions(give(Item,Pers,T),S,[giveS(Item,Pers,T),giveF(Item,Pers,T)]). /* Because a person loads things on robot, in this version the action `pickup' is deterministic. */ /* Exogenous actions: the robot has no control over them */ nondetAction(cfRequest(P,T1,T2,T),S, [cfRequest(P,T1,T2,T),noRequest(P,T)]). nondetActions(mailArrives(Person,T),S, [mailArrives(Person,T),noMail(Person,T)]). /* Later : connect to the robot */ doSimul(A) :- agentAction(A), not senseAction(A), deterministic(A,S), printf("I'm doing the deterministic action %w\n",[A]). doSimul(A) :- agentAction(A), nondetActions(A,S,NatOutcomesList), printf("I'm doing the stochastic action %w\n",[A]). doSimul(A) :- senseAction(A), printf("Im doing the sensing action %w\n",[A]), printf("Type the value returned by the sensor\n",[]), stophere(yes), A =.. [ActionName,SensorName,Value,Time], read(Value). /* Alternative implementation: introduce the predicate value(SenseAction,Value) and for each sense action senseAct include in the domain axiomatization an axiom similar to value( senseAct(X,Val,Time), Val ). Then we can simply call this predicate "value" in the clause above. */ /* Identification conditions for robot's stochastic actions */ senseCondition(endGoS(Loc1,Loc2,T), robotLoc(Loc2) ). senseCondition(endGoF(Loc1,Loc2,T), robotLoc(hall) ). senseCondition(giveS(Item,Pers,T),W) :- Item=mailTo(Pers), W = hasMail(Pers); Item=coffee, W = hasCoffee(Pers). senseCondition(giveF(Item,Pers,T),W) :- Item=mailTo(Pers), W = (-hasMail(Pers)); Item=coffee, W = (-hasCoffee(Pers)). /* Identification conditions for exogenous actions: not implemented */ /* senseCondition(cfRequest(P,T1,T2,T),wantsCoffee(P,T1,T2)). senseCondition(mailArrives(Person,T), some(now, some(prev, some(act, curentSit(now) & now=do(act,prev) & some(mNow, mailPresent(Person,mNow) & some(mPrev, mailPresent(Person,mPrev,prev) & mNow > mPrev ))))) ). % What do we sense if nothing happened? senseCondition(noRequest(P,T), -some(t1,some(t2,wantsCoffee(P,t1,t2))) ). senseCondition(noMail(Person,T), some(now, some(prev, some(act, curentSit(now) & now=do(act,prev) & some(mNow, mailPresent(Person,mNow) & some(mPrev, mailPresent(Person,mPrev,prev) & mNow = mPrev ))))) ). */ senseExo(S1,S2) :- S2=S1. /* Probabilities */ /* Robot's actions */ prob(endGoS(Loc1,Loc2,T), PS, S) :- (PS is 0.99) . prob(endGoF(Loc1,Loc2,T), PF, S) :- (PF is 0.01) . prob(giveF(Item,Pers,T), Pr2, S) :- prob(giveS(Item,Pers,T), Pr1, S), Pr2 is (1 - Pr1). /* If Ray/Craig is in his office with probability _0.6_ and Visitor/Fahiem is in with probability 0.6, then given our reward functions it is better to give(mailTo(fa),fa,45) and later give(mailTo(cr),cr,200) prob(giveS(Item,Pers,T), Pr, S) :- ( Pers=cr, (Pr is 0.6 ) ; Pers=fa, (Pr is 0.6 ) ; not Pers=cr, not Pers=fa, (Pr is 0.95) ). */ /* If Ray/Craig is in his office with probability _0.8_ but Visitor/Fahiem is in his office with probability 0.6, then given our reward functions it is better to give(mailTo(cr),cr,110) and later give(mailTo(fa),fa,265) */ prob(giveS(Item,Pers,T), Pr, S) :- ( Pers=cr, (Pr is 0.8 ) ; Pers=fa, (Pr is 0.6 ) ; not Pers=cr, not Pers=fa, (Pr is 0.95) ). /* Exogenous actions. */ /* The probabilistic model of how employees request coffee assumes that requests can occur in any situation (time of the request is tied up to the start time of the situation) and more often people ask for coffee if they did not have coffee yet. Variations: Prob depends on T that is not tied up to start time of S; some individuals more probably request coffee in certain time intervals (e.g., at the morning) than at other time, some employees request coffee more often than others, etc. prob(cfRequest(Pers,T1,T2,T), Pro, S) :- person(Pers), start(S,T), frandom(Rand1), N is 100*Rand1, round(N, Bottom), T1 is 100 + T + Bottom, random(Rand2), M is 100*Rand2, round(M, Top), T2 is T1 + Top, ( hasCoffee(Pers,S), Pro is (0.1) ; not hasCoffee(Pers,S), Pro is (0.9) ). prob(noRequest(Pers,T),P1,S) :- prob(cfRequest(Pers,T1,T2,T), P2, S), P1 is 1 - P2. prob(mailArrives(Pers,T), Pro, S) :- person(Pers), start(S,TS), % Assume that TS is a fixed time % Lambda is (T - TS)/10, exp(Lambda,Res), Pro is 1 - (1/Res). prob(noMail(Pers,T),P1,S) :- prob(mailArrives(Pers,T), P2, S), P1 is 1 - P2. */ /* Preconditions for Primitive Actions */ /* Robot's actions */ poss(pickup(Item,T),S) :- Item = coffee, not carrying(Item,S), robotLoc(mo,S). poss(pickup(Item,T),S) :- Item = mailTo(P), not carrying(Item,S), robotLoc(mo,S), mailPresent(P,N,S), N > 0. poss(giveS(Item,Person,T),S) :- Item=coffee, carrying(Item,S), robotLoc(of(Person),S). /* The robot is permitted to give mail only to the addressee */ poss(giveS(Item,Person,T),S) :- Item=mailTo(Person), carrying(Item,S), robotLoc(of(Person),S). poss(giveF(Item,Person,T),S) :- Item=coffee, carrying(Item,S), robotLoc(of(Person),S). poss(giveF(Item,Person,T),S) :- Item=mailTo(Person), carrying(Item,S), robotLoc(of(Person),S). poss(startGo(Loc1,Loc2,T),S) :- robotLoc(Loc1,S), not going(L,LL,S). poss(endGoS(Loc1,Loc2,T),S) :- going(Loc1,Loc2,S). poss(endGoF(Loc1,Loc2,T),S) :- going(Loc1,Loc3,S), not (Loc2=Loc3). poss(putBack(Item,T),S) :- robotLoc(mo,S), carrying(Item,S). /* Exogenous actions */ /* poss(mailArrives(Person,T),S). poss(noMail(P,T),S). poss(cfRequest(Person,T1,T2,T),S) :- T $<= T1, T1 $< T2. poss(noRequest(P,T),S). */ /* Successor State Axioms */ hasCoffee(Person,do(A,S)) :- A = giveS(coffee,Person,T). hasCoffee(Person,do(A,S)) :- A = sense(buttons,Answer,T), Answer==1, robotLoc(of(Person),S). hasCoffee(Person,do(A,S)) :- hasCoffee(Person,S), not A = giveS(coffee,Person,T), not A = sense(buttons,1,T). hasMail(Person, do(A,S)) :- A = giveS(mailTo(Person),Person,T). hasMail(Person, do(A,S)) :- A = sense(buttons,Answer,T), Answer==1, robotLoc(of(Person),S). hasMail(Person, do(A,S)) :- hasMail(Person,S), not A = sense(buttons,1,T), not A = giveS(mailTo(Person),Person,T). robotLoc(L,do(A,S)) :- A = endGoS(LocStart,L,T). robotLoc(L,do(A,S)) :- A = endGoF(LocStart,L,T). robotLoc(L,do(A,S)) :- A = sense(coordinates,V,Time), xCoord(V,X), yCoord(V,Y), inside(L,X,Y). robotLoc(L,do(A,S)) :- robotLoc(L,S), not A = endGoS(Loc2,Loc3,T), not A = endGoF(Loc2,Loc3,T), not ( A = sense(coordinates,V,T), xCoord(V,X), yCoord(V,Y), inside(Loc,X,Y), L \== Loc ). inside(mo,X,Y) :- bottomY(mo,Yb), Yb =< Y, topY(mo,Yt), Y =< Yt, leftX(mo,Xl), Xl =< X, rightX(mo,Xr), X =< Xr. inside(of(Person),X,Y) :- bottomY(of(Person),Yb), Yb =< Y, topY(of(Person),Yt), Y =< Yt, leftX(of(Person),Xl), Xl =< X, rightX(of(Person),Xr), X =< Xr. inside(hall,X,Y) :- not inside(mo,X,Y), not inside(of(P),X,Y). going(Origin,Destination,do(A,S)) :- A = startGo(Origin,Destination,T). going(Origin,Destination,do(A,S)) :- going(Origin,Destination,S), not A = endGoS(Origin,Destination,T), not A = endGoF(Origin,Elsewhere,T). carrying(Item,do(A,S)) :- A = pickup(Item,T). carrying(Item,do(A,S)) :- carrying(Item,S), not A = giveS(Item,Person,T), not A = putBack(Item,T). /* status(Person,DoorPersonOfficeStatus, Sit) means whether the door of Person's office is open (and then Person is in), closed (Person is out) or unknown (if the office of Person has never been visited before). */ status(Person,Stat,do(A,S)) :- A = giveS(Item,Person,T), Stat=in. % Person is in status(Person,Stat,do(A,S)) :- A = giveF(Item,Person,T), Stat=out. % Person is out status(Person,Stat,do(A,S)) :- status(Person,Stat,S), not A=giveS(Item,Person,T), not A=giveF(Item,Person,T). /* wantsCoffee(P,T1,T2,do(A,S)) :- A = cfRequest(P,T1,T2,T). */ wantsCoffee(P,T1,T2,do(A,S)) :- wantsCoffee(P,T1,T2,S), not A=giveS(coffee,P,T). /* The following axiom assumes that if initially a person P does not have mail in the mailbox, this is represented by leaving out mailPresent(P,X,s0); it is also assumed that mail arrives one by one. mailPresent(Person,N,do(A,S)) :- A=mailArrives(Person,T), mailPresent(Person,M,S), M > 0, N is M+1. mailPresent(Person,N,do(A,S)) :- A=mailArrives(Person,T), not mailPresent(Person,M,S), N is 1. */ mailPresent(Person,N,do(A,S)) :- A = putBack(mailTo(Person),T), N is 1 . % not mailPresent(Person,X,S), N is 1. % mailPresent(Person,N,do(A,S)) :- A = putBack(mailTo(Person),T), % mailPresent(Person,M,S), N is M + 1. mailPresent(Person,N,do(A,S)) :- mailPresent(Person,N,S), not A = pickup(mailTo(Person),T). /* Reward function */ reward(R, s0) :- R $= 0. /* A simpler version might also be sufficient in most cases: reward(0, s0). */ reward(V, do(A,S)) :- A = giveS(coffee,Person,T), wantsCoffee(Person,T1,T2,S), V $<= (T2 - T)/2, V $<= T - (3*T1 - T2)/2, VL $<= V, rmax(VL). reward(V, do(A,S)) :- A = giveS(coffee,Person,T), not wantsCoffee(Person,T1,T2,S), T $<= TM, rmin(TM), V $= 0. /* Just to give an idea what rewards the robot may get for serving coffee: wantsCoffee(ray,340,380). V $<= (380 - T)/2 & V $<= T - 320. rmax(V)=20 wantsCoffee(vi,150,200). V $<= (200 - T)/2 & V $<= T - 125. rmax(V)=25 */ /* We use a declining linear function of time as a reward function to encourage earlier mail delivery. */ reward(V, do(A,S)) :- A = giveS(mailTo(P),P,T1), % whenMailArrived(P,S,N,T2), ( P=cr, V $<= 30 - T1/10 ; P=fa, V $<= 15 - T1/20 ; P\==cr, P\==fa, V $<= 10 - T1/10 ), rmax(V). /* When the robot gets stuck in the hall, it costs 5 points ; other actions bring 0 costs/rewards. reward(V, do(A,S)) :- A = startGo(Loc1,Loc2,T), V $= 0 ; A = endGoS(Loc1,Loc2,T), tT(Loc1,Loc2,T12), V $= 0 ; % (1000 - T)/ T12 % ; A = endGoF(Loc1,Loc2,T), V $= -5. reward(V, do(A,S)) :- not (A=giveS(Item,P,T), A=startGo(L1,L2,T), A=endGoS(L1,L2,T), A=endGoF(L1,L2,T) ), V $= 0. */ reward(V, do(A,S)) :- not A=giveS(Item,P,T), V $= 0. whenMailArrived(P,s0,N,Time) :- mailPresent(P,N,s0), N > 0, Time $= 0. whenMailArrived(P,S2,N,Time) :- S2=do(A,S1), ( A=mailArrives(P,T), Time $= T, ( mailPresent(P,M,S1) -> N is M+1 ; N=1) ; not A=mailArrives(P,T), whenMailArrived(P,S1,N,Time) ). /* The time of an action occurrence is its last argument. */ time(pickup(Item,T),T). time(giveS(Item,Person,T),T). time(giveF(Item,Person,T),T). time(startGo(Loc1,Loc2,T),T). time(endGoS(Loc1,Loc2,T),T). time(endGoF(Loc1,Loc2,T),T). time(putBack(Item,T),T). time(sense(buttons,Answer,Time),Time). time(sense(coordinates,V,Time),Time). % time(cfCancel(P,T1,T2,T),T). % time(cfRequest(Pers,T1,T2,T),T). % time(noRequest(P,T), T). % time(mailArrives(P,T),T). % time(noMail(P,T), T). /* Restore situation arguments to fluents. */ restoreSitArg(robotLoc(Rloc),S,robotLoc(Rloc,S)). restoreSitArg(hasCoffee(Person),S,hasCoffee(Person,S)). restoreSitArg(hasMail(Person),S,hasMail(Person,S)). restoreSitArg(going(Loc1,Loc2),S,going(Loc1,Loc2,S)). restoreSitArg(carrying(Item),S,carrying(Item,S)). restoreSitArg(status(Pers,Office),S,status(Pers,Office,S)). restoreSitArg(wantsCoffee(Person,T1,T2),S,wantsCoffee(Person,T1,T2,S)). restoreSitArg(mailPresent(Person,N),S,mailPresent(Person,N,S)). restoreSitArg(currentSit(X),S,currentSit(X,S)). /* This is a handy expression */ currentSit(X,S) :- X = S. /* Primitive Action Declarations */ agentAction(pickup(Item,T)). agentAction(give(Item,Person,T)). agentAction(startGo(Loc1,Loc2,T)). agentAction(endGo(Loc1,Loc2,T)). agentAction(putBack(Item,T)). % agentAction(cfRequest(Pers,T1,T2,T)). % agentAction(mailArrives(Pers,T)). % agentAction(cfCancel(P,T1,T2,T)). /* All sensing actions have 3 arguments: - the 1st argument is property/quantity that we would like to measure - the 2nd argument is the value returned by sensor at the run-time - the last 3rd argument is time */ senseAction(sense(buttons,Answer,Time)). /* Answer can be 1 or 0 */ senseAction(sense(coordinates,V,Time)). differentiatingSeq(endGo(Loc1,Loc2,T), sense(coordinates,V,T)). differentiatingSeq(give(Item,Person,T), sense(buttons,Answer,T)). /* Initial Situation. */ % robotLoc(park,s0). robotLoc(mo,s0). status(ray,unknown,s0). status(itrc,unknown,s0). % office lp269 status(lg,unknown,s0). % office lp271 status(ma,unknown,s0). status(st,unknown,s0). status(yv,unknown,s0). % office lp276 status(fa,unknown,s0). status(vi,unknown,s0). % office lp290b status(cr,unknown,s0). % wantsCoffee(ray,340,380,s0). /* wantsCoffee(yv,800,850,s0). wantsCoffee(fa,500,550,s0). wantsCoffee(lg,150,200,s0). wantsCoffee(vi,1100,1150,s0). wantsCoffee(cr,310,400,s0). wantsCoffee(st,600,650,s0). wantsCoffee(ma,1000,1050,s0). */ /* times for video: */ /* wantsCoffee(fa,150,200,s0). wantsCoffee(yv,320,400,s0). wantsCoffee(ma,320,400,s0). wantsCoffee(lg,230,300,s0). wantsCoffee(cr,310,400,s0). */ % mailPresent(lg, 1,s0). % mailPresent(ray,1,s0). % mailPresent(vi,1,s0). mailPresent(cr,1,s0). mailPresent(fa,1,s0). /* A simple example from Section 5.3: run the procedure deliver */ % wantsCoffee(ann,100,150,s0). % mailPresent(joe,4,s0). % % tT0( mo, of(ann), 45 ). % tT0( mo, of(joe), 100 ). % tT0( mo, of(bill), 50 ). tT(L,L,0) :- L \== hall. tT(L1,L2,T) :- tT0(L1,L2,T) ; tT0(L2,L1,T). /* --- TABLE OF AVERAGE TRAVEL TIME FROM cm --- -----------RAY 75 (51, 72 cm->ray; 56, 55 ray->cm) | +-------------- | | +--ITRC 24 CM--+ | | | +--VISITOR 40 | LOUNGE-+ 58 (cm->lg), 63 (lg->cm) | ------+-------------------- */ tT0( park, mo, 100 ). /* 73, 82 on simulator */ tT0( park, hall, 80 ). tT0( hall, mo, 20 ). tT0( hall, hall, 10 ). tT0( mo, of(ray), 110 ). /* 51,72,56,55 on simulator*/ tT0( mo, of(cr), 110 ). /* 51,72,56,55 on simulator*/ tT0( mo, of(itrc), 30 ). /* 24 on simulator */ tT0( mo, of(vi), 45 ). /* 29 on simulator */ tT0( mo, of(fa), 45 ). /* 29 on simulator */ tT0( mo, of(lg), 75 ). /* 58, 63 on simulator */ tT0( mo, lp271, 70 ). tT0( mo, lp276, 45 ). tT0( mo, of(st), 70 ). tT0( mo, of(yv), 70 ). tT0( mo, of(ma), 70 ). tT0( hall, of(ray), 40 ). tT0( hall, of(cr), 60 ). /* 51,72,56,55 on simulator*/ tT0( hall, of(itrc), 20 ). /* 24 on simulator */ tT0( hall, of(vi), 20 ). /* 29 on simulator */ tT0( hall, of(fa), 20 ). /* 45 on simulator */ tT0( hall, of(lg), 35 ). /* 58, 63 on simulator */ tT0( hall, of(st), 30 ). tT0( hall, of(yv), 30 ). tT0( hall, of(ma), 30 ). tT0( hall, lp271, 30 ). tT0( hall, lp276, 20 ). /* Other travel times (measured on simulator): */ tT0( of(cr), of(itrc), 70 ). tT0( of(cr), of(vi), 120 ). tT0( of(cr), of(fa), 120 ). tT0( of(cr), of(lg), 130 ). tT0( of(lg), of(itrc), 70 ). tT0( of(lg), of(vi), 60 ). tT0( of(lg), of(fa), 60 ). tT0( of(vi), of(itrc), 50 ). tT0( of(fa), of(itrc), 120 ). tT0( park, of(vi), 60 ). /* Geometric coordinates on the real of map. */ /* New coordinates shifted by -800 in the first coordinate: of(ray) = (3753.4, 1800) cm = (2675, 2555) park = (118, 2487) OLD= (4530, 1750) OLD= (3465, 2600) OLD= (930, 2530) */ xCoord([X,Y],R) :- R=X. yCoord([X,Y],R) :- R=Y. xCoord(V,X) :- V=[X,Y,Angle]. yCoord(V,Y) :- V=[X,Y,Angle]. /* X Y X Y left_bottom(mo) = (2400,2550) right_top(mo) = (2780,2900) left_bottom(fa) = (1600,2300) right_top(fa) = (1800,2520). left_bottom(cr) = (3700,1600) right_top(cr) = (3850,1800) left_bottom(lg) = (550,2600) right_top(lg) = (800,2800) left_bottom(itrc) = (3100,2300) right_top(itrc) = (3250,2500) left_bottom(lp271) = (900,2550) right_top(lp271)= (1200,2800) left_bottom(elevator)=(3250,1600) right_top(elevator) = (3440,1650) */ bottomY(mo, 2520). % bottomY(lp271, 2600). % bottomY(lp276, 2300). bottomY(of(st), 2550). bottomY(of(yv), 2550). bottomY(of(ma), 2550). bottomY(of(cr), 1600). bottomY(of(fa), 2300). bottomY(of(vi), 2300). bottomY(of(lg), 2600). bottomY(of(itrc), 2300). topY(mo, 2900). % topY(lp271, 2800). % topY(lp276, 2500). topY(of(st), 2800). topY(of(yv), 2800). topY(of(ma), 2800). topY(of(cr), 1800). topY(of(fa), 2520). topY(of(vi), 2520). topY(of(lg), 2800). topY(of(itrc), 2500). leftX(mo, 2400). % leftX(lp271, 900). % leftX(lp276, 1600). leftX(of(st), 900). leftX(of(yv), 900). leftX(of(ma), 900). leftX(of(cr), 3700). leftX(of(fa), 1600). leftX(of(vi), 1600). leftX(of(lg), 550). leftX(of(itrc), 3100). rightX(mo, 2780). % rightX(lp271, 1200). % rightX(lp276, 1800). rightX(of(st), 1200). rightX(of(yv), 1200). rightX(of(ma), 1200). rightX(of(cr), 3850). rightX(of(fa), 1800). rightX(of(vi), 1800). rightX(of(lg), 800). rightX(of(itrc), 3250). drivePath( _, of(lg), [ ( 840, 2560 ), ( 770, 2530 ) ] ). drivePath( _, of(vi), [ ( 1670, 2450 ) ] ). drivePath( _, of(fa), [ ( 1670, 2450 ) ] ). drivePath( of(itrc), mo, [ ( 3120, 2450 ), ( 2700, 2550 ) ] ). drivePath( mo, of(itrc), [ ( 2665, 2620 ), ( 3120, 2450 ) ] ). drivePath( of(cr), mo, [ ( 3760, 2420 ), (3560, 2480 ), ( 2820, 2560 ), ( 2690, 2550 ) ] ). drivePath( _, of(st), [(1500,2500), (1030,2600), (1010,2625)] ). drivePath( _, of(ma), [(1500,2500), (1030,2600), (1010,2625)] ). drivePath( _, of(yv), [(1500,2500), (1030,2600), (1010,2625)] ). drivePath( _, mo, [ (2685, 2500), (2700, 2630) ] ). drivePath( _, of(itrc), [ ( 3120, 2450 ) ] ). drivePath( _, of(cr), [ (3535, 2490 ), (3760, 2480), ( 3760, 1720 ) ] ). drivePath(_, park, [(200, 2500)] ). driveSim( StartPos, EndPos ) :- nl, write("drive, drive, drive from "), write(StartPos), write(" to "), write(EndPos), nl. /* Drive in the corridor and turn to the goal location */ driveReal( StartPos, EndPos ) :- drivePath( StartPos, EndPos, Path ), % get path hli_go_path( Path ), % drive, drive... look( EndPos, X, Y ), % get aim point for turning hli_turn_to_point( X, Y ). % and turn the robot look( of(lg), 640, 2670 ). look( of(vi), 1600, 2180 ). look( of(fa), 1600, 2180 ). look( mo, 2700, 2800 ). look( of(itrc), 2872, 2200 ). look( of(cr), 3728, 1650 ). look( of(st), 1030, 2750 ). look( of(ma), 1030, 2750 ). look( of(yv), 1030, 2750 ).