/* Copyright 2013 Laura Giordano, Valentina Gliozzi, Adam Jalal, Nicola Olivetti, Gian Luca Pozzato This file is part of PreDeLo 1.0. PreDeLo 1.0 is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. PreDeLo 1.0 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with PreDeLo 1.0. If not, see . */ :-module(helpers,[buildTree/6,clearSubsumptions/2,extractBox/3,existOlder/3,transitivity/5,genLabel/3,getLabels/3,removeDup/2,genSmList/3,initLabels/2,getTypicals/2,getNegBox/3, uncheckedSideCondition/4]). :- use_module(library(lists)). :- use_module(operators). /* Clear the list of labels already used to expand a subsumption C inc D */ clearSubsumptions([],[]):-!. clearSubsumptions([[H,_]|Tail],[[H,[]]|ResTail]):-clearSubsumptions(Tail,ResTail). /* checks the second side condition of existence restriction */ alreadyApplied(X,Age,R,C,S) :- member([[X,Age],R,[Z,Age2]],S), member([[Z,Age2],C],S). /* checks the second side condition of negated box rule */ uncheckedSideCondition(X,S,C,XBox):- member([Y < X],S), member([Y,C],S), member([Y,box neg C],S), genSmList(Y,XBox,YBox), subList(YBox,S). /* checks inclusion among Prolog lists */ subList([],_):-!. subList([Head|Tail],L):-member(Head,L),subList(Tail,L). /* print a labelled formula in a clearer way */ writeBetter([[X,_],F]):-!,write(X),write(':'),write(F). writeBetter([[X,_]<[Y,_]]):-!,write(X),write('<'),write(Y). writeBetter([[X,_],R,[Y,_]]):-!,write(X),write(R),write(Y). /* generates a new label */ genLabel(Labels,[x,Nx],[[x,Nx]|Labels]) :- \+member([x,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[y,Nx],[[y,Nx]|Labels]) :- \+member([y,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[z,Nx],[[z,Nx]|Labels]) :- \+member([z,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[i,Nx],[[i,Nx]|Labels]) :- \+member([i,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[j,Nx],[[j,Nx]|Labels]) :- \+member([j,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[k,Nx],[[k,Nx]|Labels]) :- \+member([k,_],Labels), maxVal(Labels,N), Nx is N + 1,!. genLabel(Labels,[x,Nx],[[x,Nx]|Labels]) :- maxVal(Labels,N), Nx is N + 1,!. %genLabel([[x,1]],L,Labs) /* finds the max label value in a labels list */ maxVal([[_,Nx]],Nx). maxVal([[_,Nx]|Labels],Nx) :- maxVal(Labels,Y), Nx >= Y. maxVal([[_,Nx]|Labels],N) :- maxVal(Labels,N), N > Nx. /* checks the first side condition: if there is and older label in S labeling the same elements as X */ existOlder(S,X,Age) :- member([[Z,Age2],_],S), Age2 < Age, extract([X,Age],S,R1), extract([Z,Age2],S,R2), removeDup(R1,D1), removeDup(R2,D2), compareLists(D1,D2),!. /* extracts from a list L all the elements labeled E into the new list R */ extract(_,[],[]):-!. extract(E,[[E,C]|L],[[E,C]|R]) :- extract(E,L,R),!. extract(E,[[_,_,_]|L],R) :- extract(E,L,R),!. extract(E,[[_ < _]|L],R) :- extract(E,L,R),!. extract(E,[[_,_]|L],R) :- extract(E,L,R),!. /* says yes iff L1 and L2 contain elements labeling the same concepts */ compareLists(L1,L2):-length(L1,L),length(L2,L),compareListsIn(L1,L2). compareListsIn([],[]):-!. compareListsIn(L1,L2) :-select([_,C],L1,L11),!, select([_,C],L2,L22),!, compareListsIn(L11,L22),!. /* extracts the labels (no duplicates) from a list (except for label X, transitive labels and order relation) */ getLabels(_,[],[]). getLabels(X,[[_,_,_]|Xt],Out) :- getLabels(X,Xt,Out),!. getLabels(X,[[_ < _]|Xt],Out) :- getLabels(X,Xt,Out),!. getLabels(X,[[X,_]|Xt],Out) :- getLabels(X,Xt,Out),!. getLabels(X,[[Y,_]|Xt],Out) :- member([Y,_],Xt), getLabels(X,Xt,Out),!. getLabels(X,[[Y,_]|Xt],[Y|Out]) :- getLabels(X,Xt,Out),!. /* initializes the labels list with the labels in list S */ initLabels([],[]). initLabels([[Y,_]|S],[Y|Labels]) :- \+member([Y,_],S), initLabels(S,Labels),!. initLabels([_|S],Labels) :- initLabels(S,Labels),!. /* extracts box concepts labeled by x */ extractBox(_,[],[]). extractBox(X,[[X,box C]|S],[[box C]|Sx]) :- extractBox(X,S,Sx),!. extractBox(X,[_|S],Sx) :- extractBox(X,S,Sx),!. /* NON USATO get labels top level */ getLabels3(X,S,L2) :- removeRels(S,S2), removeDup(S2,S3),removeElem(X,S3,L2),!. /* NON USATO rimuove un elem X dalla lista */ removeElem(_,[],[]). removeElem(X,[X|Xt],S2) :- removeElem(X,Xt,S2),!. removeElem(X,[Y|Xt],[Y|S2]) :- removeElem(X,Xt,S2),!. /* NON USATO elimina da lista le formula di transitivita' */ removeRels([],[]). % removeRels([[_,_,_]|S],L) :- removeRels(S,L). % removeRels([[X,C]|S],[[X,C]|L]) :- removeRels(S,L). % /* NON USATO elimina da lista i duplicati */ removeDup2([],[]). removeDup2([[X,_]|T],[X|Out]) :- \+member([X,_],T), removeDup(T,Out),!. % removeDup2([[X,_]|T],Out) :- member([X,_],T), removeDup(T,Out),!. /* Removes duplicates from a list */ removeDup([],[]). removeDup([X|T],[X|Out]) :- \+member(X,T), removeDup(T,Out),!. % removeDup([X|T],Out) :- member(X,T), removeDup(T,Out),!. /**/ isEmpty([]). /* Second side condtion recursion for box - rule */ secondRec(_,_,[]). secondRec(U,S,[[C]|Sm]) :- member([U,C],S), secondRec(U,S,Sm). /* Generates the Sm(x) list in box - rule */ genSmList(_,[],[]). genSmList(X,[[box C]|Sm],[[X,C]|[[X,box C]|Smx]]) :- genSmList(X,Sm,Smx),!. /* generates the list Lt of concepts of which we want to minimize the untypical instances */ getTypicals([],[]). getTypicals([[_,ti C]|S],[C|Lt]) :- getTypicals(S,Lt),!. getTypicals([[_,neg ti C]|S],[C|Lt]) :- getTypicals(S,Lt),!. getTypicals([[[ti C inc _],_]|S],[C|Lt]) :- getTypicals(S,Lt),!. getTypicals([_|S],Lt) :- getTypicals(S,Lt),!. /* extracts the neg box neg c formulae from a list, used in second phase top level call*/ getNegBox([],[],[]). getNegBox([[X,neg box neg C]|S],[[X,neg box neg C]|B],[[X,neg box neg C]|K]) :- getNegBox(S,B,K),!. getNegBox([_|S],B,K) :- getNegBox(S,B,K),!. buildTree(Phase,Rule,S,U,Children,[Phase,Rule,S,U,Children]):-!.