interval-boole.pl

    1:- module(iboole, [i_boole/2]).    2
    3/*--------------------------------------------
    4	syntax checking of intervals.
    5--------------------------------------------*/
    6
    7% ?- i_normal([inf-sup, sup-inf, 3], R).
    8%@ R = [inf-3].
    9% ?- i_normal([3], R).
   10% ?- i_normal([3-2], R).
   11
   12i_normal(X, Y):- i_normal(X, X0, []),
   13	predsort(i_compare, X0, X1),
   14	once(i_merge(X1, Y)).
   15%
   16i_normal([], P, P).
   17i_normal([X|Y], P, Q):- i_check(X, P, R), !, i_normal(Y, R, Q).
   18%
   19i_check(X-Y, P, Q):- nonvar(X), nonvar(Y),
   20	i_leaf(X), i_leaf(Y),
   21	i_check(X, Y, P, Q),
   22	!.
   23i_check(X, [X-X|P], P):- integer(X).
   24
   25%
   26i_check(inf, inf, P, P).
   27i_check(sup, sup, P, P).
   28i_check(X, Y, P, Q):- once(i_add_one(X-Y, P, Q)).
   29
   30%
   31i_leaf(sup).
   32i_leaf(inf).
   33i_leaf(X):- integer(X).
   34%
   35
   36i_compare(=, U, U)  :- !.
   37i_compare(C , X-Y, Z-U)  :-  x_compare(C0, X, Z),
   38	(	C0 = (=) -> once(x_compare(C, Y, U))
   39 	;	C = C0
   40	).
   41%
   42x_compare(=, X, X).
   43x_compare(<, _, sup).
   44x_compare(>, sup, _).
   45x_compare(>, _, inf).
   46x_compare(<, inf, _).
   47x_compare(C, X, Y) :- compare(C, X, Y).
   48
   49% ?- i_sort([1-1], R).
   50% ?- i_sort([2-2,1-1], R).
   51% ?- i_sort([10-sup,inf-9], R).
   52i_sort(X, Y):- predsort(i_compare, X, Y).
   53
   54/*--------------------------------------------
   55	glue intervals into one when no integer
   56	between them.
   57--------------------------------------------*/
   58% ?- i_glue(inf-9, 10-sup, R).
   59% ?- i_glue(inf-inf, 10-sup, R).
   60% ?- i_glue(10-sup, 10-sup, R).
   61i_glue(inf-inf, Intvl, Intvl):-!.
   62i_glue(Intvl, sup-sup, Intvl):-!.
   63i_glue(X-Y, Z-U, X-V):-	x_compare(C, Y, Z),
   64	(	C = (=) -> 	V = U
   65	;	C = (<), i_succ(Y, Z) -> V = U
   66	;	C = (>) -> i_max(Y, U, V)
   67	).
   68%
   69i_lt(X, Y):- integer(X), integer(Y), !, X < Y.
   70i_lt(inf, X):-!, X \== inf.
   71i_lt(X, sup):- X \== sup.
   72
   73%
   74i_gt(X, Y):- integer(X), integer(Y), !, X > Y.
   75i_gt(sup, X):-!, X \== sup.
   76i_gt(X, inf):- X \== inf.
   77%
   78i_max(_, sup, sup).
   79i_max(sup, _, sup).
   80i_max(inf, X, X).
   81i_max(X, inf, X).
   82i_max(X, Y, X):- X > Y.
   83i_max(_, Y, Y).
   84
   85%
   86i_min(X, sup, X).
   87i_min(sup, X, X).
   88i_min(_, inf, inf).
   89i_min(inf, _, inf).
   90i_min(X, Y, X):- X < Y,!.
   91i_min(_, Y, Y).
   92
   93%  ?- i_on(-2, inf- sup).
   94%  X : integer.
   95%  Use for the future ?
   96on_interval(X, A - B):-
   97	(	A == inf, !
   98	;	integer(A), A =< X
   99	),
  100	(	B == sup, !
  101	;	integer(B), X =< B
  102	).
  103
  104% ?- i_succ(1,X).
  105% ?- i_succ(X,2).
  106% ?- i_succ(sup,X).
  107i_succ(sup, sup).
  108i_succ(inf, inf).
  109i_succ(X, Y):- integer(X), !, Y is X + 1.
  110i_succ(X, Y):- integer(Y), X is Y - 1.
  111
  112/*--------------------------------------------
  113	Boolean operations on sets of intergers
  114	represented as a list of characters
  115	and intervals of characters,
  116	e.g, [a, c-k, u, x-z].
  117--------------------------------------------*/
  118% ?-  i_boole([^, 3-5],  R).
  119% ?-  i_boole(\+ ([3-5]),  R).
  120% ?-  i_boole([3-5];[4-8],  R).
  121% ?-  i_boole(&([1-10],  ([3-5]|[4-8, 8-12])),  R).
  122% ?-  i_boole(([1-10],  ([3-5]|[4-8, 8-12])),  R).
  123
  124i_boole(normal(X), Y):-!, i_normal(X, Y).
  125i_boole(dot(X), Y)	:-!, i_boole(X, Y).
  126i_boole(out(X), Y)	:-!, i_boole(X, X0), i_neg(X0, Y).
  127i_boole(^(X), Y)	:-!, i_boole(out(X), Y).
  128i_boole(\+(X), Y)	:-!, i_boole(out(X), Y).
  129i_boole((X|Y), Z)	:-!, i_boole(X, X0),
  130	i_boole(Y, Y0),
  131	i_cup(X0, Y0, Z).
  132i_boole((X;Y), Z)	:-!, i_boole((X|Y), Z).
  133i_boole(&(X,Y), Z)	:-!, i_boole(X, X0),
  134	i_boole(Y, Y0),
  135	i_cap(X0, Y0, Z).
  136i_boole((X,Y), Z)	:-!, i_boole(&(X, Y), Z).
  137i_boole(\(X,Y), Z)	:-!, i_boole(X, X0),
  138	i_boole(Y, Y0),
  139	i_subtract(X0, Y0, Z).
  140i_boole(X, X).
  141
  142%
  143i_add([], P, P).
  144i_add([X|Xs], P, Q):- i_add_one(X, P, R),!,
  145	i_add(Xs, R, Q).
  146
  147%
  148i_add_one(X-Y, P, P):- integer(X), integer(Y), Y < X.
  149i_add_one(_-inf, P, P).
  150i_add_one(sup-_, P, P).
  151i_add_one(X, [X|P], P).
  152
  153% ?- i_cap([1-10],[3-6, 8-8], R).
  154i_cap(X, Y, P):- once(i_cap(X, Y, P, [])).
  155%
  156i_cap([], _, P, P).
  157i_cap(_, [], P, P).
  158i_cap([X|Xs],[Y|Ys], P, Q):- i_cap(X, Y, NXs, Xs, NYs, Ys, P, R), !,
  159	i_cap(NXs, NYs, R, Q).
  160%
  161i_cap(LX-RX, LY-RY, P, Q, R, S, T, U):-
  162	i_max(LX, LY, Min),
  163	i_min(RX, RY, Max),
  164	i_succ(RY, Y0),
  165	i_succ(RX, X0),
  166	i_add_one(Y0-RX, P, Q),
  167	i_add_one(X0-RY, R, S),
  168	i_add_one(Min-Max, T, U).
  169
  170%  union of two intervals sets.
  171% ?- i_cup([1-5, 7-10], [6-6], R).
  172i_cup([], Y, Y).
  173i_cup(X, [], X).
  174i_cup(X, Y, Z):- select_smaller(S, X, Y, X0, Y0),
  175	once(i_cup(S, X0, Y0, Z)).
  176%
  177i_cup(X, [], Y, Z):- i_cup_one(X, Y, Z).
  178i_cup(X, Y, [], Z):- i_cup_one(X, Y, Z).
  179i_cup(X, As, Bs, Z):- select_smaller(Y, As, Bs, Cs, Ds),
  180	i_cup(X, Y, Cs, Ds, Z).
  181%
  182i_cup(X-X0, Y-Y0, As, Bs, [X-X0|Z]):-  i_off(X0, Y), !,
  183	i_cup(Y-Y0, As, Bs, Z).
  184i_cup(X-X0, _-Y0, As, Bs, Z):- i_max(X0, Y0, M), !,
  185	once(i_cup(X-M, As, Bs, Z)).
  186%
  187i_cup_one(X, [], [X]).
  188i_cup_one(X-X0, [Y-Y0|Ys], [X-X0, Y-Y0|Ys]):- i_off(X0, Y), !.
  189i_cup_one(X-X0, [_-Y0|Ys], Z):- i_max(X0, Y0, M),
  190	i_cup_one(X-M, Ys, Z).
  191
  192% ?- i_subtract([1-10],[3-6], R).
  193% R = [1-2,7-10]
  194%  Remark:  i_subtract(X,Y,Z):- i_neg(Y, Y0), i_cap(X, Y0, Z).
  195i_subtract(X, Y, Z):- i_subtract(X, Y, Z, []), !.
  196
  197%
  198i_subtract([], _, P, P).
  199i_subtract(X, [], P, Q):- append(X, Q, P).
  200i_subtract([LX-RX|Xs], [LY-RY|Ys], P, Q):-
  201    i_succ(RY, RY0),
  202	i_succ(LY0, LY),
  203	i_succ(RX, RX0),
  204	i_add_one(LX-LY0, P, R),
  205	i_add_one(RY0-RX, NXs, Xs),
  206	i_add_one(RX0-RY, NYs, Ys),
  207	i_subtract(NXs, NYs, R, Q).
  208
  209% computing the complement of intervals.
  210% ?- i_neg([3-5, 7-9], R).
  211% R = [inf-2,6,10-sup]
  212
  213i_neg(X, Y):- once(i_neg(inf, X, Y, [])).
  214%
  215i_neg(W, [], P, Q):- i_add_one(W-sup, P, Q).
  216i_neg(W, [X-Y|Z], P, Q):-
  217	i_succ(X0, X),
  218	i_succ(Y, Y0),
  219	i_add_one(W-X0, P, R),
  220	i_neg(Y0, Z, R, Q).
  221
  222% ?- i_merge([9-9, 10-10], X).
  223% ?- i_merge([inf-9, 10-sup], X).
  224% ?- i_merge([inf-inf, sup-sup], X).
  225% ?- i_merge([1-2, 3-4, 5-6], X).
  226
  227i_merge([], []):-!.
  228i_merge([_-inf|U], V):-!, i_merge(U, V).
  229i_merge([sup-_|U], V):-!, i_merge(U, V).
  230i_merge([X], [X]):-!.
  231i_merge([A, B|U], V):- i_glue(A, B, C), !, i_merge([C|U], V).
  232i_merge([A, B|U], V):- i_glue(A, B, C), !, i_merge([C|U], V).
  233i_merge([A, B|U], [A|V]):- i_merge([B|U], V).
  234
  235% ?- i_partition([1-3], [2-2], X).
  236% ?- i_partition([1-3], [2-4], X).
  237% ?- i_partition([1-3], [2-4], X).
  238% ?- i_partition([inf-sup], [-3 - -3, -2 - -2, -1 - -1],  X).
  239i_partition(X, Y, Z):- once(i_partition(X, Y, Z, [])).
  240
  241%
  242i_partition([], _, P, P).
  243i_partition(X, [], P, Q):- append(X, Q, P).
  244i_partition([LX-RX|Xs], [_-RY|Ys], P, Q):-  i_lt(RY, LX), !,
  245	i_partition([LX-RX|Xs], Ys, P, Q).
  246i_partition([LX-RX|Xs], [LY-RY|Ys], [LX-RX|P], Q):-  i_lt(RX, LY), !,
  247	i_partition(Xs, [LY-RY|Ys], P, Q).
  248i_partition([LX-RX|Xs], [LY-RY|Ys], P, Q):-
  249	i_max(LX, LY, L),
  250	i_min(RX, RY, R),
  251	i_succ(L0, L),
  252	i_add([LX-L0, L-R], P, P0),
  253	i_succ(RX, RX0),
  254	i_add_one(RX0-RY, NYs, Ys),
  255	i_succ(RY, RY0),
  256	i_add_one(RY0-RX, NXs, Xs),
  257	i_partition(NXs, NYs, P0, Q).
  258
  259% ?- m_partition([[1-5],[3-6]],R).
  260% R = [[1-2,3-5],[3-5,6-6]]
  261% ?- m_partition([[1-2, 3-5],[3-6]],R).
  262%@ R = [[1-2, 3-5], [3-5, 6-6]] .
  263% ?- m_partition([[1-2, 4-5],[3-6]],R).
  264% ?- m_partition([[1-2, 3-5],[inf-5, 8-sup]],R).
  265%@ R = [[1-2, 3-5], [inf-0, 1-2, 3-5, 8-sup]]
  266
  267m_partition([], []).
  268m_partition([X|Y], [X0|Z]):- m_partition(Y, Z0),
  269	once(m_partition(X, Z0, X0, Z)).
  270%
  271m_partition(X, [], X, []).
  272m_partition(X, [Y|Z],  X1, [Y0|V]):-
  273	m_partition_one(X, Y, X0, Y0),
  274	m_partition(X0, Z, X1, V).

?- m_partition_one([1-5], [2-7], X, Y). X = [1-1,2-5], Y = [2-5,6-7]

  280m_partition_one(X, Y, Z, U):- once(m_partition_one(X, Y, Z, [], U, [])).
  281
  282%
  283m_partition_one([], Y, P, P, Q, R):- append(Y, R, Q).
  284m_partition_one(X, [], P, Q, R, R):- append(X, Q, P).
  285m_partition_one([LX-RX|Xs], [LY-RY|Ys], P, Q, [LY-RY|U], V):- i_lt(RY, LX), !,
  286	m_partition_one([LX-RX|Xs], Ys, P, Q, U, V).
  287m_partition_one([LX-RX|Xs], [LY-RY|Ys], [LX-RX|P], Q, U, V):- i_lt(RX, LY), !,
  288	m_partition_one(Xs, [LY-RY|Ys], P, Q, U, V).
  289m_partition_one([LX-RX|Xs], [LY-RY|Ys], P, Q, U, V):- i_max(LX, LY, L),
  290	i_min(RX, RY, R),
  291	i_succ(L0, L),
  292	i_add([LX-L0, L-R], P, P0),
  293	i_succ(RX, RX0),
  294	i_add_one(RX0-RY, NYs, Ys),
  295	i_succ(RY, RY0),
  296	i_add_one(RY0-RX, NXs, Xs),
  297	i_add([LY-L0, L-R], U, U0),
  298	m_partition_one(NXs, NYs, P0, Q, U0, V).
  299%
  300i_off(X, Y):- integer(X), !,
  301			  (	integer(Y) -> Y > X+1
  302			  ;	Y == sup
  303			  ).
  304i_off(inf, X):-!, X \== inf.
  305i_off(X, sup):- X \== sup.
  306
  307%
  308select_smaller(C, [A|As], [B|Bs], X, Y) :- i_compare(P, A, B), !,
  309	  (  P == (=) -> C=A, X=As, Y=Bs
  310	  ;  P == (<) -> C=A, X=As, Y=[B|Bs]
  311	  ;  C = B, X = [A|As], Y = Bs
  312	  ).

?- keymerge([a-1,a-2,b-3,c-4,c-5], R). R = [a-[1,2],b-[3],c-[4,5]]

  318keymerge([], []).
  319keymerge([A-X|R],  [A-[X|P]|R0]):- keymerge(A, R, P, [], S), !,
  320	keymerge(S, R0).
  321%
  322keymerge(A, [A-X|R], [X|P], Q, S):- keymerge(A, R, P, Q,  S), !.
  323keymerge(_, R, P, P, R).
  324
  325% ?- iboole:keymerge_r([1-a,2-a,3-b,4-c,5-c], R).
  326% R = [[1,2]-a,[3]-b,[4,5]-c]
  327
  328keymerge_r([], []).
  329keymerge_r([X-A|R],  [[X|P]-A|R0]):- keymerge_r(A, R, P, [], S), !,
  330	keymerge_r(S, R0).
  331%
  332keymerge_r(A, [X-A|R], [X|P], Q, S):- keymerge_r(A, R, P, Q,  S), !.
  333keymerge_r(_, R, P, P, R)