2/*
    3Alexander Artikis
    4*/
    5
    6
    7/******************* Main predicate for union *******************/
    8
    9
   10union_all([], []) :- !.
   11
   12union_all([H|Tail], Union) :-
   13	union2(H, Tail, Union).
   14
   15
   16union2(List, [], List) :- !.
   17
   18union2(List, [H|Tail], FinalUnion) :-
   19	iset_union(List, H, TempUnion),
   20	union2(TempUnion, Tail, FinalUnion).
   21
   22
   23/******************* Main predicate for intersection *******************/
   24
   25
   26intersect_all(List, []) :- 
   27	member([], List), !.
   28
   29intersect_all([], []) :- !.
   30
   31intersect_all([H|Tail], Intersection) :-
   32	intersect(H, Tail, Intersection).
   33
   34
   35intersect(List, [], List) :- !.
   36
   37intersect(List, [H|Tail], FinalIntersection) :-
   38	iset_intersection(List, H, TempIntersection),
   39	intersect(TempIntersection, Tail, FinalIntersection).
   40
   41
   42/******************* Main predicate for relative complement *******************/
   43
   44
   45relative_complement_all(List, [], List) :- !.
   46
   47relative_complement_all([], _List, []) :- !.
   48
   49relative_complement_all(List, [H|Tail], FinalComplement) :-
   50	iset_difference(List, H, TempComplement),
   51	relative_complement_all(TempComplement, Tail, FinalComplement).
   52
   53
   54/******************* Main predicate for complement *******************/
   55
   56% complement is defined in terms of relative complement
   57% given the list of lists of intervals List 
   58% we compute the list of intervals NewI 
   59% such that  union_all([NewI|List], WM)  and  intersect_all([NewI|List], [])
   60complement_all(List, NewI) :-
   61	% retrieve InitTime from computer memory
   62	initTime(InitTime),
   63	(
   64		InitTime<0, NewInitTime is 0 
   65		;
   66		nextTimePoint(InitTime, NewInitTime)
   67	), !,
   68	% the intervals of this value of the fluent are simply computed by relative_complement_all
   69	relative_complement_all([(NewInitTime,inf)], List, NewI).
   70
   71
   72/************* Min-Max *********************/
   73
   74
   75max(X,Y,Y) :- geq(Y, X), !.
   76max(X,Y,X) :- geq(X, Y), !.
   77max(_X,inf,inf) :- !.
   78max(inf, _X, inf).
   79
   80min(X,Y,Y) :- geq(X, Y), !.
   81min(X,Y,X) :- geq(Y, X), !. 
   82min(X,inf,X) :- !.
   83min(inf,X,X).
   84
   85
   86gt(_X,inf) :- !, fail.
   87gt(inf,_Y) :- !.
   88gt(X,Y) :- X>Y.
   89%%% gt(X,Y) :- \+(Y=inf), X>Y.
   90
   91geq(_X,inf) :- !, fail.
   92geq(inf,_Y) :- !.
   93geq(X,Y) :- X>=Y.
   94
   95lt(inf,_Y) :- !, fail.
   96lt(_X, inf) :- !.
   97lt(X,Y) :- X<Y.
   98
   99leq(inf,_Y) :- !, fail.
  100leq(_X, inf) :- !.
  101leq(X,Y) :- X=<Y.
  102
  103/*
  104geq(inf,_Y) :- !.
  105geq(X,Y) :- \+(Y=inf), X>=Y.
  106
  107lt(_X, inf) :- !.
  108lt(X,Y) :- \+(X=inf), X<Y.
  109
  110leq(_X, inf) :- !.
  111leq(X,Y) :- \+(X=inf), X=<Y.
  112*/
  113
  114
  115/************* next & previous time-point *********************/
  116
  117% the next and previous time-points are defined based on 
  118% the temporal distance between two time-points
  119
  120nextTimePoint(inf, inf) :- !.
  121
  122nextTimePoint(T, NextT) :-
  123	temporalDistance(TD),
  124	NextT is T+TD-(T mod TD). 
  125
  126prevTimePoint(inf, inf) :- !.
  127prevTimePoint(T, PrevT) :-
  128	temporalDistance(TD),
  129	% test if T is a 'legal' time-point
  130	Temp is T mod TD, Temp=0, !,
  131	PrevT is T-TD. 
  132prevTimePoint(T, PrevT) :-
  133	temporalDistance(TD),
  134	PrevT is T-(T mod TD).
  135
  136
  137/************* Interval Library *********************/
  138/* 
  139The code below is a slightly modified version of intervals.pl from Carnegie Mellon.
  140Intervals are represented as (S,E) as opposed to S--E
  141(S,E) now means [S,E) as opposed to [S,E]
  142*/
  143
  144iset_intersection( _A, [], [] ) :- !.
  145
  146iset_intersection( [], _B, [] ) :- !.
  147
  148iset_intersection( [(A11,A12)|A2_n], [(B11,B12)|B2_n], IRest ) :-
  149    interval_is_less( [A11,A12], [B11,B12] ),
  150    iset_intersection( A2_n, [(B11,B12)|B2_n], IRest ), !.
  151
  152iset_intersection( [(A11,A12)|A2_n], [(B11,B12)|B2_n], IRest ) :-
  153    interval_is_less( [B11,B12], [A11,A12] ),
  154    iset_intersection( [(A11,A12)|A2_n], B2_n, IRest ), !.
  155
  156iset_intersection( [(A11,A12)|A2_n], [(B11,B12)|B2_n], [(I11,I12)|IRest] ) :-
  157    interval_intersection( [A11,A12], [B11,B12], [I11,I12] ),
  158    drop_lowest( [(A11,A12)|A2_n], [(B11,B12)|B2_n], A_Rest, B_Rest ),
  159    iset_intersection( A_Rest, B_Rest, IRest ).
  160
  161
  162interval_is_less( [_L1,U1], [L2,_U2] ) :-
  163    % U1 < L2, 
  164    leq(U1, L2), 
  165    !.
  166
  167
  168interval_intersection( [L1,U1], [L2,U2], [L3,U3] ) :-
  169    localmax( L1, L2, L3 ),
  170    localmin( U1, U2, U3 ).
  171
  172
  173drop_lowest( [I|A2_n], [I|B2_n], A2_n, B2_n ) :- !.
  174
  175drop_lowest( [(A11,A12)|A2_n], [(B11,B12)|B2_n], A2_n, [(B11,B12)|B2_n] ) :-
  176    interval_ends_first( [A11,A12], [B11,B12] ), !.
  177
  178drop_lowest( A, [_B1|B2_n], A, B2_n ).
  179
  180
  181localmax( A, B, A ) :- gt(A, B), !.
  182localmax( _A, B, B ).
  183
  184localmin( A, B, A ) :- lt(A, B), !.
  185localmin( _A, B, B ).
  186
  187interval_ends_first( [_,U1], [_,U2] ) :-
  188    %U1 < U2, 
  189    lt(U1, U2),
  190    !.
  191
  192
  193
  194
  195
  196iset_difference( A, [], A ) :- !.
  197
  198iset_difference( [], _B, [] ) :- !.
  199
  200iset_difference( [(A11,A12)|A2_n], [(B11,B12)|B2_n], [(A11,A12)|DRest] ) :-
  201    interval_is_less( [A11,A12], [B11,B12] ),
  202    iset_difference( A2_n, [(B11,B12)|B2_n], DRest ), !.
  203
  204iset_difference( [(A11,A12)|A2_n], [(B11,B12)|B2_n], DRest ) :-
  205    interval_is_less( [B11,B12], [A11,A12] ),
  206    iset_difference( [(A11,A12)|A2_n], B2_n, DRest ), !.
  207/*
  208iset_difference( [(A1_low,A1_high)|A2_n], [(B1_low,B1_high)|B2_n],
  209                 [(A1_low,B1_low_less_1) | D_Rest ]  ) :-
  210    % A1_low < B1_low,
  211    lt(A1_low, B1_low),
  212    !,
  213    B1_low_less_1 is B1_low - 1,
  214    iset_difference( [ (B1_low,A1_high) | A2_n ],
  215                     [ (B1_low,B1_high) | B2_n ],
  216                     D_Rest ), !.
  217*/
  218iset_difference( [(A1_low,A1_high)|A2_n], [(B1_low,B1_high)|B2_n],
  219                 [(A1_low,B1_low) | D_Rest ]  ) :-
  220    % A1_low < B1_low,
  221    lt(A1_low, B1_low),
  222    !,
  223    %%% B1_low_less_1 is B1_low - 1,
  224    iset_difference( [ (B1_low,A1_high) | A2_n ],
  225                     [ (B1_low,B1_high) | B2_n ],
  226                     D_Rest ), !.
  227
  228iset_difference( [(_A1_low,High)|A2_n], [(_B1_low,High)|B2_n], D ) :-
  229    iset_difference( A2_n, B2_n, D ), !.
  230/*
  231iset_difference( [(A1_low,A1_high)|A2_n], [(B1_low,B1_high)|B2_n], D ) :-
  232    %A1_high > B1_high,
  233    gt(A1_high, B1_high),
  234    !,
  235    B1_high_add_1 is B1_high + 1,
  236    iset_difference( [ (B1_high_add_1,A1_high) | A2_n ], B2_n, D ), !.
  237
  238iset_difference( [(A1_low,A1_high)|A2_n], [(B1_low,B1_high)|B2_n], D ) :-
  239    %A1_high < B1_high,
  240    lt(A1_high, B1_high),
  241    !,
  242    A1_high_add_1 is A1_high + 1,
  243    iset_difference( A2_n, [ (A1_high_add_1,B1_high) | B2_n ], D ), !.
  244*/
  245iset_difference( [(_A1_low,A1_high)|A2_n], [(_B1_low,B1_high)|B2_n], D ) :-
  246    %A1_high > B1_high,
  247    gt(A1_high, B1_high),
  248    !,
  249    %%% B1_high_add_1 is B1_high + 1,
  250    iset_difference( [ (B1_high,A1_high) | A2_n ], B2_n, D ), !.
  251
  252iset_difference( [(_A1_low,A1_high)|A2_n], [(_B1_low,B1_high)|B2_n], D ) :-
  253    %A1_high < B1_high,
  254    lt(A1_high, B1_high),
  255    !,
  256    %%% A1_high_add_1 is A1_high + 1,
  257    iset_difference( A2_n, [ (A1_high,B1_high) | B2_n ], D ), !.
  258
  259
  260
  261
  262
  263iset_union( A, [], A ) :- !.
  264
  265iset_union( [], B, B ) :- !.
  266
  267iset_union( [(A11,A12)|A2_n], [(B11,B12)|B2_n], [(B11,B12)|URest] ) :-
  268    interval_is_less_and_not_coalescable( [B11,B12], [A11,A12] ),
  269    iset_union( [(A11,A12)|A2_n], B2_n, URest ), !.
  270
  271iset_union( [(A11,A12)|A2_n], [(B11,B12)|B2_n], [(A11,A12)|URest] ) :-
  272    interval_is_less_and_not_coalescable( [A11,A12], [B11,B12] ),
  273    iset_union( A2_n, [(B11,B12)|B2_n], URest ), !.
  274
  275iset_union( [(A11,A12)|A2_n], [(B11,B12)|B2_n], U ) :-
  276    /*  A1 overlaps B1  */
  277    interval_union( [A11,A12], [B11,B12], [U11,U12] ),
  278    union_overlap( [U11,U12], A2_n, B2_n, U ).
  279
  280
  281interval_is_less_and_not_coalescable( [_L1,U1], [L2,_U2] ) :-
  282    %%% L2_less_1 is L2-1,
  283    %U1 < L2_less_1, 
  284    %%% lt(U1, L2_less_1),
  285    lt(U1, L2),
  286    !.
  287
  288
  289intervals_are_not_coalescable( I1, I2 ) :-
  290    interval_is_less_and_not_coalescable( I1, I2 ), !.
  291
  292intervals_are_not_coalescable( I1, I2 ) :-
  293    interval_is_less_and_not_coalescable( I2, I1 ), !.
  294
  295
  296intervals_are_coalescable( I1, I2 ) :-
  297    not( intervals_are_not_coalescable( I1, I2 ) ).
  298
  299
  300interval_union( [L1,U1], [L2,U2], [L3,U3] ) :-
  301    localmin( L1, L2, L3 ),
  302    localmax( U1, U2, U3 ).
  303
  304
  305union_overlap( [U11,U12], [(A11,A12)|A2_n], B, URest ) :-
  306    intervals_are_coalescable( [U11,U12], [A11,A12] ),
  307    interval_union( [U11,U12], [A11,A12], J ),
  308    union_overlap( J, A2_n, B, URest ), !.
  309
  310union_overlap( [U11,U12], A, [(B11,B12)|B2_n], URest ) :-
  311    intervals_are_coalescable( [U11,U12], [B11,B12] ),
  312    interval_union( [U11,U12], [B11,B12], J ),
  313    union_overlap( J, A, B2_n, URest ), !.
  314
  315union_overlap( [U11,U12], A, B, [(U11,U12)|URest] ) :-
  316    iset_union( A, B, URest ), !.
  317
  318
  319
  320
  321
  322/********* THE PREDICATES BELOW ARE OBSOLETE *************/
  323
  324/*
  325Convert a list of lists of intervals [[(S11,E11), (S12,E12), ...], [(S21, E21), (S22, E22), ...], ...]
  326to a list of lists of intervals [[S11--E11, S12--E12, ...], [S21--E21, S22--E22, ...], ...] 
  327The latter representation is used in the file intervals.pl
  328
  329convertToDDashAll( +List, -List, [] )
  330*/
  331/*
  332convertToDDashAll( [], OL, OL ) :- !.
  333
  334convertToDDashAll( IL, CIL, Aux ) :-
  335  IL=[H|Tail],
  336  convertToDDash( H, CH, [] ),
  337  append( Aux, [CH], NewAux ),
  338  convertToDDashAll( Tail, CIL, NewAux ).
  339
  340:- op( 31, xfx, -- ).
  341*/
  342/*
  343Convert a list of intervals [(S1, E1), (S2, E2), ...]
  344to a list of intervals [S1--E1, S2--E2, ...]
  345The latter representation is used in the file intervals.pl
  346
  347convertToDDash( +List, -List, [] )
  348*/
  349/*
  350convertToDDash( [], OL, OL ) :- !.
  351	
  352convertToDDash( IL, OL, Aux ) :- 
  353  IL=[(S,E)|Tail],
  354  \+ E = inf, 
  355  !,
  356  NewE is E-1,
  357  append( Aux, [S--NewE], NewAux ),
  358  convertToDDash( Tail, OL, NewAux ).
  359
  360convertToDDash( IL, OL, Aux ) :- 
  361  IL=[(S,inf)|Tail],
  362  append( Aux, [S--inf], NewAux ),
  363  convertToDDash( Tail, OL, NewAux ).
  364*/
  365
  366
  367
  368/*
  369Convert a list of intervals [S1--E1, S2--E2, ...]
  370to a list of intervals [(S1, E1), (S2, E2), ...]
  371
  372revertToSE( +List, -List, [] )
  373*/
  374/*
  375revertToSE( [], OL, OL ) :- !.
  376
  377revertToSE( IL, OL, Aux ) :- 
  378  IL=[H|Tail],
  379  H=S--E,
  380  \+ E = inf, 
  381  !,
  382  NewE is E+1,
  383  append( Aux, [(S, NewE)], NewAux ),
  384  revertToSE( Tail, OL, NewAux ).
  385
  386revertToSE( IL, OL, Aux ) :- 
  387  IL=[H|Tail],
  388  H=S--inf,
  389  append( Aux, [(S, inf)], NewAux ),
  390  revertToSE( Tail, OL, NewAux ).
  391*/