%%% Kennissystemen assignment 1B.
%%% 0440949 Andreas van Cranenburgh

:- retractall(hierarchy(_,_)).
:- consult(data).
%:- consult(graph).

%new concepts: bicycle, ufo, zeppelin, jetfighter, submarine
do(Name) :-
	tab(8), writeln(Name),
	do_classification(Name),
	findall(X, classify(Name, [], X), Classification),
	print2dhierarchy(Classification).
go1 :- 
	writeln('adding a fully new concept (no super concepts):'),
	do(ufo).
go2 :-
	writeln('adding a fully subsumed concept (all attributes and values match an existing concept):'),
	do(longboard).
go3 :- 
	writeln('adding a concept with missing attributes/values which is placed in the hierarchy while adding the missing knowledge to the concept.'),
	do(submarine).
go4 :-
	do(tank).
go5 :-
	do(zeppelin).

%show info on the whole KB
show :-
	findall(X, hierarchy(_, X), Y),
	list_to_set(Y, Concepts),
	show(Concepts).

%show info on each concept in a list	
show([]).
show([H|Tail]) :- show(H), show(Tail).

%show info on a single concepts.
show(Name) :-        
	bagof(Property=Value, defined(Name, Property, Value), Specific),
	findall(X, classify(Name, [], X), Classification),
	findall(X=Y, numberrestriction(Name, X, Y), SNumRestr),	%note: we use findall so as not to fail
	findall(X/Y, valuerestriction(Name, X, Y), SValRestr),	%when there are no restrictions.
	hierarchy(CurrentNode, Name),
	findall(X, inherit(properties, Name, CurrentNode, [], X), IProperties),
	findall(X, inherit(numberrestrictions, Name, CurrentNode, [], X), INumRestr),
	findall(X, inherit(valuerestrictions, Name, CurrentNode, [], X), IValRestr),
	write('classification of \''), write(Name), writeln('\': '), print2dhierarchy(Classification),
	writeln('specific properties: '), printlist(Specific),
	writeln('inherited properties: '), print3dlist(IProperties),
	writeln('specific number restrictions: '), printlist(SNumRestr),
	writeln('inherited number restrictions: '), print3dlist(INumRestr),
	writeln('specific value restrictions: '), printlist(SValRestr),
	writeln('inherited value restrictions: '), print3dlist(IValRestr), nl.

show(Name) :- write('Information on \''), write(Name), writeln('\' is incomplete.'), nl.

%%% simple prety print
printlist([]).
printlist([H|List]) :-
	tab(8), writeln(H),
	printlist(List).

%%% eg. [A,B,C] becomes: A --> B --> C
printhierarchy([H]) :- write(H), nl.
printhierarchy([H|List]) :-
	write(H), write('-->'),
	printhierarchy(List).

%%% call previous predicate for every list inside 2d list.
print2dhierarchy([]).
print2dhierarchy([H|List]) :-
	tab(8), printhierarchy(H),
	print2dhierarchy(List).

%%% slightly less simple pretty print
print2dlist([]).
print2dlist([H|List]) :-
	printlist(H),
	print2dlist(List).

print3dlist([]).
print3dlist([H|List]) :-
	print2dlist(H),
	print3dlist(List).

%%% base case, get out of recursion, don't record properties of thing.
inherit(_, _, thing, List, List).

%%% %Inherit properties from parent types, collect properties and move
%%% up in the hierarcy.
inherit(properties, Name, CurrentNode, Accu, Answer) :-
	%%% fixme: maybe setof?? member check in accu?
        findall(CurrentNode:Property=Value, primitive(CurrentNode, Property, Value), List),
	hierarchy(NewNode, CurrentNode),
	inherit(properties, Name, NewNode, [List|Accu], Answer).

inherit(numberrestrictions, Name, CurrentNode, Accu, Answer) :-
	%%% fixme: maybe setof?? member check in accu?
        findall(CurrentNode:Restriction=Value, numberrestriction(CurrentNode, Restriction, Value), List),
	hierarchy(NewNode, CurrentNode),
	inherit(numberrestrictions, Name, NewNode, [List|Accu], Answer).

inherit(valuerestrictions, Name, CurrentNode, Accu, Answer) :-
	%%% fixme: maybe setof?? member check in accu?
        findall(CurrentNode:Restriction/X, valuerestriction(CurrentNode, Restriction, X), List),
	hierarchy(NewNode, CurrentNode),
	inherit(valuerestrictions, Name, NewNode, [List|Accu], Answer).

%classify(thing, List, List).
%return paths to "thing" in a list.
%eg. 
%	thing-->rolling-->wheels-->smart
%	thing-->motor-->smart
		
%"thing" in the list shows the start of a path
classify(thing, List, [thing|List]).

classify(Name, Accu, Answer) :-
	hierarchy(CurrentNode, Name),
	classify(CurrentNode, [Name|Accu], Answer).

% match if Super is a direct or indirect super concept of Concept
% (similar to "classify" above, but doesn't generate a list)
related(Super, Concept) :-
	Super = Concept ;
 	hierarchy(Super, Concept) ;
	hierarchy(X, Concept),
	related(Super, X).

%find classification based on properties.
%given a name and a list of properties, the concept will be placed in the
%taxonomy.
getproperties(Name, Properties) :-
	findall(Attribute/Min:Max, 
		numberrestriction(Name, Attribute, Min:Max),
		NRs),
	findall(Attribute=Value, 
		defined(Name, Attribute, Value),
		VRs),
	append(NRs, VRs, Properties).

do_classification(Name) :-
	getproperties(Name, Properties),
	subsumedconcept(Properties, [], Concepts),
	assertconcepts(Name, Concepts).

do_classification(Name) :-
	getproperties(Name, Properties),
	partiallysubsumedconcept(Properties, [], Concepts),
	assertconcepts(Name, Concepts).

%when all else fails, completely new concept:
do_classification(Name) :-
	writeln('	New concept, linking to \'thing\''),
	assertconcepts(Name, [thing]).
	
%all of a concept's properties (number restrictions) are present in the KB,
%return super concepts.
subsumedconcept([], Accu, Result) :-
	length(Accu, X), %multiple inheritance -> more than 1 super concept
	X >= 1, list_to_set(Accu, Result),
	write('	Subsumed concept, super concepts: '), writeln(Result).
subsumedconcept([H|Properties], Concepts, Result) :-
	matchsuperconcept(H, Super),
	%subsumedconcept(Properties, [Super|Concepts], Result).
        (length(Concepts, Y), Y >= 1 ->
                (intersection(List, Concepts, SuperConcepts),
                subsumedconcept(Properties, SuperConcepts, Result))
                ;
                subsumedconcept(Properties, List, Result)).


%find the most specific matching number restriction
matchsuperconcept(Attribute/XMin:XMax, Result) :-
	bagof(Super/SMin:SMax,
		numberrestriction(Super, Attribute, SMin:SMax),
		List),
	smallestinterval(XMin:XMax, List, 999999:_, Result). %six nines should be enough for anything.

%match a value as being part of a number restriction's interval	
matchsuperconcept(Attribute=Value, Result) :-
	bagof(Super/SMin:SMax,
		numberrestriction(Super, Attribute, SMin:SMax),
		List),
	smallestinterval(Value:Value, List, 999999:_, Result).
	
%given an attribute/value, match concepts requiring an instance of that value.
matchsuperconcept(Attribute=Value, Result) :-
	bagof(Super=SValue,
		valuerestriction(Super, Attribute, SValue),
		List),
	mostspecific(Value, List, _, 0, Result).

%from a list of intervals, find the smallest one(s) that match.
smallestinterval(_XMin:_XMax, [], Best:Result, Result) :- Best < 999999. %999999 equals infinity.
smallestinterval(XMin:XMax, [SName/SMin:SMax|List], Best:Accu, Result) :-
	(SMin =< XMin, 	XMax =< SMax ->
		(SDelta is SMax - SMin, SDelta < Best ->
			smallestinterval(XMin:XMax, List, SDelta:[SName], Result)
			;
			SDelta = Best,
			smallestinterval(XMin:XMax, List, Best:[SName|Accu], Result))
		;
		smallestinterval(XMin:XMax, List, Best:Accu, Result)).

%from a list of candidate super concepts, return the most
%specific one; ie. the one with the longest route to "thing".
%mostspecific(_, [X], X, _BestScore, X).	%don't bother if there's only 1 element
mostspecific(_, [], X, BestScore, X) :-
	BestScore > 0.
mostspecific(Value, [Super=SValue|List], BestConcept, BestScore, Result) :-
	(related(SValue, Value), 
	classify(Super, [], X),
	length(X, Y), 
	Y > BestScore ->	%found better match
		mostspecific(Value, List, [Super], Y, Result)
		;
		(Y = BestScore ->
			mostspecific(Value, List, [Super|BestConcept], BestScore, Result))
			;
			mostspecific(Value, List, BestConcept, BestScore, Result)).

%match if there are unresolved ambiguities.	
partiallysubsumedconcept([], Accu, Result) :-
	length(Accu, X), %multiple inheritance -> more than 1 super concept
	X >= 1, list_to_set(Accu, Result),
	write('	Partially subsumed concept, super concepts: '),
	writeln(Result).
partiallysubsumedconcept([H|Properties], Concepts, Result) :-
	(matchsuperconcept(H, Super) ->
	        (length(Concepts, Y), Y >= 1 ->
        	        intersection(Super, Concepts, SuperConcepts),
			(SuperConcepts \= [] ->
				write('Property \''), write(H),
				write('\' subsumed by: '), writeln(SuperConcepts),
				partiallysubsumedconcept(Properties, SuperConcepts, Result)
				;
				write('Ambiguous property \''), write(H),
				write('\' subsumed by: '), writeln(Super),
				
				)
			;
			(write('Underspecified: '), writeln(H),
			partiallysubsumedconcept(Properties, Concepts, Result)))).

%assert our findings into the taxonomy
assertconcepts(_Name, []).
assertconcepts(Name, [H|Concepts]) :-
	%atom(H) %don't assert things like _G234
	writeln(assert(hierarchy(H, Name))),	%commented out for debugging.
	assertconcepts(Name, Concepts).