3/******************************* FORGET MECHANISM *********************************/
    4
    5
    6% the rule below deals with the case in which the input stream is not temporally sorted
    7forget(InitTime) :-
    8	input(unordered), !,
    9	nextTimePoint(InitTime, NewInitTime),
   10	% forget input entities/events
   11	findall(E, (happensAtIE(E, T), T=<InitTime, retract(happensAtIE(E, T))), _),
   12	% forget the instances (time-points) of input entities/statically determined fluents
   13	findall(U, (holdsAtIE(U, T), T=<InitTime, retract(holdsAtIE(U, T))), _),	
   14	% forget the intervals of input entities/statically determined fluents
   15	findall(E, (holdsForIESI(E, (Start,End)), dealWithInputFluents(E, Start, End, InitTime, NewInitTime)), _).
   16
   17% the rule below deals with the case in which the input stream is temporally sorted
   18forget(InitTime) :-
   19	nextTimePoint(InitTime, NewInitTime),
   20	% forget input entities/events
   21	findall(E, dealWithInputEvents(E, InitTime), _),
   22	% forget the instances (time-points) of input entities/statically determined fluents
   23	findall(U, dealWithInputFluentsT(U, InitTime), _),	
   24	% forget the intervals of input entities/statically determined fluents
   25	findall(U, dealWithInputFluentsI(U, InitTime, NewInitTime), _).
   26
   27
   28% if the entity starts after Qi-WM then keep it (do nothing)
   29dealWithInputFluents(_E, Start, _End, InitTime, _NewInitTime) :-
   30	Start>InitTime, !.
   31
   32% if the entity ends before Qi-WM then delete it
   33dealWithInputFluents(E, Start, End, InitTime, _NewInitTime) :-
   34	End=<InitTime,
   35	retract(holdsForIESI(E,(Start,End))), !.
   36
   37% if the entity starts before or on Qi-WM and ends after Qi-WM then break it
   38dealWithInputFluents(E, Start, End, _InitTime, NewInitTime) :-
   39	retract(holdsForIESI(E,(Start,End))), !, 
   40	\+ NewInitTime=End,
   41	assert(holdsForIESI(E,(NewInitTime,End))). 
   42
   43
   44% stop looking after InitTime=Qi-WM
   45dealWithInputEvents(E, InitTime) :-
   46	happensAtIE(E,T),
   47	(
   48		T>InitTime, !
   49		;
   50		retract(happensAtIE(E,T))
   51	).
   52
   53% stop looking after InitTime=Qi-WM
   54dealWithInputFluentsT(U, InitTime) :-
   55	holdsAtIE(U,T),
   56	(
   57		T>InitTime, !
   58		;
   59		retract(holdsAtIE(U,T))
   60	).
   61
   62
   63% stop looking after InitTime=Qi-WM
   64dealWithInputFluentsI(U, InitTime, NewInitTime) :-
   65	holdsForIESI(U, (Start, End)),	
   66	(
   67		Start>InitTime, !
   68		;
   69		End=<InitTime, 
   70		retract(holdsForIESI(U, (Start, End)))
   71		;		
   72		End>InitTime, 
   73		\+ NewInitTime=End,
   74		retract(holdsForIESI(U, (Start, End))), 
   75		assert(holdsForIESI(U, (NewInitTime, End)))
   76	).
   77
   78
   79
   80/************************************************************************************************** 
   81 Compute the list of intervals of input entities/statically determined fluents.
   82 If the intervals of the input entities are provided then RTEC simply collects these intervals 
   83 and stores them in a list --- see 'collectIntervals' flag.
   84 If the time points of the input entities are provided then RTEC may build the list
   85 of intervals --- see 'buildFromPoints' flag.
   86 **************************************************************************************************/
   87
   88inputProcessing(InitTime, QueryTime) :-
   89	% collect the input entity/statically determined fluent intervals into a list	
   90	findall(F=V, 
   91		(
   92			% collectIntervals2/2 is produced in the compilation stage 
   93			% by combining collectIntervals/1, indexOf/2 and grounding/1
   94			collectIntervals2(Index, F=V),
   95			processIECollectI(Index, F=V, InitTime)
   96		), _),
   97	% build the list of input entity/statically determined fluent intervals 
   98	% given the time-points in which they are detected
   99	findall(F=V, 
  100		(
  101			% buildFromPoints2/2 is produced in the compilation stage 
  102			% by combining collectIntervals/1, indexOf/2 and grounding/1
  103			buildFromPoints2(Index, F=V),
  104			processIEBuildFP(Index, F=V, InitTime, QueryTime)
  105		), _).
  106
  107
  108%%%%%%% processIECollectI
  109
  110processIECollectI(Index, F=V, InitTime) :-
  111	iePList(Index, F=V, RestrictedList, Extension), !,
  112	retract(iePList(Index, F=V, _, _)),
  113	amalgamatePeriods(Extension, RestrictedList, ExtendedPList),
  114	% the predicate below is defined in processSDFluents.prolog
  115	setTheSceneSDFluent(ExtendedPList, InitTime, BrokenPeriod), 
  116	holdsForIE(collectIntervals, F=V, NewPeriods),
  117	updateiePList(Index, F=V, NewPeriods, BrokenPeriod). 
  118
  119% this predicate deals with the case where no intervals for F=V were computed at the previous query time
  120processIECollectI(Index, F=V, _InitTime) :-
  121	holdsForIE(collectIntervals, F=V, NewPeriods),
  122	updateiePList(Index, F=V, NewPeriods, []). 
  123
  124
  125%%%%%%% processIEBuildFP
  126
  127processIEBuildFP(Index, F=V, InitTime, QueryTime) :-
  128	iePList(Index, F=V, RestrictedList, Extension), !,
  129	retract(iePList(Index, F=V, _, _)),
  130	amalgamatePeriods(Extension, RestrictedList, ExtendedPList),
  131	% the predicate below is defined in processSDFluents.prolog
  132	setTheSceneSDFluent(ExtendedPList, InitTime, BrokenPeriod), 
  133	holdsForIE(buildFromPoints, F=V, NewPeriods, QueryTime),
  134	updateiePList(Index, F=V, NewPeriods, BrokenPeriod). 
  135
  136% this predicate deals with the case where no intervals for F=V were computed at the previous query time
  137processIEBuildFP(Index, F=V, _InitTime, QueryTime) :-
  138	holdsForIE(buildFromPoints, F=V, NewPeriods, QueryTime),
  139	updateiePList(Index, F=V, NewPeriods, []). 
  140
  141
  142%%%%%%% updateiePList
  143
  144% if no IE intervals have been computed then do not assert anything
  145updateiePList(_Index, _U, [], []) :- !.
  146
  147updateiePList(Index, F=V, NewPeriods, BrokenPeriod) :- 
  148	assert(iePList(Index, F=V, NewPeriods, BrokenPeriod)).
  149
  150
  151%%%%%%% holdsForIE --- collectIntervals
  152
  153% collect the list of intervals; setof sorts the list of intervals
  154holdsForIE(collectIntervals, IE, L) :-
  155 	setof(SingleI, holdsForIESI(IE, SingleI), L), !.
  156
  157% if there is no holdsForIESI in the input then setof will fail
  158% in this case return the empty list of intervals
  159holdsForIE(collectIntervals, _IE, []).
  160
  161
  162%%%%%%% holdsForIE --- build intervals from points
  163
  164holdsForIE(buildFromPoints, IE, L, QueryTime) :-
  165	% in this case we are given the IE at time-points using holdsAt
  166	% rather than intervals as in collectIntervals
  167	setof(T, holdsAtIE(IE, T), PointList), !, 
  168	% this is the application-dependent temporal distance between two points (eg video frames)
  169	temporalDistance(TemporalDistance),
  170	makeIntervalsFromAllPoints(PointList, TemporalDistance, QueryTime, [], L).
  171
  172holdsForIE(buildFromPoints, _IE, [], _QueryTime).
  173
  174
  175% the predicate below builds an interval given a set of time-points and 
  176% the fixed temporal distance between any two consecutive time-points
  177
  178makeIntervalsFromAllPoints([], _TemporalDistance, _QueryTime, L, L) :- !.
  179
  180makeIntervalsFromAllPoints([Start|Tail], TemporalDistance, QueryTime, Temp, L) :-
  181	findEndofInterval([Start|Tail], TemporalDistance, QueryTime, End, Rest),
  182	append(Temp, [(Start,End)], NewTemp),
  183	makeIntervalsFromAllPoints(Rest, TemporalDistance, QueryTime, NewTemp, L).
  184
  185	
  186findEndofInterval([LastTime], _TemporalDistance, LastTime, inf, []) :- !.
  187
  188findEndofInterval([End], TemporalDistance, _LastTime, NextEnd, []) :- 
  189	!, 
  190	% nextTimePoint
  191	NextEnd is End+TemporalDistance-(End mod TemporalDistance). 
  192
  193findEndofInterval([P1,P2|Tail], TemporalDistance, LastTime, NextP1, [P2|Tail]) :-
  194	Diff is P2-P1,
  195	Diff>TemporalDistance, !, 
  196	% nextTimePoint
  197	NextP1 is P1+TemporalDistance-(P1 mod TemporalDistance).
  198
  199findEndofInterval([P1,P2|Tail], TemporalDistance, LastTime, End, Rest) :-
  200	findEndofInterval([P2|Tail], TemporalDistance, LastTime, End, Rest)