/* Reasoning about time. Kennissystemen 2007
 * 0440949 Andreas van Cranenburgh
 * 0518808 Joris de Groot
 */

:- use_module(library(ugraphs)).
:- consult(data).
:- consult(graph).

go :-
	write('This is CSI (Crime Scene Investigation)'), nl, nl, nl,
	loop.

%Main menu
loop :- 
	writeln('1 = Add witness report'),
	writeln('2 = Find conflicting witness reports'),
	writeln('3 = List witness reports'),
	writeln('4 = Show all events'),
	writeln('5 = Get witness reports for an event'),
	writeln('6 = Generate possible timeline (Topological sort)'),
	writeln('q = Quit (Ctrl-c a)'),
	nl, write('Choice: '), readln(Letter),
	(
		( Letter = [1], 
		  write( 'Entering witness report. Refer to an existing event-id to add an additional witness reports, or create a new event. Enter q to stop and go back to the menu' ), nl,
		  add_witnessreport_loop )
		;
		( Letter = [2], 
			list_conflicts,
			write('Press the \'any\' key to continue'), readln(_) )
		;
		( Letter = [3],
			findall(witness(X, Y, Z), witness(X, Y, Z), List),
			writeln('witness(Name, Time, [Events]'),
			print_ol(List, 1), nl,
			write('Press the \'any\' key to continue'), readln(_))
		;
		( Letter = [4], 
			findall(event(A,B,C,D),
			event(A,B,C,D), List),
			writeln('event(Name, Place, Participants, Time'),
			print_ol(List, 1), nl,
			write('Press the \'any\' key to continue'), readln(_))
		;
		( Letter = [5], 
			witnessreports_for_event,
			write('Press the \'any\' key to continue'), readln(_) )
		;
		( Letter = [6], 
			timeline,
			write('Press the \'any\' key to continue'), readln(_))
		; true
	),
	(Letter = [q] -> true
	;
	loop).

% ---------------------------------------------
		
%%%probably redundant parentheses etc. (but nowhere near LISP levels yet!')
add_witnessreport_loop :-
	write('Witness: '), readln([Witness]),
	(	Witness = [q]
		;
		(
			write('Time: '), readln(Time),
			add_event(Event),
			X = witness(Witness, Time, Event),
			assert(X),
			write('		asserted: '), writeln(X),
			add_witnessreport_loop
		)
	).

add_event(Event) :-
	write('what - action: '), readln([Event]),
	(event(Event, _,_,_) ->
		true
	;
		write('where - place: '), readln([Place]),
		write('who - [space separated list]: '), readln(Participants),
		write('when: '), readln(Time),
		X = event(Event, Place, Participants, Time),
		assert(X),
		write('		asserted '), writeln(X)).

list_conflicts :-
	writeln('Contradicting witness reports:'),
	findall(_, conflict, _).

%when there are multiple reports on the same event, there is a conflict
conflict :-
	event(X,Y1,Z1,T1), event(X,Y2,Z2,T2),
	\+ T1 = T2,
	writeln(event(X,Y1,Z1,T1)), writeln(event(X,Y2,Z2,T2)), nl.

% ---------------------------------------------
witnessreports_for_event :-
	findall(event(X,Y,Z,T), event(X,Y,Z,T), List), print_ol(List, 1),
	write('make your choice, enter number: '), readln([Number]),
	nth1(Number, List, event(Id,_,_,_)),
	findall(X, getwitness(X, Id), WitnessList),
	(WitnessList = [] ->
		writeln('No witness reports yet.')
	;
		writeln('Witness report(s):'),
		print_ol(WitnessList, 1)).

getwitness(Witness, EventId) :-
	witness(P, Q, R),
	Witness = witness(P, Q, R),
	member(EventId, R).

% ---------------------------------------------

% - make a directed graph from the events
% - do a topological sort
% - print the first solution
timeline :-
	directed_graph(Top),
	%transpose(Top1, Top),
	writeln('The events graph:'),
	print_ol(Top, 1), nl,
	writeln('A topological sort yields the following possible timeline:'),
	toposort(Top, Sorted),
	timeprint(Sorted, 1),
	findall(X, toposort(Top, X), List), length(List, N),
	write('Total number of alternative timelines: '), writeln(N).
	%writeln('All possible timelines:'),
	%forall(toposort(Top, Sorted), timeprint(Sorted, 1)).

switch('=', '=').
switch('<', '>').
switch('>', '<').

%match if A is before B
%absolute times
cmpevents('<', A, B) :- 
	event(A, _,_, A1:A2), event(B, _,_, B1:B2),
	A1*60+A2 < B1*60+B2.
cmpevents('>', A, B) :-
	event(A, _,_, A1:A2), event(B, _,_, B1:B2),
	A1*60+A2 > B1*60+B2.
cmpevents('=', A, B) :-
	event(A, _,_, A1:A2), event(B, _,_, B1:B2), A \= B,
	A1*60+A2 = B1*60+B2.

%relative times
cmpevents('<', A, B) :-
	(event(A, _, _, before(B)) ; event(A, _, _, before(_, B)) 
	; event(B, _, _, after(A)) ; event(B, _, _, after(_, A))).
cmpevents('>', A, B) :-
	(event(A, _, _, after(B)) ; event(A, _, _, after(_, B))
	; event(B, _, _, before(A)) ; event(B, _, _, before(_, A))).
%NB: this one should not be symmetric, otherwise it'll cause cycles.. A->B, B->A
cmpevents('=', A, B) :-
	event(A, _, _, during(B)).

%recursion
cmpevents('<', A, B) :-
	event(X,_,_,_), \+ A = X, \+ B = X,
	((event(X, _, _, during(Y)) ; event(Y, _, _, during(X))), X1 = Y; X1 = X),
	(event(A, _, _, before(X1)) ; event(A, _, _, before(_, X1))
	;event(X1, _, _, after(A)) ; event(X1, _, _, after(_, A))),
	cmpevents('<', X1, B).

%show a numbered list, with concurrent events on the same line
timeprint([X], Count) :-
	write(Count), write('-'), writeln(X), nl.
timeprint([X,Y|List], Count) :-
	(event(X,_,_,during(Y))
	; event(Y,_,_,during(X))), !,
	write(Count), write('-'), write(X), tab(1),
	timeprint([Y|List], Count).

timeprint([X,Y|List], Count) :-
	write(Count), write('-'), writeln(X),
	NewCount is Count + 1,
	timeprint([Y|List], NewCount).

% this prints an ordered list, ie. it writes the index number before every
% element. Second argument should be 0 or 1, wherever you want counting to start.
print_ol( [], _ ).
print_ol( [ Head | Tail ], Count) :-
	write(Count), write('-'), write(Head), nl,
	NewCount is Count + 1,
	print_ol( Tail, NewCount ).
	

% ---------------------------------------------

%NB: Nodes need to be sorted (set)
directed_graph(Result) :-
	findall(Id, event(Id,_,_,_), Ids), 
	list_to_set(Ids, Ids1),
	make_graph(Ids1, [], Graph),
	sort(Graph, Result).

%NB: Edges need to be sorted (also a set)
make_graph([], Result, Result).
make_graph([Id|Ids], Acc, Result) :-
	findall(A, cmpevents('<', Id, A), List),
	findall(A, cmpevents('=', Id, A), List1),
	append(List, List1, List2), 
	list_to_set(List2, List3),
	sort(List3, Edges),
	make_graph(Ids, [Id-Edges|Acc], Result).

%--------------------------------------------

%Modified topological sort, based on SWI-Prolog's standard library
%This version backtracks over alternatives
top_sort([], [], A, _, B) :- !,
        ugraphs:vertices_and_zeros(A, _, B).
top_sort(F, [A|H], B, D, E) :-
        member(A, F),
	delete(F, A, NewF),
	ugraphs:graph_memberchk(A-C, B),
        ugraphs:decr_list(C, D, E, I, NewF, G),
        top_sort(G, H, B, D, I).

toposort(A, F) :-
        ugraphs:vertices_and_zeros(A, B, C),
        ugraphs:count_edges(A, B, C, D),
        ugraphs:select_zeros(D, B, E),
        top_sort(E, F, A, B, D).


toposort(A, G, F) :-
        ugraphs:vertices_and_zeros(A, B, C),
        ugraphs:count_edges(A, B, C, D),
        ugraphs:select_zeros(D, B, E),
        top_sort(E, F, G, A, B, D).
%-------

%this is only used by graph.pl:
before(A,B) :-
	cmpevents('<', A, B) ; cmpevents('=', A, B).