/* 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,writePlainElement/2,writePlainList/2,compareWithK/3,getK/3,genSmCompList/5,printl/1,indent/1,clearSubsumptions/2,extractBox/3,extractNegBoxNegC/4,existElder/3,transitivity/5,split/4,printlist/1,genLabel/3,getLabels/3,extract/3,compareLists/2,maxVal/2,removeDup/2,genSmList/4,secondSideCond/4,initLabels/2,getTypicals/2,getNegBox/3,copyList/2,removeBoxes/3]). :- use_module(library(lists)). :- use_module(operators). /* Remove negated box formulas [X,neg box neg _] from K, returning the resulting list */ removeBoxes([],_,[]):-!. removeBoxes([[X,neg box neg _]|K],X,TailK):-!,removeBoxes(K,X,TailK). removeBoxes([[Y,F]|K],X,[[Y,F]|TailK]):-!,removeBoxes(K,X,TailK). /* compares 'x: neg box neg C' in S and K -> looks for 1 to 1 correspondence */ compareWithK(_,[],_). compareWithK(X,[C|Lc],K):- member([X,neg box neg C],K), compareWithK(X,Lc,K). /* Indent text for debugging */ indent(0):-!. indent(L):-L1 is L-1,write(' '),indent(L1). /* Clear the list of labels already used to expand a subsumption C inc D */ clearSubsumptions([],[]):-!. clearSubsumptions([[H,_]|Tail],[[H,[]]|ResTail]):-clearSubsumptions(Tail,ResTail). /*builds a tree node*/ buildTree(Phase,Rule,S,U,Children,[Phase,Rule,S1,U1,Children]):- writePlainList(S,S1),writePlainList(U,U1),!. /* checks the second side condition */ transitivity(X,Age,R,C,S) :- member([[X,Age],R,[Z,Age2]],S), member([[Z,Age2],C],S). /* splits the list L in B (elems before E) and A (elems after E) */ split(E,L,B,A) :- member(E,L), split(E,L,B,A,0),!. split(_,[],[],[],_). split(E,[E|L],B,A,_) :- split(E,L,B,A,1),!. split(E,[Y|L],[Y|B],A,C) :- C == 0, split(E,L,B,A,0),!. split(E,[Y|L],B,[Y|A],C) :- C == 1, split(E,L,B,A,1),!. /* mia print */ printl([]) :-write('\n'),!. printl([Hd|Tl]) :- write(Hd), printl(Tl),!. /* prints a list */ printlist([]) :-write('\n'),!. printlist([Hd|Tl]) :- writeBetter(Hd), write(','), printlist(Tl),!. /* 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). /*writes a plain list, without ages*/ writePlainList([],[]):-!. writePlainList([[[L,_],F]|Li],[[L:F]|Pl]) :- writePlainList(Li,Pl),!. writePlainList([[[L,_],R,[L2,_]]|Li],[[L,R,L2]|Pl]) :- writePlainList(Li,Pl),!. writePlainList([X|Li],[X|Pl]) :- writePlainList(Li,Pl),!. /*writes a plain element, without age*/ writePlainElement([[X,_],F],[X:F]):-!. writePlainElement([[X,_],R,[Y,_]],[X,R,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 */ existElder(S,X,Age) :- member([[X,Age],C],S), member([[Z,Age2],C],S), Age2 < Age,!, extract([X,Age],S,R1), extract([Z,Age2],S,R2), compareLists(R1,R2),!. /* 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([],[]). compareLists(L1,L2) :- select([_,C],L1,L11), select([_,C],L2,L22), compareLists(L11,L22),!. /* extracs 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),!. /* extracts neg box neg concepts labeled by x */ extractNegBoxNegC(_,[],[],[]). extractNegBoxNegC(X,[[X,neg box neg C]|S],[C|Sx],Sn) :- extractNegBoxNegC(X,S,Sx,Sn),!. extractNegBoxNegC(X,[A|S],Sx,[A|Sn]) :- extractNegBoxNegC(X,S,Sx,Sn),!. /* 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),!. /* Second side condition for box - rule */ secondSideCond(X,C,S,Sm) :- member([U < X],S), member([U,C],S), member([U,box neg C],S), secondRec(U,S,Sm). /**/ 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 list in box - rule */ genSmList(_,_,[],[]). genSmList(X,Y,[[X,box neg D]|S],[[Y,neg D]|[[Y,box neg D]|Sm]]) :- genSmList(X,Y,S,Sm),!. genSmList(X,Y,[_|S],Sm) :- genSmList(X,Y,S,Sm),!. /* Generates the SComplement list in box - rule */ genSmCompList(_,_,_,[],[]). genSmCompList(X,Y,C,[[X,neg box neg C]|S],Sc) :- genSmCompList(X,Y,C,S,Sc),!. genSmCompList(X,Y,C,[[X,neg box neg D]|S],[[Y,neg box neg D or D]|Sc]) :- genSmCompList(X,Y,C,S,Sc),!. genSmCompList(X,Y,C,[_|S],Sc) :- genSmCompList(X,Y,C,S,Sc),!. /* 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),!. /* generates list K for phase2 */ getK([],_,[]). getK([[X,neg box neg C]|S],Lt,[[X,neg box neg C]|K]) :- member(C,Lt), getK(S,Lt,K),!. getK([[_,neg box neg _]|S],Lt,K) :- getK(S,Lt,K),!. getK([_|S],Lt,K) :- getK(S,Lt,K),!. /* copies a list into another */ copyList([],[]). copyList(Hd,Hd). coptList([Hd|Tl],[Hd|L2]) :- copyList(Tl,L2),!.