[Xsb-commits] CVS: xsbtests/sub_table_tests abol_test.P, NONE, 1.1 abol_test2.P, NONE, 1.1 abol_tes

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Update of /cvsroot/xsb/xsbtests/sub_table_tests
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv3992

Added Files:
	abol_test.P abol_test2.P abol_test2_module.P abol_test2_old 
	abol_test2a.P abol_test2a_old abol_test3.P abol_test3_old 
	abol_test3a.P abol_test3a_old abol_test3b.P abol_test3b_old 
	abol_test3c.P abol_test3c_old abol_test_old abolish_cascade.P 
	abolish_cascade_old abolish_cascade_pred.P 
	abolish_cascade_pred_old aggregs1_test.P aggregs_test.P 
	aggregs_test_old atc_test.P atc_test_old bug.P bugtest.P 
	bulk_trie_test_old cantrdat.P concomp.P concomp_old correct.P 
	cycle.P dipti.P dipti_old edge_dag.P empty_answer.P 
	empty_answer_old exec.P expand.P expand_old float.P float1.P 
	float_old flora1.P flora1_old grammarlrk3.P grammarlrk3_old 
	incremental.P incremental_old kalah_ox.P lists.P lrbug.P 
	lrbug_old makefile.P makefile_old pps.P pps_old 
	recursive_aboltest.P recursive_aboltest_old sets.P stest.sh 
	testdyntable.P testdyntable_old testh.P testh_old tfinda.P 
	tfinda_old trdat.P unw_tr1.P unw_tr1_old utils.P 
Log Message:

Adding a copy of table_tests to be used for testing the subsumptive engine.
This includes a number of miscellaneous tests, and more importantly table reclamation and garbage collection tests.

--- NEW FILE: abol_test.P ---
%-------------------------------------------------------------------------
% Created by Kostis Sagonas to test the basic functionality of tabling
% built-in predicates abolish_table_pred/1.
%-------------------------------------------------------------------------

:- import numbervars/1 from num_vars.
:- import get_calls/3, abolish_table_pred/1, abolish_table_call/1 from tables.

arc(1,2).
arc(2,3).
arc(2,4).
arc(4,1).

:- table path/2.

path(X,Y) :- arc(X,Y).
path(X,Y) :- path(X,Z), arc(Z,Y).

% test case with no calls first
test :- abolish_table_pred(path(_,_)), fail.
% create completed tables
test :- path(_X,_Y), fail.
test :- path(1,_), fail.
test :- path(1,4), fail.
test :- path(_X,4), fail.
% inspect these tables while selecively deleting some of them
test :- print(1,0), fail.
% STUFF FOR abolish_table_call/1 to be added here
% test :- print(1,1), fail.
test :- abolish_table_pred(path/2), fail.
test :- print(1,2), fail.
% create some more and test the other mode of calling
test :- path(1,_), fail.
test :- path(1,4), fail.
test :- print(2,0), fail.
% STUFF FOR abolish_table_call/1 to be added here
% test :- print(2,1), fail.
test :- abolish_table_pred(path(_,_)), fail.
test :- print(2,2), fail.
test.

print(N,M) :-
	get_calls(path(X,Y),_C,_R),
	write(N), write('.'), write(M), write(' '),
	numbervars(path(X,Y)), writeln(path(X,Y)),
	fail.
print(_,_).

--- NEW FILE: abol_test2.P ---

arc(1,2).
arc(2,3).
arc(2,4).
arc(4,1).

:- table upath/2.

upath(X,Y) :- arc(X,Y).
upath(X,Y) :- upath(X,Z), arc(Z,Y).

:- import mpath/2 from abol_test2_module.
:- import abolish_module_tables/1 from tables.

test:- upath(1,_),fail.
test:- mpath(1,_),fail.
test:- get_residual(upath(1,Y),_),writeln(answer(u(a,Y))),fail.
test:- get_residual(mpath(1,Y),_),writeln(answer(m(a,Y))),fail.
test:- writeln('-------'),fail.
test:- abolish_module_tables(abol_test2_module),fail.
test:- get_residual(upath(1,Y),_),writeln(answer(u(b,Y))),fail.
test:- get_residual(mpath(1,Y),_),writeln(answer(m(b,Y))),fail.
test:- abolish_module_tables(usermod),fail.
test:- writeln('-------'),fail.
test:- get_residual(upath(1,Y),_),writeln(answer(u(c,Y))),fail.
test:- get_residual(mpath(1,Y),_),writeln(answer(m(c,Y))),fail.
test:- gc_tables(N),writeln(remaining(N)).

--- NEW FILE: abol_test2_module.P ---

:- export mpath/2.
:- import arc/2 from usermod.

:- table mpath/2.

mpath(X,Y) :- arc(X,Y).
mpath(X,Y) :- mpath(X,Z), arc(Z,Y).

--- NEW FILE: abol_test2_old ---
-------

-------

answer(m(a,1))

answer(m(a,2))

answer(m(a,3))

answer(m(a,4))

answer(u(a,1))

answer(u(a,2))

answer(u(a,3))

answer(u(a,4))

answer(u(b,1))

answer(u(b,2))

answer(u(b,3))

answer(u(b,4))

remaining(0)

--- NEW FILE: abol_test2a.P ---

arc(1,2).
arc(2,3).
arc(2,4).
arc(4,1).

:- table upath/2.

upath(X,Y) :- arc(X,Y).
upath(X,Y) :- upath(X,Z), arc(Z,Y).

:- import mpath/2 from abol_test2_module.
:- import abolish_module_tables/1 from tables.

test:- upath(1,_),fail.
test:- mpath(1,_),fail.
test:- mpath(1,X),abolish_module_tables(abol_test2_module),fail.
test:- abolish_module_tables(abol_test2_module),fail.
test:- upath(1,_),abolish_module_tables(usermod),fail.
test:- get_residual(upath(1,Y),_),writeln(answer(u(a,Y))),fail.
test:- get_residual(mpath(1,Y),_),writeln(answer(m(a,Y))),fail.
test:- gc_tables(N),write(remaining(N)),fail.
test.

--- NEW FILE: abol_test2a_old ---
remaining(0)

--- NEW FILE: abol_test3.P ---

/* Tests DTF creation and garbage collection of two tables for the
 same predicate. */

:- table tpred/1.

tpred(X):- p(X).

p(f(1)).
p(f(2)).
p(f(3)).
p(g(1)).
p(g(2)).
p(g(3)).

%------------------
:- dynamic tr/1.
:- index(tr/1,trie).

test:- assert(tr(a)),assert(tr(b)),assert(tr(c)),fail.

test:- tpred(_X),fail.
test:-  tpred(X),tr(Y),
	abolish_table_pred(tpred/1),
	writeln((X,Y)),fail.

test:- tpred(_X),fail.
test:-  tpred(X),tr(Y),
	abolish_table_pred(tpred/1),
	fail.

test:- get_residual(tpred(X),_),writeln(first(X)),fail.
test:- gc_tables(N),writeln(remaining(N)).

--- NEW FILE: abol_test3_old ---
(g(3)  ','  c)
(g(3)  ','  b)
(g(3)  ','  a)
(g(2)  ','  c)
(g(2)  ','  b)
(g(2)  ','  a)
(g(1)  ','  c)
(g(1)  ','  b)
(g(1)  ','  a)
(f(3)  ','  c)
(f(3)  ','  b)
(f(3)  ','  a)
(f(2)  ','  c)
(f(2)  ','  b)
(f(2)  ','  a)
(f(1)  ','  c)
(f(1)  ','  b)
(f(1)  ','  a)
remaining(0)

--- NEW FILE: abol_test3a.P ---

/* Tests DTF creation and garbage collection of two tables for
different predicates. */

:- table tpred/1.
tpred(X):- p(X).

:- table upred/1.
upred(X):- p(X).

p(f(1)).
p(f(2)).
p(f(3)).
p(g(1)).
p(g(2)).
p(g(3)).

%------------------
:- dynamic tr/1.
:- index(tr/1,trie).

test:- assert(tr(a)),assert(tr(b)),assert(tr(c)),fail.

test:- tpred(_X),fail.
test:-  tpred(X),tr(Y),
	abolish_table_pred(tpred/1),
	writeln((X,Y)),fail.

test:- upred(_X),fail.
test:-  upred(X),tr(Y),
	abolish_table_pred(upred/1),
	fail.

test:- get_residual(tpred(X),_),writeln(first(X)),fail.
test:- get_residual(upred(X),_),writeln(first(X)),fail.
test:- gc_tables(N),writeln(remaining(N)).

--- NEW FILE: abol_test3a_old ---
(f(1)  ','  a)

(f(1)  ','  b)

(f(1)  ','  c)

(f(2)  ','  a)

(f(2)  ','  b)

(f(2)  ','  c)

(f(3)  ','  a)

(f(3)  ','  b)

(f(3)  ','  c)

(g(1)  ','  a)

(g(1)  ','  b)

(g(1)  ','  c)

(g(2)  ','  a)

(g(2)  ','  b)

(g(2)  ','  c)

(g(3)  ','  a)

(g(3)  ','  b)

(g(3)  ','  c)

remaining(0)

--- NEW FILE: abol_test3b.P ---

/* Tests DTF creation and garbage collection of two tables for
different predicates. */

:- table tpred/1.
tpred(X):- p(X).

:- table upred/1.
upred(X):- p(X).

p(f(1)).
p(f(2)).
p(f(3)).
p(g(1)).
p(g(2)).
p(g(3)).

%------------------
:- dynamic tr/1.
:- index(tr/1,trie).

test:- assert(tr(a)),assert(tr(b)),assert(tr(c)),fail.

test:- tpred(_X),fail.
test:-  tpred(X),tr(Y),
	abolish_table_pred(tpred/1),
	writeln((X,Y)),fail.

test:- upred(_X),fail.
test:-  upred(X),tr(Y),
	abolish_table_pred(upred/1),
	fail.

test:- upred(_),fail.
test:- get_residual(tpred(X),_),writeln(first(X)),fail.
test:- get_residual(upred(X),_),writeln(first(X)),fail.
test:- gc_tables(N),writeln(remaining(N)),fail.
test:- get_residual(upred(X),_),writeln(first(X)),fail.
test.

--- NEW FILE: abol_test3b_old ---
(f(1)  ','  a)

(f(1)  ','  b)

(f(1)  ','  c)

(f(2)  ','  a)

(f(2)  ','  b)

(f(2)  ','  c)

(f(3)  ','  a)

(f(3)  ','  b)

(f(3)  ','  c)

(g(1)  ','  a)

(g(1)  ','  b)

(g(1)  ','  c)

(g(2)  ','  a)

(g(2)  ','  b)

(g(2)  ','  c)

(g(3)  ','  a)

(g(3)  ','  b)

(g(3)  ','  c)

first(f(1))

first(f(1))

first(f(2))

first(f(2))

first(f(3))

first(f(3))

first(g(1))

first(g(1))

first(g(2))

first(g(2))

first(g(3))

first(g(3))

remaining(0)

--- NEW FILE: abol_test3c.P ---

/* Tests DTF creation and garbage collection of two tables for
different predicates, when one of the predicates has a valid table.*/

:- table tpred/1.
tpred(X):- p(X).

:- table upred/1.
upred(X):- p(X).

p(f(1)).
p(f(2)).
p(f(3)).
p(g(1)).
p(g(2)).
p(g(3)).

%------------------
:- dynamic tr/1.
:- index(tr/1,trie).

test:- assert(tr(a)),assert(tr(b)),assert(tr(c)),fail.

test:- tpred(_X),fail.
test:-  tpred(X),tr(Y),
	abolish_table_pred(tpred/1),
	writeln((X,Y)),fail.

test:- upred(_X),fail.
test:-  upred(X),tr(Y),
	abolish_table_pred(upred/1),
	fail.
%test:- writeln('-------'),fail.

test:- upred(X),abolish_table_pred(upred/1),gc_tables(N),
	writeln(remaining1(N)),fail.
test:- gc_tables(N),writeln(remaining2(N)),fail.
test.

end_of_file.

test:- upred(X),writeln(X),abolish_table_pred(upred/1),
	gc_tables(N),
	fail.

--- NEW FILE: abol_test3c_old ---
(f(1)  ','  a)

(f(1)  ','  b)

(f(1)  ','  c)

(f(2)  ','  a)

(f(2)  ','  b)

(f(2)  ','  c)

(f(3)  ','  a)

(f(3)  ','  b)

(f(3)  ','  c)

(g(1)  ','  a)

(g(1)  ','  b)

(g(1)  ','  c)

(g(2)  ','  a)

(g(2)  ','  b)

(g(2)  ','  c)

(g(3)  ','  a)

(g(3)  ','  b)

(g(3)  ','  c)

remaining1(0)

remaining1(1)

remaining1(1)

remaining1(1)

remaining1(1)

remaining1(1)

remaining2(0)

--- NEW FILE: abol_test_old ---
1.0 path(A,B)
2.0 path(1,A)

--- NEW FILE: abolish_cascade.P ---
:- import find_components/1, find_forward_dependencies/1, find_backward_dependencies/1, 
	find_answers/1
from tables.

test:- p1(_,_,_),p1(a,b,_),s,abolish_table_call(undefined),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p1(_,_,_),p1(_,_,_),s,abolish_table_call(undefined),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p1(_,_,_),s,abolish_table_call(undefined),abolish_table_call(p1(_,_,_)),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
%test:- p1(_,_,_),p1(_,_,_),s,abolish_table_call(undefined,[abolish_tables_singly]),fail.
%test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
%test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p2(_,_,_),abolish_table_call(r2(_,_,_)),abolish_table_call(r3(_,_,_)),fail.
test:- get_residual(p2(A,B,C),F),writeln(get_residual(p2(A,B,C),F)),fail.
test:- get_residual(r2(A,B,C),F),writeln(get_residual(r2(A,B,C),F)),fail.
test:- get_residual(r3(A,B,C),F),writeln(get_residual(r3(A,B,C),F)),fail.
test:- writeln('cascading abolish test completed').

:- table p1/3, r1/3, undefined/0.
p1(X,Y,Z):- r1(X,Y,Z).

r1(a,b,c):- undefined.
r1(a,b,d):- undefined.
r1(a,c,c):- undefined.
r1(a,c,d):- undefined.
r1(b,c,d):- undefined.
r1(b,c,e):- undefined.
r1(c,c,e):- undefined.
r1(d,c,e):- undefined.
r1(3,c,e):- undefined.
r1(f,c,e):- undefined.
r1(g,c,e):- undefined.
r1(h,c,e):- undefined.
r1(i,c,e):- undefined.

%undefined :- tnot(undefined).

:- table s/0,t/0.
s:- tnot(t).

t:- tnot(undefined).

:- table p2/3,  r2/3,  r3/3.
p2(X,Y,Z):- r2(X,Y,Z).
p2(X,Y,Z):- r3(X,Y,Z).

r2(a,b,c):- undefined.
r2(a,b,d):- undefined.
r2(a,c,c):- undefined.
r2(a,c,d):- undefined.
r2(b,c,d):- undefined.
r2(b,c,e):- undefined.
r2(c,c,e):- undefined.

r3(d,c,e):- undefined.
r3(3,c,e):- undefined.
r3(f,c,e):- undefined.
r3(g,c,e):- undefined.
r3(h,c,e):- undefined.
r3(i,c,e):- undefined.

--- NEW FILE: abolish_cascade_old ---
cascading abolish test completed
--- NEW FILE: abolish_cascade_pred.P ---
:- import find_components/1, find_forward_dependencies/1, find_backward_dependencies/1, 
	find_answers/1
from tables.

init:- p1(_,_,_),p1(a,_,_),s.

test:- p1(_,_,_),p1(a,b,_),s,abolish_table_pred(undefined),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p1(_,_,_),p1(_,_,_),abolish_table_pred(undefined),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p1(_,_,_),s,abolish_table_pred(undefined),abolish_table_pred(p1(_,_,_)),fail.
test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
%test:- p1(_,_,_),p1(_,_,_),s,abolish_table_pred(undefined,[abolish_tables_singly]),fail.
%test:- get_residual(p1(A,B,C),D),writeln(get_residual(p1(A,B,C),D)),fail.
%test:- get_residual(s,F),writeln(get_residual(s,F)),fail.
test:- p2(_,_,_),abolish_table_pred(r2(_,_,_)),abolish_table_pred(r3(_,_,_)),fail.
test:- get_residual(p2(A,B,C),F),writeln(get_residual(p2(A,B,C),F)),fail.
test:- get_residual(r2(A,B,C),F),writeln(get_residual(r2(A,B,C),F)),fail.
test:- get_residual(r3(A,B,C),F),writeln(get_residual(r3(A,B,C),F)),fail.
test:- writeln('cascading abolish test completed').

test_fc(X):- 
	call(X),
	find_components(X).

test_bd(X):- 
	call(X),
	find_backward_dependencies(X).

test_ans(X):-
	(call(X),fail ; true),
	find_answers(X).

:- table p1/3, r1/3, undefined/0.
p1(X,Y,Z):- r1(X,Y,Z).

r1(a,b,c):- undefined.
r1(a,b,d):- undefined.
r1(a,c,c):- undefined.
r1(a,c,d):- undefined.
r1(b,c,d):- undefined.
r1(b,c,e):- undefined.
r1(c,c,e):- undefined.
r1(d,c,e):- undefined.
r1(3,c,e):- undefined.
r1(f,c,e):- undefined.
r1(g,c,e):- undefined.
r1(h,c,e):- undefined.
r1(i,c,e):- undefined.

undefined :- tnot(undefined).

:- table s/0,t/0.
s:- tnot(t).

t:- tnot(undefined).

tbd:- p1(_,_,_),p1(a,b,_),s,find_backward_dependencies(undefined).

ta:- p1(_,_,_),p1(a,b,_),s,abolish_table_call(undefined).

ta1:- p1(_,_,_),p1(_,_,_),s,abolish_table_call(undefined).
ta1a:- p1(_,_,_),s,abolish_table_call(undefined),abolish_table_call(p1(_,_,_)).

ta2:- p1(_,_,_),p1(_,_,_),s,abolish_table_call(undefined,[abolish_tables_singly]).

:- table p2/3,  r2/3,  r3/3.
p2(X,Y,Z):- r2(X,Y,Z).
p2(X,Y,Z):- r3(X,Y,Z).

r2(a,b,c):- undefined.
r2(a,b,d):- undefined.
r2(a,c,c):- undefined.
r2(a,c,d):- undefined.
r2(b,c,d):- undefined.
r2(b,c,e):- undefined.
r2(c,c,e):- undefined.

r3(d,c,e):- undefined.
r3(3,c,e):- undefined.
r3(f,c,e):- undefined.
r3(g,c,e):- undefined.
r3(h,c,e):- undefined.
r3(i,c,e):- undefined.

ta3:- p2(_,_,_),abolish_table_call(r2(_,_,_)),abolish_table_call(r3(_,_,_)).

--- NEW FILE: abolish_cascade_pred_old ---
cascading abolish test completed

--- NEW FILE: aggregs1_test.P ---
:- import bagReduce/4, bagPO/3, bagPOv/2, bagOf/2, 
	bagMin/2, bagMax/2, bagSum/2, bagCount/2, bagAvg/2, bagPO/4,
	filterReduce/4, filterPO/3, filterPO/2, filterPOA/4,
	filterMin/2, filterMax/2 from aggregs1.
:- import subsumes_chk/2,variant/2 from subsumes.
:- import numbervars/3, numbervars/1 from num_vars.

/***********************************************************************/
:- import abolish_table_info/0 from machine.
:- import abolish_table_pred/1 from tables.
:- import member/2 from basics.
at :- abolish_table_info.
:- [edge_dag].	% data for testing shortest path
?- [subsumes].

:- compiler_options([spec_off]).

/* test data and query: test. */
test :- at,fail.

test :- 
	ainterp(app([a,b],[c,d],R),V),
	writeln([R,V]),fail.
test :- 
	ainterp(app(X,Y,[a,b,c,d]),V),
	writeln([X,Y,V]),fail.
test :- 
	bagPO(hi_call,p(X,Y),subsumed),
	numbervars(p(X,Y),0,_),writeln(p(X,Y)),fail.
test :- 
	bagOf(sal(Dept),M), sortbag(M,S),
	write('Dept'=Dept),write(', '),writeln('SalList'=S),fail.
test :- 
	% a funny way to do bagOf, inefficient! and not recommended!
	bagReduce(sal(Dept),M,cons,[]), sortbag(M,S),
	write('Dept'=Dept),write(', '), writeln('SalList(reduce)'=S),fail.
test :- 
	bagMin(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Minsal'=M),fail.
test :- 
	bagMax(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Maxsal'=M),fail.
test :- 
	bagAvg(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Avgsal'=M),fail.
test :- 
	bagCount(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Count'=M),fail.
test :- 
	bagSum(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Sumsal'=M),fail.
test :- 
	bagPO(tp(I),V,po),
	write('I'=I),write(', '),writeln('Val'=V),fail.
% bigger tests.
/****/
test :- 
	bagMin(sp(0,T),Dist), writeln([T,Dist]),fail.
test :- 
	bagCount(targsof(X),Count),
	write('Node'=X),write(', '),writeln('NumTargs'=Count),fail.
test:- 	filterReduce(p(a,X),max,neginf,Y),nvarwriteln(fmax(p(a,X),Y)),fail.

test:- 	filterReduce(p(a,b),max,neginf,Y),nvarwriteln(fmax(p(a,b),Y)),fail.

test:- 	filterReduce(p(X,c),max,neginf,Y),nvarwriteln(fmax(p(X,c),Y)),fail.

test:- 	filterPO(po1(a,b),Var,subsumes_chk),nvarwriteln(po1_1(a,b,Var)),fail.

test:- 	filterPO(po1(a,c),Var,subsumes_chk),nvarwriteln(po1_2(a,c,Var)),fail.

test:- filterPO(po1(X,c),Var,subsumes_chk),nvarwriteln(po1_3(X,c,Var)),fail.

test:- filterPO(fpo2(X,Y),aliasPrefer),nvarwriteln(fpo2(X,Y)),fail.

test:- filterMax(salary(Dept),Sal),writeln(filterMax(salary(Dept),Sal)),fail.

test:- filterMin(salary(Dept),Sal),writeln(filterMin(salary(Dept),Sal)),fail.

test:- filterPOA(place,Place,more_general_than,abstract),writeln(Place),fail.

test.

test1:-  bagPO(Y,v(X,Y),Min,(=<)),writeln(bpo1(X,Y,Min)),fail.

test2:-  bagPO(Y,X^v(X,Y),Min,(=<)),writeln(bpo2(X,Y,Min)),fail.

v(a,2).  
v(b,4).  
v(_,3).

varlte(v(_,B1),v(_,B2)):- B1 =< B2.
varlte(B1,B2):- number(B1),number(B2),B1 =< B2.

%filterPOA(place,Place,more_general_than,abstract)
place([place(p1,1),place(p2,2),place(p3,3)]).
place([place(p1,2),place(p2,1),place(p3,3)]).
place([place(p1,2),place(p2,1),place(p3,6)]).
place([place(p1,2),place(p2,2),place(p3,4)]).

more_general_than([],[]).
more_general_than([place(P,N1)|R1],[place(P,N2)|R2]):- 
	N2 @=< N1,
	more_general_than(R1,R2).

abstract([],Answer,Answer):-!.
abstract(Lists,Answer,NewAnswer):-
	factor(Lists,Places),
	abstract_1(Places,Answer,NewAnswer).

factor([],[]).
factor([[place(P1,N)|L1]|R1],[place(P1,Max)|R2]):-
	factor_1(R1,N,Rn,Max),
	(L1 == [] -> Rnew = Rn ; Rnew = [L1|Rn]),
	factor(Rnew,R2).
factor([[]|R],R1):- 
	factor(R,R1).

factor_1([],Max,[],Max).
factor_1([[place(_,M)|L1]|R1],N,[L1|Rnew],Max):- 
	(N @< M -> N1 = M ; N1 = N),
	factor_1(R1,N1,Rnew,Max).
factor_1([[]|R],N,R1,Max):- 
	factor_1(R,N,R1,Max).

abstract_1([],[],[]). 
abstract_1([place(P,N)|R1],[place(P,Ans)|R2],[place(P,NewAns)|R3]):- 
	(N @< Ans -> NewAns = omega ; NewAns = Ans),
	abstract_1(R1,R2,R3).

fpo2(a,b).
fpo2(a,c).
fpo2(a,a).
fpo2(b,c).
fpo2(X,X).

%aliasPrefer(fpo2(X,X),fpo2(Y,Z)):- \+ \+ (X = Y), \+ (Y == Z).
aliasPrefer(fpo2(X,X),fpo2(Y,_Z)):- variant(X,Y).

nvarwriteln(Term):-
	numbervars(Term),
	writeln(Term).

max(X,Y,Y):- \+ number(X),!.
max(X,Y,X):- \+ number(Y),!.
max(X,Y,Z):- (X > Y -> Z = X ; Z = Y).

min(X,Y,Y):- \+ number(X),!.
min(X,Y,X):- \+ number(Y),!.
min(One,Two,Min):- One > Two -> Min = Two ; Min = One.

sortbag(B,S) :- 
	findall(p(X,_),member(X,B),L),
	sort(L,L1),
	findall(X,member(p(X,_),L1),S).

%%:- table empp/2.	% to eliminate duplicates
empp(Dept,Sal) :- emp(_,Dept,Sal).

emp(david,cse,20000).
emp(phil,cse,25000).
emp(iv,cse,22000).
emp(sas,cse,22000).
emp(richard,lin,21000).
emp(mark,lin,51000).

/* Have to put ALL hilog declarations together.  This is a serious
problem. */

% to use this table decl, must compile(aggregs,[unfold_off,spec_repr]).
%%:- table sal(_)(_).
sal(Dept)(Sal) :- empp(Dept,Sal).

salary(Dept,Sal):- emp(_,Dept,Sal).

po1(a,X,p(f(X),g(X))).
po1(a,b,p(f(1),g(2))).
po1(a,b,p(f(1),g(_))).
po1(a,c,p(f(2),g(2))).
po1(b,c,p(f(_),g(2))).

:- hilog po.
po(false,top).
po(true,top).
po(bot,top).
po(bot,true).
po(bot,false).

/* test data for partial order */

tp(1)(bot).
tp(1)(false).
tp(1)(true).
tp(2)(bot).
tp(2)(true).
tp(2)(top).
tp(3)(false).
tp(3)(true).
tp(4)(bot).
tp(4)(true).
tp(4)(false).
tp(4)(top).

/* This defines sp(X,Y) as a set of (some short) distances from X to
Y.  Then one can find the shortest paths between points 0 and X, e.g.,
by calling bagMin(sp(0,X),Min). */

sp(X,Y)(D) :- edge(X,Y,D).
sp(X,Y)(D) :- bagMin(sp(X,Z),D1),edge(Z,Y,D2),D is D1+D2.

targsof(X)(Y) :- edge(X,Y,_).

:- hilog cons.		% for (badly) defining bagOf in terms of bagReduce
cons(Y,X,[X|Y]).

:- hilog minimum.
minimum(X,Y,Z) :- X @< Y -> Z=X ; Z=Y.
:- hilog maximum.
maximum(X,Y,Z) :- X @< Y -> Z=Y ; Z=X.
:- hilog sum.
sum(X,Y,Z) :- Z is X+Y.
:- hilog successor.
successor(X,_Y,Z) :- Z is X+1.
:- hilog sumcount.
sumcount([S|C],X,[S1|C1]) :- S1 is S+X, C1 is C+1.

/*******************************************************/
p(a,_X,1).
p(a,b,2).
p(a,b,3).
p(a,c,2).
p(b,c,3).

%	bagMax(sal(Dept),M),

bag_p(a,_X)(1).
bag_p(a,b)(2).
bag_p(a,b)(3).
bag_p(a,c)(2).

/*******************************************************/
/* An annotated logic meta-interpreter */

ainterp(G,N) :- bagMax(ainterp(G),N).

ainterp(true)(100000) :- !.
ainterp((A,B))(N) :- !,
	ainterp(A,N1),ainterp(B,N2),
	minimum(N1,N2,N).
ainterp(A)(N) :- arule(A,B)(N1), ainterp(B,N2), N is floor(N1*N2).

arule(app([],L,L),true)(1.0).
arule(app([X|L1],L2,[X|L3]),app(L1,L2,L3))(0.9).

arule(a,true)(1.0).
arule(a,true)(0.5).
arule(b,(a,c))(0.9).
arule(c,true)(0.5).
arule(c,(b,a))(0.4).

% to use bagPOv to get lubs by subsumption.
:- hilog subsumed.
subsumed(X,Y) :- subsumes_chk(Y,X).

p(a,b).
p([a],[c,d]).
p([a,b,c],[c,d,e,f]).
p(a,_X).
p([_,_|_],[_|_]).

:- hilog hi_call.
hi_call(X) :- call(X).

--- NEW FILE: aggregs_test.P ---
:- import bagReduce/4, bagPO/3, bagPOv/2, bagOf/2, 
	bagMin/2, bagMax/2, bagSum/2, bagCount/2, bagAvg/2, bagPO/4,
	filterReduce/4, filterPO/3, filterPO/2, filterPOA/4,
	filterMin/2, filterMax/2 from aggregs.
:- import subsumes_chk/2,variant/2 from subsumes.
:- import numbervars/3, numbervars/1 from num_vars.

/***********************************************************************/
:- import abolish_table_info/0 from machine.
:- import abolish_table_pred/1 from tables.
:- import member/2 from basics.
at :- abolish_table_info.
:- [edge_dag].	% data for testing shortest path
?- [subsumes].

:- compiler_options([spec_off]).

/* test data and query: test. */
test :- at,fail.

test :- 
	ainterp(app([a,b],[c,d],R),V),
	writeln([R,V]),fail.
test :- 
	ainterp(app(X,Y,[a,b,c,d]),V),
	writeln([X,Y,V]),fail.
test :- 
	bagPO(hi_call,p(X,Y),subsumed),
	numbervars(p(X,Y),0,_),writeln(p(X,Y)),fail.
test :- 
	bagOf(sal(Dept),M), sortbag(M,S),
	write('Dept'=Dept),write(', '),writeln('SalList'=S),fail.
test :- 
	% a funny way to do bagOf, inefficient! and not recommended!
	bagReduce(sal(Dept),M,cons,[]), sortbag(M,S),
	write('Dept'=Dept),write(', '), writeln('SalList(reduce)'=S),fail.
test :- 
	bagMin(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Minsal'=M),fail.
test :- 
	bagMax(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Maxsal'=M),fail.
test :- 
	bagAvg(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Avgsal'=M),fail.
test :- 
	bagCount(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Count'=M),fail.
test :- 
	bagSum(sal(Dept),M),
	write('Dept'=Dept),write(', '),writeln('Sumsal'=M),fail.
test :- 
	bagPO(tp(I),V,po),
	write('I'=I),write(', '),writeln('Val'=V),fail.
% bigger tests.
/****/
test :- 
	bagMin(sp(0,T),Dist), writeln([T,Dist]),fail.
test :- 
	bagCount(targsof(X),Count),
	write('Node'=X),write(', '),writeln('NumTargs'=Count),fail.
test:- filterReduce(p(a,X),max,neginf,Y),nvarwriteln(fmax(p(a,X),Y)),fail.