% -----------------------------------------------------------------------------
% Project:	Declarative Output by Ordering Text Pieces
% Filename:	output.pl
% Purpose:	Execution environment for deductive database in Datalog
% Last Change:	07.01.2011
% Language:	SWI Prolog
% EMail:	brass@informatik.uni-halle.de
% WWW:		http://www.informatik.uni-halle.de/~brass/
% Address:	Univ. Halle, Von-Seckendorff-Platz 1, D-06120 Halle, GERMANY
% Copyright:	(c) 2010 by Stefan Brass
%		Downloads and modifications for tests and scientific purposes
%		permitted, provided that some acknowledgement of my work
%		remains, and modified versions are clearly marked as such.
%		There is no warranty at all - this code may contain bugs.
% -----------------------------------------------------------------------------

%==============================================================================
% Dynamic Database:
%==============================================================================

:- dynamic rule/2.
:- dynamic fact/1.
:- dynamic derived_pred/2.
:- dynamic base_pred/2.


%==============================================================================
% Main Program:
%==============================================================================

main(File) :-
	retractall(rule(_,_)),
	retractall(fact(_)),
	read_datalog_program(File),
	nl,
	nl,
	write('Given Base Facts: '),
	show_base_facts,
	nl,
	nl,
	write('Given Rules: '),
	show_rules,
	nl,
	nl,
	write('Bottom-Up Evaluation starts ...\n'),
	botup,
	write('done.\n'),
	nl,
	nl,
	write('Derived Facts: '),
	show_derived_facts,
	nl,
	nl,
	write('Generated Output:'),
	nl,
	do_output,
	nl,
	!.

ex1 :- main('/dos/paper/iclp11/ex1').
ex2 :- main('/dos/paper/iclp11/ex2').
ex3 :- main('/dos/paper/iclp11/ex3').
ex4 :- main('/dos/paper/iclp11/ex4').

%==============================================================================
% Read Datalog Program:
%==============================================================================

:- op(1200, xfx, <-).

read_datalog_program(File) :-
	open(File, read, Stream),
	read_rules(Stream),
	close(Stream).

read_rules(Stream) :-
	read(Stream, Rule),
	(Rule = end_of_file -> finished; process(Rule), read_rules(Stream)).

finished :-
	write('Finished reading Datalog program.\n').

process(Rule) :-
	parse_rule(Rule, Head, BodyList) -> store_rule(Head, BodyList);
	store_fact(Rule).

parse_rule((Head <- Body), Head, BodyList) :-
	parse_body(Body, BodyList).

parse_body(Body, [Lit|RestList]) :-
	Body = (Lit, Rest) ->
		parse_body(Rest, RestList);
		(Lit = Body, RestList = []).

store_rule(Head, Body) :-
	functor(Head, Pred, Arity),
	store_derived_pred(Pred, Arity),
	assert(rule(Head, Body)).

store_derived_pred(Pred, Arity) :-
	derived_pred(Pred, Arity) -> true; assert(derived_pred(Pred,Arity)).

store_fact(Fact) :-
	functor(Fact, Pred, Arity),
	store_base_pred(Pred, Arity),
	assert(fact(Fact)).

store_base_pred(Pred, Arity) :-
	base_pred(Pred, Arity) -> true; assert(base_pred(Pred,Arity)).


%==============================================================================
% Naive Bottom-Up Evaluation:
%==============================================================================

%------------------------------------------------------------------------------d
% Main Bottom-Up Loop:
%------------------------------------------------------------------------------

botup :-
	derivable(Fact),
	\+ fact(Fact),
	!,
	assert(fact(Fact)),
	botup.

botup.

%------------------------------------------------------------------------------d
% Finding Derivable Facts:
%------------------------------------------------------------------------------

derivable(Head) :-
	rule(Head, Body),
	is_true(Body).

is_true([]).

is_true([Lit|Rest]) :-
	check_lit(Lit),
	is_true(Rest).

check_lit(Lit) :-
	fact(Lit).

check_lit('>'(A,B)) :-
	A > B.

check_lit('>='(A,B)) :-
	A >= B.

check_lit('<'(A,B)) :-
	A < B.

check_lit('<='(A,B)) :-
	A =< B.

check_lit('='(A,B)) :-
	A = B.

check_lit('!='(A,B)) :-
	A \= B.

check_lit(inc(A,B)) :-
	B is A+1.

check_lit(concat(A,B,C)) :-
	atom_concat(A, B, C).

%------------------------------------------------------------------------------d
% Show rules:
%------------------------------------------------------------------------------

show_rules :-
	derived_pred(Pred, Arity),
	nl,
	write(Pred),
	write('/'),
	write(Arity),
	write(':'),
	nl,
	functor(Head, Pred, Arity),
	rule(Head, Body),
	write('\t'),
	writeq(Head),
	write(' <- '),
	show_body(Body),
	write('.'),
	nl,
	fail.

show_rules.

show_body([]).

show_body([Lit|Body]) :-
	nl,
	write('\t\t'),
	writeq(Lit),
	show_body(Body).

%------------------------------------------------------------------------------d
% Show derived facts:
%------------------------------------------------------------------------------

show_derived_facts :-
	derived_pred(Pred, Arity),
	nl,
	write(Pred),
	write('/'),
	write(Arity),
	write(':'),
	nl,
	functor(Fact, Pred, Arity),
	fact(Fact),
	write('\t'),
	writeq(Fact),
	write('.'),
	nl,
	fail.

show_derived_facts.

%------------------------------------------------------------------------------d
% Show base facts:
%------------------------------------------------------------------------------

show_base_facts :-
	base_pred(Pred, Arity),
	nl,
	write(Pred),
	write('/'),
	write(Arity),
	write(':'),
	nl,
	functor(Fact, Pred, Arity),
	fact(Fact),
	write('\t'),
	writeq(Fact),
	write('.'),
	nl,
	fail.

show_base_facts.


%==============================================================================
% Output:
%==============================================================================

%------------------------------------------------------------------------------d
% do_output:
%------------------------------------------------------------------------------

do_output :-
	findall(output(Pos,Text), fact(output(Pos,Text)), Out_List),
	sort_output_list(Out_List, Sorted_List),
	print_output(Sorted_List).


%------------------------------------------------------------------------------d
% sort_output_list(+In, -Out):
%------------------------------------------------------------------------------

sort_output_list(In, Out) :-
	make_runs(In, Runs),
	mergesort(Runs, Out).

make_runs([], []).

make_runs([Elem|More], [[Elem]|MoreRuns]) :-
	make_runs(More, MoreRuns).

mergesort([], []).

mergesort([Run], Run).

mergesort([Run1, Run2 | More], Out) :-
	mergesort_step([Run1, Run2 | More], Runs),
	mergesort(Runs, Out).

mergesort_step([], []).

mergesort_step([Run], [Run]).

mergesort_step([Run1, Run2 | More], [Run | MoreRuns]) :-
	merge(Run1, Run2, Run),
	mergesort_step(More, MoreRuns).

merge([], Rest, Rest) :- !.
merge(Rest, [], Rest) :- !.
merge([E1|Rest1], [E2|Rest2], [E1|Rest]) :-
	E1 = output(P1,_),
	E2 = output(P2,_),
	before(P1, P2),
	!,
	merge(Rest1, [E2|Rest2], Rest).
merge([E1|Rest1], [E2|Rest2], [E2|Rest]) :-
	merge([E1|Rest1], Rest2, Rest).

before(X, Y) :-
	number(X),
	number(Y),
	!,
	X < Y.

before(X, Y) :-
	flatten(X, XL),
	flatten(Y, YL),
	before_list(XL, YL).

before_list([], [_|_]) :-
	!.

before_list([X|L1], [X|L2]) :-
	!,
	before_list(L1, L2).

before_list([X|_], [Y|_]) :-
	number(X),
	number(Y),
	!,
	X < Y.

before_list([X|_], [Y|_]) :-
	atomic(X),
	atomic(Y),
	!,
	X @< Y.


flatten([], []) :-
	!.

flatten(X, [X]) :-
	atomic(X),
	!.

flatten([[]|L1], L2) :-
	!,
	flatten(L1, L2).

flatten([X|L1], [X|L2]) :-
	atomic(X),
	!,
	flatten(L1, L2).

flatten([X|L1], L4) :-
	flatten(X, L2),
	flatten(L1, L3),
	append(L2, L3, L4).


%------------------------------------------------------------------------------
% print_output(+List):
%------------------------------------------------------------------------------

print_output([]) :-
	nl.

print_output([output(_,Text)|More_Output]) :-
	write(Text),
	print_output(More_Output).