2multifile_data(F/A):- multifile(F/A), dynamic(F/A), discontiguous(F/A).
    3
    4:- multifile_data(cgr/3).    5:- multifile_data(cg/4).    6:- multifile_data(cgc/5).    7
    8:- multifile_data(isa_cg/2).    9:- multifile_data(isa_rel/2).   10:- multifile_data(ind/3).   11:- multifile_data(reldef/3).   12:- multifile_data(isa_kind/4).   13:- multifile_data(typedef/3).   14
   15
   16
   17
   18:- dynamic(ex_c/3).   19:- dynamic(sp_c/3).   20:- dynamic(broi/1).   21:- dynamic(broig/1).   22:- dynamic(top/1).   23:- dynamic(bottom/1).   24:- dynamic(u_conc/3).   25:- expects_dialect(sicstus).   26:- use_module(library(lists)).   27:- dynamic(params/1).   28
   29:- include(library('../test/cgworld/CGKB.kb')).   30:- include(library('../test/cgworld/Type_Hierarchy.kb')).   31
   32isConcept(ID):- grounded(id(g), ID), cgc(ID, _, _, _, _).
   33isCG(ID):- grounded(id(g), ID), cg(ID, _, _, _).
   34
   35grounded(_, G):- ground(G), !.
   36grounded(id(_), _):- !.
   37
   38isRelation(Name):- cgr(Name, _, _).
   39
   40isSimpleConcept(ID):- grounded(id(g), ID), cgc(ID, simple, _, _, _).
   41isSituationConcept(ID):- grounded(id(g), ID), cgc(ID, complex, _, _, _).
   42isSimpleGraph(ID):- grounded(id(g), ID), cg(ID, _, _, F), member(fs(kind, normal), F).
   43isContextGraph(ID):- grounded(id(g), ID), cg(ID, _, _, F), member(fs(kind, context), F).
   44isBofContextGraph(ID):- 	grounded(id(g), ID), cg(ID, _, F, _), member(fs(kind, body_of_context), F).
   45isBCTDefGraph(ID):- grounded(id(g), ID), cg(ID, _, _, F),
   46    member(fs(kind, body_of_concept_type_def), F).
   47isBRTDefGraph(ID):- grounded(id(g), ID), cg(ID, _, _, F),
   48    member(fs(kind, body_of_rel_type_def), F).
   49isTypeDefGraph(ID):- grounded(id(g), ID), cg(ID, _, _, F),
   50    member(fs(kind, typedef), F).
   51isRelDefGraph(ID):- grounded(id(g), ID), reldef(ID, _, _).
   52isCLabel(Lbl):- grounded(label, Lbl), cgc(_, simple, Lbl, _, _).
   53isTLabel(Lbl):- grounded(label, Lbl), cg(Lbl, _, _, F),
   54    member(fs(kind, typedef), F).
   55
   56
   57
   58isUsedId(ID):- (
   59    isConcept(ID);
   60    isCG(ID);
   61    isTypeDefGraph(ID);
   62    isRelDefGraph(ID)
   63    ).
   64
   65
   66listId(L):- findall(Id, cgc(Id, _, _, _, _), CgcL),
   67    findall(Id, cg(Id, _, _, _), CgL), append(CgcL, CgL, L1),
   68    findall(Id, (cg(Id, _, _, F), member(fs(kind, typedef), F)), TL),
   69    findall(Id, (cg(Id, _, _, F), member(fs(kind, reldef), F)), RL),
   70    append(TL, RL, L2), append(L1, L2, L).
   71
   72broiId(Id):- listId(L), max_el(L, Id),
   73    X is (1 + '//'(Id , 10000000)) * 10000000,
   74    max_el([Id, X], XId),
   75    asserta(broi(XId)).
   76
   77max_el(L, E):- mel(L, -1, E).
   78mel([], E, E).
   79mel([H|T], N, E):- ground(H), (H>=N -> mel(T, H, E));mel(T, N, E).
   80
   81:- broiId(_X).   82
   83newId(Id):- retract(broi(I)), !, sum1(I, Id), asserta(broi(Id)).
   84sum1(X, X1):- X1 is X+1.
   85
   86/*supRef(super_referent, referent)*/
   87supRef([], [fs(type, quest)]).
   88supRef([], [fs(quant, lambda)]).
   89supRef([], [fs(quant, every)]).
   90supRef([fs(num, sing)], [fs(num, sing)]).
   91supRef([], [fs(name, _)]).
   92supRef([], [fs(refID, _)]).
   93supRef([fs(num, plur)], [fs(num, plur)]).
   94supRef([], [fs(type, def)]).
   95supRef([], [fs(type, meas)]).
   96supRef([], [fs(quant, _)]).
   97supRef([], [fs(set_type, _)]).
   98
   99/*subRef(subreferent, referent)*/
  100subRef([], [fs(type, quest)]).
  101subRef([], [fs(quant, lambda)]).
  102subRef([], [fs(quant, every)]).
  103subRef([fs(num, sing)], [fs(num, sing)]).
  104/*subRef([fs(refID, V)], [fs(num, sing)]).*/
  105subRef([fs(num, plur)], [fs(num, plur)]).
  106subRef([fs(name, N)], [fs(name, N)]).
  107subRef([fs(refID, ID)], [fs(refID, ID)]).
  108subRef([fs(type, def)], [fs(type, def)]).
  109subRef([fs(type, meas)], [fs(type, meas)]).
  110subRef([fs(quant, N)], [fs(quant, N)]).
  111subRef([fs(set_type, T)], [fs(set_type, T)]).
  112
  113/*HIERARCY*/
  114/*sub(X, Y) check if X is subtype of Y*/
  115sub(X, X).
  116sub(X, Y):- isa_cg(X, Y), !.
  117sub(X, Y):- isa_cg(X, Z), sub(Z, Y).
  118
  119suptype(X, Y, X):- sub(Y, X), !.
  120suptype(X, Y, Y):- sub(X, Y).
  121
  122subtype(X, Y, X):- sub(X, Y), !.
  123subtype(X, Y, Y):- sub(Y, X).
  124
  125/*subrel(subrel_type, rel_type) this prodcedure may be needless if relation hierarcy introduces with isa_cg/2 clause*/
  126
  127subrel(X, Y):- X==Y, !;isa_rel(X, Y).
  128subrel(X, Y):- isa_rel(X, Z), !, subrel(Z, Y).
  129
  130subrels(X, Y, Y):- subrel(X, Y).
  131subrels(X, Y, X):- subrel(Y, X).
  132
  133/*finds common father of the given nodes*/
  134super(A, B, S):- suptype(A, B, S), !;
  135    top(X),
  136    path_up(A, X, S1), path_up(B, X, S2),
  137    waste(S1, S2, S).
  138
  139/*path_up(X, Y, P) path from X to Y climbing up*/
  140
  141path_up(X, X, [X]).
  142path_up(X, Y, P) :-  
  143  isa_cg(X, Z), path_up(Z, Y, L), append([X], L, P).
  144
  145path_up_len(_, _, 0, []).
  146path_up_len(X, Y, N, P):- isa_cg(X, Z), N1 is (N-1),
  147    path_up_len(Z, Y, N1, P1), append([X], P1, P).
  148paths_up_len(X, Y, N, P):-
  149    findall(P1, path_up_len(X, Y, N, P1), P).
  150
  151
  152/*finds the first common element of two lists of elements*/
  153waste([H|L], L1, L2):- non_member(H, L1), !,
  154    waste(L, L1, L2).
  155waste([H|_], L1, H):- member(H, L1), !.
  156
  157min_super_type(A, B, S):- if(A=B, S=A,
  158    (findall(S1, super(A, B, S1), S2),
  159    sort(S2, S3), top(X),
  160    min_hel(X, S3, X, S))).
  161
  162/*returns element from the list which is minimal consider hierarcy e.g sybtype of all the other*/
  163min_hel(E, [], Top, E):- E\=Top.
  164min_hel(E, [H|T], Top, M):- sub(H, E), !, min_hel(H, T, Top, M).
  165min_hel(E, [_|T], Top, M):- min_hel(E, T, Top, M).
  166
  167/*C is minimal common supertype, L1 is a path from T1 to C, L2 is the path from T2 to C and T is a path from C to Univ*/
  168minComSuperType(T1, T1, T1, [], [], _).
  169minComSuperType(T1, T2, C, L1, L2, T):-
  170    min_super_type(T1, T2, C), path_up(T1, C, L1),
  171    path_up(T2, C, L2), top(X), path_up(C, X, T).
  172
  173/*finds common son of the given nodes*/
  174below(A, B, S):- subtype(A, B, S), !;bottom(X),
  175    path_down(A, X, S1),
  176    path_down(B, X, S2),
  177    waste(S1, S2, S).
  178
  179/*path_down(X, Y, P) path from X to Y climbing down*/
  180path_down(X, X, [X]).
  181path_down(X, Y, P):- isa_cg(Z, X), path_down(Z, Y, L),
  182    append([X], L, P).
  183
  184max_sub_type(A, B, S):- if(A=B, S=A,
  185    (findall(S1, below(A, B, S1), S2),
  186    sort(S2, S3), bottom(X), max_hel(X, S3, X, S))).
  187
  188/*returns element from the list which is maximal consider hierarcy*/
  189max_hel(E, [], B, E):- E\=B.
  190max_hel(E, [H|T], B, M):- sub(E, H), !, max_hel(H, T, B, M).
  191max_hel(E, [_|T], B, M):- max_hel(E, T, B, M).
  192
  193maxComSubType(T1, T1, T1, [], [], _).
  194maxComSubType(T1, T2, C, L1, L2, B):-
  195    max_sub_type(T1, T2, C), path_down(T1, C, L1),
  196    path_down(T2, C, L2), bottom(X), path_down(C, X, B).
  197
  198/*returns specialization of two list of referents in case of type/subtype relation in corresponding type labels*/
  199referents1(Ref1, Ref2, Ref2):- subset(Ref1, Ref2), !.
  200referents1(Ref1, Ref2, Ref):- subrefs(R1, Ref1), subrefs(R2, Ref2), !,
  201    if(subset(R1, R2), Ref=R2, ref_subt(R1, R2, Ref)).
  202
  203:- discontiguous(ref_subt/3).  204
  205/*PartialSet(1)*/
  206ref_subt(R1, R2, R):- if(subt_case1(R1, R2, R), !, subt_case2(R1, R2, R)).
  207subt_case1(R1, R2, R2):- check_mq(R1, Q1), check_mq(R2, Q2), !,
  208    brel(R1, N), brel(R2, N), Q2>=Q1,
  209    if((member(fs(name, N1), R1), member(fs(name, N2), R2)), 		subset(N1, N2), !).
  210subt_case2(R1, R2, R2):- check_mq(R1, Q1), check_mq(R2, Q2), !, Q2>=Q1,
  211    brel(R1, N), N2 is (N+1), brel(R2, N2), member(fs(name, _), R2).
  212
  213subt_case2(R1, R2, R):- check_mq(R1, Q1), check_mq(R2, Q2), Q2>=Q1,
  214    brel(R2, N), N2 is (N+1), brel(R1, N2), member(fs(name, L), R1),
  215    brel(L, L1), Q2>=L1,
  216    append(R2, [fs(name, L)], R).
  217/*DefiniteSet(1)*/
  218ref_subt(R1, R2, R2):- check_tn(R1, N1), check_tn(R2, N2), brel(R1, N),
  219    brel(R2, N), subset(N1, N2).
  220/*DefiniteSet(2)*/
  221ref_subt(R1, R2, R2):- check_tn(R1, N1), check_mq(R2, Q2), brel(N1, N), Q2>=N.
  222/*PartialSet(2)*/
  223ref_subt(R1, R2, R2):- check_mq(R1, Q1), check_tn(R2, N2), brel(N2, N), N>=Q1.
  224/*NamedIndividual(2) and IndividualMarker(2)*/
  225ref_subt(R1, R2, Ref):- checkId(R1, R2, Ref).
  226
  227check_mq(R, N):- member(fs(type, meas), R), member(fs(quant, N), R).
  228check_tn(R, L):- member(fs(type, def), R), member(fs(name, L), R).
  229check_tq(R, N):- member(fs(quant, N), R), member(fs(type, def), R).
  230
  231
  232/*Named individual case_2 and Individual marker case_2*/
  233checkId(R1, R2, Ref):- if(checkId1(R1, R2, Rf), Ref=Rf, checkId1(R2, R1, Ref)).
  234checkId1(R1, R2, Ref):- member(fs(name, N), R1), member(fs(refID, Id), R2),
  235    ind(Id, N, _), append(R1, R2, Refs), clean(Refs, Ref).
  236
  237/*returns specialization of two list of referents in case common subtype between corresponding type labels*/
  238referents2(Ref1, Ref2, Ref):- supsetr(Ref1, Ref2, Ref), !.
  239referents2(Ref1, Ref2, Ref):- subrefs(R1, Ref1), subrefs(R2, Ref2), !,
  240    if(supsetr(R1, R2, Refs), Ref=Refs, ref_comt(R1, R2, Ref)).
  241
  242ref_comt(Ref1, Ref2, Ref):- ref_sp_case(Ref1, Ref2, Ref), !.
  243ref_comt(Ref1, Ref2, Ref):- ref_comt1(Ref1, Ref2, Ref).
  244/*check in two directions*/
  245ref_comt1(Ref1, Ref2, Ref):- if(ref_comt2(Ref1, Ref2, Ref), !,
  246    ref_comt2(Ref2, Ref1, Ref)).
  247
  248/*PartialSet(1)*/
  249:- discontiguous(ref_comt2/3).  250
  251ref_comt2(R1, R2, R):- if(comt_case1(R1, R2, R), !, comt_case2(R1, R2, R)).
  252
  253comt_case1(R1, R2, R2):- check_mq(R1, Q1), check_mq(R2, Q2), !,
  254    brel(R1, N), brel(R2, N), Q2>=Q1,
  255    if((member(fs(name, N1), R1), member(fs(name, N2), R2)),
  256    subset(N1, N2), !).
  257
  258comt_case2(R1, R2, R2):- check_mq(R1, Q1), check_mq(R2, Q2), !, Q2>=Q1,
  259    brel(R1, N), N2 is (N+1), brel(R2, N2), member(fs(name, _L), R2).
  260
  261comt_case2(R1, R2, R):- check_mq(R1, Q1), check_mq(R2, Q2), Q2>=Q1,
  262    brel(R2, N), N2 is (N+1), brel(R1, N2), member(fs(name, L), R1),
  263    brel(L, L1), Q2>=L1,
  264    append(R2, [fs(name, L)], R).
  265
  266/*DefiniteSet(1)*/
  267ref_comt2(R1, R2, R2):- check_tn(R1, N1), check_tn(R2, N2), brel(R1, N),
  268    brel(R2, N), subset(N1, N2).
  269
  270/*DefiniteSet(2)*/
  271ref_comt2(R1, R2, R):- check_tn(R1, N1), check_mq(R2, Q2), brel(N1, N), Q2>=N,
  272    append(R2, [fs(name, N1)], R).
  273
  274/*PartialSet(2)*/
  275ref_comt2(R1, R2, R2):- check_mq(R1, Q1), check_tn(R2, N2), brel(N2, N), N>=Q1.
  276
  277/*NamedIndividual(2) and IndividualMarker(2)*/
  278ref_comt2(R1, R2, Ref):- checkId(R1, R2, Ref).
  279
  280%Special case
  281ref_sp_case(R1, R2, R):- 	member(fs(num, sing), R1), !, member(fs(num, sing), R2),
  282    member(fs(name, N1), R1), member(fs(name, N2), R2),
  283    append([N1], [N2], N), append([fs(num, plur)], [fs(name, N)], R).
  284
  285ref_sp_case(R1, R2, R):- 	check_tn(R1, L1), check_tn(R2, L2), append(L1, L2, L), !,
  286  if(ref_sp_case1(R1, R2, Rf), (append(Rf, [fs(name, L)], R), !),
  287    (append([fs(type, def)], [fs(num, plur)], S1),
  288     append(S1, [fs(name, L)], R))).
  289ref_sp_case(R1, R2, R):- member(fs(name, L1), R1), member(fs(name, L2), R2),
  290    append(L1, L2, L), append([fs(num, plur)], [fs(name, L)], R).
  291
  292ref_sp_case1(R1, R2, R):- check_mq(R1, Q1), check_mq(R2, Q2),
  293    append([fs(num, plur)], [fs(type, meas)], S1),
  294    append(S1, [fs(type, def)], S2),
  295    Q is Q1+Q2, append(S2, [fs(quant, Q)], R).
  296
  297/*returs superset of two sets; if sets aren't in relation superset/subset then fails*/
  298supsetr(S1, S2, S2):- subset(S1, S2).
  299supsetr(S1, S2, S1):- subset(S2, S1).
  300
  301/*finds subreferents of the list of referents*/
  302subrefs([], []).
  303subrefs(L, [H|T]):- subRef(H1, [H]), !,
  304    subrefs(L1, T), append(H1, L1, L).
  305
  306brel([], 0).
  307brel([_|T], N):- brel(T, N1), N is N1+1.
  308
  309%subset([], _).
  310%subset([E|Sub], Set):- member(E, Set), !, subset(Sub, Set).
  311
  312/*ind(IndID, Name, Type) declares that individual with IndID conforms to the Type, this individual also conforms to all super types of the given type*/
  313conformity(IndID, Type):- ind(IndID, _, Type).
  314conformity(IndID, Type):- isa_cg(SubType, Type), bottom(X),
  315    SubType\=X,
  316    conformity(IndID, SubType).
  317conformity(_, _):- !, fail.
  318
  319conformity1(IndName, Type):- ind(_, IndName, Type).
  320conformity1(IndName, Type):- isa_cg(SubType, Type), bottom(X),
  321    SubType\=X,
  322    conformity1(IndName, SubType).
  323conformity1(_, _):- !, fail.
  324
  325
  326/*check list of referents and if some referent doesn't conform to the type it is removed and returns new list;check only referents with feauture refID*/
  327conform([], _, []).
  328conform([fs(refID, ID)|R], T, [New|R1]):-
  329    if(conformity(ID, T), New=fs(refID, ID), New=[]),
  330    conform(R, T, R1).
  331conform([H|R], T, [H|R1]):- conform(R, T, R1).
  332
  333conform1([], _, []).
  334conform1([fs(name, N)|R], T, [New|R1]):-
  335    if(conformity1(N, T), New=fs(name, N), New=[]),
  336    conform1(R, T, R1).
  337conform1([H|R], T, [H|R1]):- conform1(R, T, R1).
  338check_conformity(R, T, R1):- 	if(conform(R, T, R2), R1=R2, conform1(R, T, R1)).
  339
  340/*unifies concepts with concept labels in relation subtype/type */
  341checku(N1, N2, R1, R2, Id):- sub(N1, N2), referents1(R1, R2, R),
  342    check_conformity(R, N1, NR), exist_cgc(simple, N1, NR, _, Id).
  343
  344
  345/*unifies two concepts and the result is some specialization of the given concepts*/
  346%unifyconc(Cid1, Cid1, Cid1).
  347unifyconc(Cid1, Cid2, Id):-
  348   (cgc(Cid1, simple, N1, Ref1, _),
  349    cgc(Cid2, simple, N2, Ref2, _),
  350    unifysimple(N1, Ref1, N2, Ref2, Id),
  351    assertz(u_conc(Cid1, Cid2, Id)))
  352  ;(cgc(Cid1, complex, N1, RGr1, _),
  353    cgc(Cid2, complex, N2, RGr2, _),
  354    unifysituation(N1, RGr1, N2, RGr2, Id),
  355    assertz(u_conc(Cid1, Cid2, Id))).
  356/*unifyconc(_, _, _):- write('Unification is impossible.'),
  357    !, fail.*/
  358
  359/*if the two concepts are previously unified then returns the unified concept id(g) else performs unification*/
  360unifyconcepts(Cid1, Cid2, Id):-
  361  (u_conc(Cid1, Cid2, Id);u_conc(Cid2, Cid1, Id)), !.
  362unifyconcepts(Cid1, Cid2, Id):- unifyconc(Cid1, Cid2, Id).
  363
  364/*unifies simple concepts*/
  365unifysimple(N1, Ref1, N2, Ref2, Id):-
  366    (checku(N1, N2, Ref1, Ref2, Id), !;
  367    checku(N2, N1, Ref1, Ref2, Id), !;
  368    if(max_sub_type(N1, N2, N),
  369    (referents2(Ref1, Ref2, R),
  370    check_conformity(R, N, NR), !,
  371    exist_cgc(simple, N, NR, _, Id)),
  372    (!, fail))).
  373
  374/*unifies complex concepts*/
  375unifysituation(N1, S1, N2, S2, Id):-
  376    (sub(N1, N2), exist_cgc(complex, N1, S1, _, Id)), !;
  377    (sub(N2, N1), exist_cgc(complex, N2, S2, _, Id)).
  378
  379/*separate list of relations in graph Gid in two lists R and R1, list R consists of all relations that have concept Cid, list R1 consists of all relations that don't have concept Cid*/
  380findrels(Gid, Cid, R, R1):- graph_relations(Gid, G), findrel(Cid, G, R, R1).
  381
  382findrel(_, [], [], []).
  383findrel(Cid, [cgr(N, L, _)|T], [cgr(N, L, _)|T1], L1):-
  384    member(Cid, L), !, findrel(Cid, T, T1, L1).
  385findrel(Cid, [cgr(N, L, _)|T], T1, [cgr(N, L, _)|L1]):-
  386    findrel(Cid, T, T1, L1).
  387
  388/*generates separated lists of realtinos of two graphs*/
  389graphrels(Gid1, Gid2, Cid1, Cid2, C1, R1, C2, R2):-
  390    findrels(Gid1, Cid1, C1, R1),
  391    findrels(Gid2, Cid2, C2, R2),
  392    C1\=[], C2\=[].
  393graphrels(_, _, _, _, _, _, _, _):-
  394    write('No compatible triples of relations'), !, fail.
  395
  396/*,,,,,,,,,,,cg_replace every appearance of X in list with Y*/
  397find_rep(_, _, [], []).
  398find_rep(X, Y, [X|T], [Y|T1]):- !, find_rep(X, Y, T, T1).
  399find_rep(X, Y, [H|T], [H|T1]):- !, find_rep(X, Y, T, T1).
  400
  401/*cg_replace every appearance of concept X in rel.list with concept Y*/
  402cg_replace(_, _, [], []).
  403cg_replace(X, Y, [cgr(N, L, _)|T], [cgr(N, L1, _)|T1]):-
  404    find_rep(X, Y, L, L1), !,
  405    cg_replace(X, Y, T, T1).
  406
  407/*cg_replace when it is considered wheather concepts are related to in comming or out comming arcs*/
  408replace_in(_, _, [], []).
  409replace_in(X, Y, [cgr(N, L, _)|T], [cgr(N, L1, _)|T1]):-
  410    inRel(cgr(N, L, _), InR),
  411    outRel(cgr(N, L, _), OutR),
  412    find_rep(X, Y, InR, InR1), append(InR1, OutR, L1),
  413    !, replace_in(X, Y, T, T1).
  414
  415replace_out(_, _, [], []).
  416replace_out(X, Y, [cgr(N, L, _)|T], [cgr(N, L1, _)|T1]):-
  417    inRel(cgr(N, L, _), InR),
  418    outRel(cgr(N, L, _), OutR),
  419    [X]=OutR, append(InR, [Y], L1), !,
  420    replace_out(X, Y, T, T1).
  421replace_out(X, Y, [cgr(N, L, _)|T], [cgr(N, L, _)|T1]):-
  422    replace_out(X, Y, T, T1).
  423
  424inRel(cgr(_, R, _), InR):- append(InR, [_], R).
  425outRel(cgr(_, R, _), [OutR]):- append(_, [OutR], R).
  426
  427/*removes repeated elements in the list*/
  428clean([], []).
  429clean([H|T], T1):- member(H, T), !, clean(T, T1).
  430clean([H|T], [H|T1]):- clean(T, T1).
  431
  432/*removes repeated relations in the list of relation triples in case of different annotations*/
  433cleanr([], []).
  434cleanr([cgr(N, R, _)|T], T1):- member(cgr(N, R, _), T), !,
  435    cleanr(T, T1).
  436cleanr([cgr(N, R, _)|T], [cgr(N, R, _)|T1]):- cleanr(T, T1).
  437
  438/*check if exists graph with relation list R, coreference links CorL, feature kind K, faeture comment C; if exists returns its NGrid else create new graph with NGrid*/
  439exist_cg(R, CorL, K, C, P, NGrid):-
  440    ((cg(N, R, CorL, FS), member(fs(kind, K), FS),
  441    member(fs(comment, C), FS), member(fs(operation, P), FS),
  442    grounded(id(g), N))-> NGrid=N;
  443    (newId(NGrid), assertz(cg(NGrid, R, CorL, [fs(kind, K),
  444    fs(comment, C), fs(operation, P)])))).
  445
  446/*check if exists concept of type K, name T, features F; if exists returns its NC else create new concept*/
  447exist_cgc(K, T, F, _, NC):- (cgc(N, K, T, F, _), grounded(id(g), N))->NC=N;
  448    (newId(NC), assertz(cgc(NC, K, T, F, _))).
  449
  450graph_relations(GrID, Rel):- grounded(id(g), GrID), cg(GrID, Rel, _, _).
  451graph_clinks(GrID, CLinks):- grounded(id(g), GrID), cg(GrID, _, CLinks, _).
  452
  453/*subsumes given concept label with other concept label in coreference link*/
  454help_link([], _, _, []).
  455help_link([identity_line(H)|T], Cid, NCid, NL):- find_rep(Cid, NCid, H, H1),
  456    help_link(T, Cid, NCid, T1), append([identity_line(H1)], T1, NL).
  457
  458/*JOIN OPERATION*/
  459/*join/4;Gid1&Gid2 are graphs identificators and Cid1&Cid2 are identificators of concepts to be joined.Gid3&Cid3 are identificators of the resulted graph and concept*/
  460/*Test join(103, 104, 7, 7, GrID, CID), join(103, 106, 6, 12, GrID, CID),
  461join(100, 110, 7, 7, GrID, CID), join(103, 100, 7, 7, GrID, CID)*/
  462join(Gid1, Gid2, Cid1, Cid1, Gid3, Cid1):-
  463    Param=['join', Gid1, Gid2, Cid1, Cid1, Cid1, Gid3],
  464    if(exist_params(Param, Gid), Gid3=Gid,
  465    (
  466    graph_relations(Gid1, R1), graph_relations(Gid2, R2),
  467    graph_clinks(Gid1, Link1), graph_clinks(Gid2, Link2),
  468    append(Link1, Link2, Link),
  469    append(R1, R2, NRel),
  470    clean(NRel, NR1), clean_help(NR1, NRels),
  471    to_string('This graph is reseived from graphs ', Gid1, Com1),
  472    to_string(' and ', Gid2, Com2), to_string(Com1, Com2, Com3),
  473    to_string(' performing the join operation on concepts with id(g) ', Cid1, Com4),
  474    to_string(Com3, Com4, Com5), to_string(' and ', Cid1, Com6),
  475    to_string(Com5, Com6, Comment),
  476    exist_cg(NRels, Link, joined, Comment, Param, Gid3),
  477    assertz(params(Param)))).
  478
  479join(Gid1, Gid2, Cid1, Cid2, Gid3, Cid3):-
  480    Param=['join', Gid1, Gid2, Cid1, Cid2, Cid3, Gid3],
  481    if(exist_params(Param, Gid), Gid3=Gid,
  482    (
  483    unifyconcepts(Cid1, Cid2, Cid3), !,
  484    graph_clinks(Gid1, Link1), graph_clinks(Gid2, Link2),
  485    help_link(Link1, Cid1, Cid3, L1), help_link(Link2, Cid2, Cid3, L2),
  486    append(L1, L2, L),
  487    graphrels(Gid1, Gid2, Cid1, Cid2, C1, R1, C2, R2),
  488    cg_replace(Cid1, Cid3, C1, NC1),
  489    cg_replace(Cid2, Cid3, C2, NC2),
  490    append(NC1, NC2, NC), append(R1, R2, NR),
  491    append(NC, NR, NRel), !,
  492    clean(NRel, NR1), clean_help(NR1, NRels),
  493    to_string('This graph is reseived from graphs ', Gid1, Com1),
  494    to_string(' and ', Gid2, Com2), to_string(Com1, Com2, Com3),
  495    to_string(' performing the join operation on concepts with id(g) ', Cid1, Com4),
  496    to_string(Com3, Com4, Com5), to_string(' and ', Cid2, Com6),
  497    to_string(Com5, Com6, Comment),
  498    exist_cg(NRels, L, joined, Comment, Param, Gid3),
  499    assertz(params(Param)))).
  500
  501
  502/*join_op/4; Grid1&Grid2 are graphs identificators and L1&L2 are type labels of concepts that have to be joined.Grid3&Cid3 are identificators of the resulted graph and concept*/
  503/*test join_op(103, 'security', 106, 'corporate_bond', GrID, Cid3).*/
  504join_op(Grid1, L1, Grid2, L2, Grid3):-
  505    find_conc(Grid1, Grid2, L1, L2, Cid1, Cid2),
  506    join(Grid1, Grid2, Cid1, Cid2, Grid3, _).
  507
  508/*finds concepts from the list of relation with the given type labels*/
  509find_conc(Grid1, Grid2, L1, L2, Cid1, Cid2):-
  510    graph_relations(Grid1, R1), graph_relations(Grid2, R2),
  511    rel_to_list(R1, Ls1), rel_to_list(R2, Ls2),
  512    (cgc(Cid1, _C1, L1, _F1, _), member(Cid1, Ls1)),
  513    (cgc(Cid2, _C2, L2, _F2, _), member(Cid2, Ls2)), !.
  514
  515max_join(Grid1, Grid1, Grid1).
  516max_join(Grid1, Grid2, NGrid):-
  517    Param=['max_join', Grid1, Grid2, NGrid],
  518    if(exist_params(Param, Grid), NGrid=Grid,
  519    (
  520    graph_relations(Grid1, Rl1), graph_relations(Grid2, Rl2),
  521    comn_relsj(Rl1, Rl2, Rel1, Rel2), (Rel1= [];Rel2 =[]),
  522    compareconsj(Rl1, Rl2, _RelC), all_un(Rl1, Rl2, U),
  523    graph_clinks(Grid1, Link1), graph_clinks(Grid2, Link2),
  524    un_process(U, Rl1, Rl2, NR1, NR2),
  525    un_processl(U, Link1, Link2, L1, L2),
  526    append(NR1, NR2, NR), clean(NR, NRels),
  527    clean_help(NRels, R), !,
  528    (R\=[] -> (to_string('This graph is received from graphs ', Grid1, Com1), to_string(' and ', Grid2, Com2),
  529to_string(Com1, Com2, Com3),
  530to_string(Com3, ' performing the maximal join operation', Comment),
  531    append(L1, L2, L),
  532    exist_cg(R, L, maximal_joined, Comment, Param, NGrid)),
  533    assertz(params(Param))))).
  534max_join(Grid1, Grid2, NGrid):-
  535    Param=['max_join', Grid1, Grid2, NGrid],
  536    if(exist_params(Param, Grid), NGrid=Grid,
  537    (
  538    graph_relations(Grid1, Rl1), graph_relations(Grid2, Rl2),
  539    comn_relsj(Rl1, Rl2, Rel1, Rel2),
  540    razlika(Rl1, Rel1, Rest1), razlika(Rl2, Rel2, Rest2),
  541    comparetrsj(Rel1, Rel2), all_un(Rel1, Rel2, U),
  542    graph_clinks(Grid1, Link1), graph_clinks(Grid2, Link2),
  543    un_process(U, Rel1, Rel2, NR1, NR2),
  544    un_processl(U, Link1, Link2, L1, L2),
  545    un_process(U, Rest1, Rest2, NRest1, NRest2),
  546    append(NR1, NR2, NR), clean(NR, NRels),
  547    append(NRels, NRest1, S), append(S, NRest2, S1), clean(S1, NRel),
  548    clean_help(NRel, R), !,
  549    (R\=[] -> (to_string('This graph is received from graphs ', Grid1, Com1), to_string(' and ', Grid2, Com2),
  550    to_string(Com1, Com2, Com3),
  551    to_string(Com3, ' performing the maximal join operation', Comment),
  552    append(L1, L2, L),
  553    exist_cg(R, L, maximal_joined, Comment, Param, NGrid)),
  554    assertz(params(Param))))).
  555
  556compareconsj(Rel1, Rel2, L):- rel_to_list(Rel1, L1), rel_to_list(Rel2, L2),
  557    conceptsunify(L1, L2, Lm), !, clean(Lm, L).
  558conceptsunify([], _, []).
  559conceptsunify([H|L1], L2, L):- conceptun(H, L2, H1), conceptsunify(L1, L2, T), append(H1, T, L).
  560
  561conceptun(_, [], []).
  562conceptun(C, [H|T], UC):- unifyconcepts(C, H, C1), conceptun(C, T, U1), append([C1], U1, UC).
  563conceptun(C, [_H|T], UC):- conceptun(C, T, UC).
  564
  565
  566/*GENERALIZATION OPERATION*/
  567/*finds minimal common supertype of the given types*/
  568gentype(T1, T2, Type):- suptype(T1, T2, Type), !;
  569    if(min_super_type(T1, T2, T), Type=T, Type=[]).
  570
  571
  572/*finds some generalization of two lists of referents*/
  573genref(R1, R2, R):- suprefs(Ref1, R1), suprefs(Ref2, R2), !,
  574    sec(Ref1, Ref2, R).
  575
  576/*returns list S of supreferents of the given list of referents*/
  577suprefs([], []).
  578suprefs(L, [H|T]):- supRef(H1, [H]), suprefs(L1, T),
  579    append(H1, L1, L).
  580
  581referents(R1, R2, R):- referents1(R1, R2, R).
  582referents(R1, R2, R):- referents2(R1, R2, R).
  583
  584/*returs the generalize concept of the given concepts*/
  585extend_conc(Cid1, Cid2, NCid):-
  586ex_c(Cid1, Cid2, NCid), !.
  587extend_conc(Cid1, Cid2, NCid):-
  588extend_concept(Cid1, Cid2, NCid).
  589
  590extend_concept(Cid, Cid, Cid).
  591extend_concept(Cid1, Cid2, NCid):-
  592    (cgc(Cid1, simple, T1, R1, _),
  593    cgc(Cid2, simple, T2, R2, _),
  594    extend_simple(T1, R1, T2, R2, NCid),
  595    assertz(ex_c(Cid1, Cid2, NCid))), !;
  596    (cgc(Cid1, complex, T1, R1, _),
  597    cgc(Cid2, complex, T2, R2, _),
  598    extend_sit(T1, T2, R1, R2, NCid),
  599    assertz(ex_c(Cid1, Cid2, NCid))).
  600
  601extend_simple(T1, R1, T2, R2, NCid):-
  602    (gentype(T1, T2, T), T\=[],
  603    genref(R1, R2, R), exist_cgc(simple, T, R, _, NCid));!, fail.
  604
  605extend_sit(T1, T2, R1, R2, NCid):-
  606    (sub(T1, T2), exist_cgc(complex, T2, R2, _, NCid));
  607    (sub(T2, T1), exist_cgc(complex, T1, R1, _, NCid));
  608    (gentype(T1, T2, S), exist_cgc(complex, S, [], _, NCid));!, fail.
  609
  610/*returns some generalization of 2 lists of concepts*/
  611comparel([], _, []).
  612comparel(_, [], []).
  613comparel([H|T], [H1|T1], [Id|L]):- extend_conc(H, H1, Id),
  614    !, comparel(T, T1, L).
  615
  616help_links([], []).
  617help_links([identity_line([H1, H2])|T], NL):- 		if((ex_c(H1, _, I1);ex_c(_, H1, I1)), NI1=I1, NI1=H1),
  618    if((ex_c(H2, _, I2);ex_c(_, H2, I2)), NI2=I2, NI2=H2), help_links(T, T1),
  619    append([identity_line([NI1, NI2])], T1, NL).
  620
  621/*generalization(GrID1, GrID1, GenGrID);test generalization(103, 106, GenId), generalization(103, 138, GenId) generalization(103, 104, GenID), generalization(106, 107, GenGrID)...*/
  622
  623generalization(Gid1, Gid1, Gid1).
  624generalization(Grid1, Grid2, NGrid):-
  625    Param=['generalization', Grid1, Grid2, NGrid],
  626    if(exist_params(Param, Grid), NGrid=Grid,
  627    (
  628    comn_rels(Grid1, Grid2, Rel1, Rel2),
  629    comparetrs(Rel1, Rel2, R1), clean_help(R1, R), !,
  630    (R\=[] -> (to_string('This graph is received from graphs ', Grid1, Com1), to_string(' and ', Grid2, Com2),
  631    to_string(Com1, Com2, Com3),
  632    to_string(Com3, ' performing the generalization operation', Comment), graph_clinks(Grid1, L1), graph_clinks(Grid2, L2),
  633    append(L1, L2, L3), help_links(L3, L),
  634    exist_cg(R, L, generalized, Comment, Param, NGrid)),
  635    assertz(params(Param))))).
  636
  637/*finds common relations, e.g relations with equal names of graphs Gid1 and Gid2*/
  638comn_rels(Grid1, Grid2, Rel1, Rel2):-
  639    graph_relations(Grid1, R1), graph_relations(Grid2, R2),
  640    comn(R1, R2, Rl2), comn(R2, R1, Rl1),
  641    cleanr(Rl2, Rel2), cleanr(Rl1, Rel1).
  642
  643comn([], _, []).
  644comn([cgr(N, _, _)|T], S, R):- new_list(S, N, S1), comn(T, S, S2), append(S1, S2, R), !.
  645
  646new_list([], _, []).
  647new_list([cgr(N, S, _)|T], N, [cgr(N, S, _)|T1]):-
  648    new_list(T, N, T1).
  649new_list([_|T], N, L):- new_list(T, N, L).
  650
  651/*returns new list of triples which are some generalization of the given lists of triples*/
  652comparetrs([], _, []).
  653comparetrs([H|T], R2, R):- new_trs(H, R2, S), comparetrs(T, R2, S1), append(S, S1, Rel), clean(Rel, R), !.
  654
  655new_trs(_, [], []).
  656new_trs(cgr(N, R1, _), [cgr(N, R2, _)|T], [cgr(N, R, _)|Rl]):- comparel(R1, R2, R),
  657    new_trs(cgr(N, R1, _), T, Rl).
  658new_trs(cgr(N, R, _), [_|T], Rl):- new_trs(cgr(N, R, _), T, Rl).
  659
  660/*generalize_graph(GrID, NGrID)*/
  661/*test generalize_graph(106, NGrID), generalize_graph(155, NGrID)
  662    generalize_graph(1057, NGrID).*/
  663generalize_graph(GrID, NGrid):- Param=['generalize_graph', GrID, NGrid],
  664    if(exist_params(Param, Grid), NGrid=Grid,
  665    (
  666    graph_relations(GrID, R), !,
  667    gen_help(R, Gn), tripls(R, Rels, Gn), clean_help(Rels, Rel),
  668    to_string('This graph is received from graph ', GrID, Com1),
  669    to_string(Com1, ' performing the generalization operation', Comment),
  670    graph_clinks(GrID, L), help_links1(L, Gn, NL),
  671    exist_cg(Rel, NL, generalized, Comment, Param, NGrid),
  672    assertz(params(Param)))).
  673
  674help_links1([], _, []).
  675help_links1([identity_line([C1, C2])|T], Gn, L):-
  676    if(memb_gen(C1, Gn, C3), NC1=C3, NC1=C1),
  677    if(memb_gen(C2, Gn, C4), NC2=C4, NC2=C2),
  678    help_links1(T, Gn, T1),
  679    append([identity_line([NC1, NC2])], T1, L).
  680memb_gen(C1, [gen(C1, C2)|_], C2).
  681memb_gen(C1, [_|T], C2):- memb_gen(C1, T, C2).
  682
  683gen_help(R, PL):- rel_to_list(R, L), clean(L, L1), gen_tl(L1, PL).
  684gen_tl([], []).
  685gen_tl([C|T], PL):- apply_lbl(C, L), gen_tl(T, P), append([L], P, PL).
  686
  687apply_lbl(C, E):- cgc(C, K, T, F, Cm), !, isa_res(T, T1),
  688    exist_cgc(K, T1, F, Cm, NC), E=gen(C, NC).
  689
  690isa_res(L, NL):- if((isa_cg(L, L1), top(U), dif(L1, U)), NL=L1, NL=L).
  691
  692tripls([], [], _).
  693tripls([cgr(N, R1, _)|T1], [cgr(N, R2, _)|T2], Gn):-
  694    list_css(R1, R2, Gn), tripls(T1, T2, Gn).
  695list_css([], [], _).
  696list_css([C1|R1], [C2|R], Gn):- member(gen(C1, C2), Gn),
  697    list_css(R1, R, Gn).
  698
  699/*general_conc_in_graph(GrID, ConcLabel, NGrID); test general_conc_in_graph(106, 'corporate_bond', NGrID),
  700general_conc_in_graph(103, 'security', NGrID)*/
  701general_conc_in_graph(Grid, Lbl, NGrid):-
  702    Param=['gen_conc_gr', Grid, Lbl, NGrid],
  703    if(exist_params(Param, Grid1), NGrid=Grid1,
  704    (
  705    cg(Grid, Rel, _, _), rel_to_list(Rel, List),
  706    (cgc(Cid, K, Lbl, Fs, _), member(Cid, List)), !,
  707    isa_cg(Lbl, SLbl), exist_cgc(K, SLbl, Fs, _, Cid1),
  708    cg_replace(Cid, Cid1, Rel, NR), clean_help(NR, NRel),
  709    to_string('This graph is received from graph ', Grid, Com1),
  710    to_string(' by generalizing the concept with label ', Lbl, Com2),
  711    to_string(Com1, Com2, Comment), graph_clinks(Grid, L),
  712    help_link(L, Cid, Cid1, NL),
  713    exist_cg(NRel, NL, generalized, Comment, Param, NGrid),
  714    assertz(params(Param)))).
  715
  716/*specialization(GrID1, GrID1, SpecGrID)*/
  717/*test specialization(103, 106, NGrID)*/
  718specialization(Grid1, Grid1, Grid1).
  719specialization(Grid1, Grid2, NGrid):-
  720    Param=['specialization', Grid1, Grid2, NGrid],
  721    if(exist_params(Param, Grid), NGrid=Grid,
  722    (
  723    comn_rels(Grid1, Grid2, Rel1, Rel2),
  724    comparetrs1(Rel1, Rel2, NR), clean_help(NR, R), !,
  725    (R\=[] -> (to_string('This graph is received from graphs ', Grid1, Com1), to_string(' and ', Grid2, Com2),
  726    to_string(Com1, Com2, Com3),
  727    to_string(Com3, ' performing the specialization operation', Comment),
  728    graph_clinks(Grid1, L1), graph_clinks(Grid2, L2),
  729    append(L1, L2, L3), help_links_sp(L3, L),
  730exist_cg(R, L, specialized, Comment, Param, NGrid)),
  731    assertz(params(Param))))).
  732
  733/*returns new list of triples which are some specialization of the given lists of triples*/
  734comparetrs1([], _, []).
  735comparetrs1([H|T], R2, R):- new_trs1(H, R2, S), comparetrs1(T, R2, S1), append(S, S1, R), !.
  736
  737new_trs1(_, [], []).
  738new_trs1(cgr(N, R1, _), [cgr(N, R2, _)|T], [cgr(N, R, _)|Rl]):-
  739    comparel_spec(R1, R2, R),
  740    new_trs1(cgr(N, R1, _), T, Rl).
  741new_trs1(cgr(N, R, _), [_|T], Rl):- new_trs1(cgr(N, R, _), T, Rl).
  742
  743/*returns some specialization of 2 lists of concepts*/
  744comparel_spec([], _, []).
  745comparel_spec(_, [], []).
  746comparel_spec([H|T], [H1|T1], [Id|L]):- spec_conc(H, H1, Id),
  747    !, comparel_spec(T, T1, L).
  748
  749spec_conc(Cid1, Cid2, NCid):-
  750sp_c(Cid1, Cid2, NCid), !.
  751spec_conc(Cid1, Cid2, NCid):-
  752spec_concept(Cid1, Cid2, NCid).
  753
  754spec_concept(Cid, Cid, Cid).
  755spec_concept(Cid1, Cid2, NCid):-
  756    (cgc(Cid1, simple, T1, R1, _),
  757    cgc(Cid2, simple, T2, R2, _),
  758    spec_simple(T1, R1, T2, R2, NCid),
  759    assertz(sp_c(Cid1, Cid2, NCid))), !;
  760    (cgc(Cid1, complex, T1, R1, _),
  761    cgc(Cid2, complex, T2, R2, _),
  762    spec_sit(T1, T2, R1, R2, NCid),
  763    assertz(sp_c(Cid1, Cid2, NCid))).
  764
  765spec_simple(T1, R1, T2, R2, NCid):-
  766    (spectype(T1, T2, T), T\=[],
  767    referents(R1, R2, R), exist_cgc(simple, T, R, _, NCid));!, fail.
  768spec_sit(T1, T2, R1, R2, NCid):-
  769    (sub(T1, T2), exist_cgc(complex, T1, R1, _, NCid));
  770    (sub(T2, T1), exist_cgc(complex, T2, R2, _, NCid));
  771    (spectype(T1, T2, S), exist_cgc(complex, S, [], _, NCid));!, fail.
  772help_links_sp([], []).
  773help_links_sp([identity_line([H1, H2])|T], NL):- 		if((sp_c(H1, _, I1);sp_c(_, H1, I1)), NI1=I1, NI1=H1),
  774    if((sp_c(H2, _, I2);sp_c(_, H2, I2)), NI2=I2, NI2=H2),
  775    help_links_sp(T, T1),
  776    append([identity_line([NI1, NI2])], T1, NL).
  777
  778
  779/*specialize_graph(GrID, NGrID); test specialize_graph(103, NGrID)*/
  780specialize_graph(GrID, NGrid):- Param=['spec_graph', GrID, NGrid],
  781    if(exist_params(Param, Grid1), NGrid=Grid1,
  782    (
  783    graph_relations(GrID, R), !,
  784    gen_help1(R, Sp), tripls1(R, Rh, Sp), clean_help(Rh, Rel),
  785    to_string('This graph is received from graph ', GrID, Com1),
  786    to_string(Com1, ' performing the specialization operation', Comment), graph_clinks(GrID, L),
  787    help_links1_sp(L, Sp, NL),
  788    exist_cg(Rel, NL, specialized, Comment, Param, NGrid),
  789    assertz(params(Param)))).
  790
  791help_links1_sp([], _, []).
  792help_links1_sp([identity_line([C1, C2])|T], Sp, L):-
  793    if(memb_sp1(C1, Sp, C3), NC1=C3, NC1=C1),
  794    if(memb_sp1(C2, Sp, C4), NC2=C4, NC2=C2),
  795    help_links1_sp(T, Sp, T1),
  796    append([identity_line([NC1, NC2])], T1, L).
  797memb_sp1(C1, [spec(C1, C2)|_], C2).
  798memb_sp1(C1, [_|T], C2):- memb_sp1(C1, T, C2).
  799
  800gen_help1(R, PL):- rel_to_list(R, L), clean(L, L1), gen_tl1(L1, PL).
  801gen_tl1([], []).
  802gen_tl1([C|T], PL):- apply_lbl1(C, L), gen_tl1(T, P), append([L], P, PL).
  803
  804apply_lbl1(C, E):- cgc(C, K, T, F, Cm), !, isa_res1(T, T1),
  805    exist_cgc(K, T1, F, Cm, NC), E=spec(C, NC).
  806
  807isa_res1(L, NL):- if((isa_cg(L1, L), bottom(B), dif(L1, B)), NL=L1, NL=L).
  808
  809tripls1([], [], _).
  810tripls1([cgr(N, R1, _)|T1], [cgr(N, R2, _)|T2], Sp):-
  811    list_css1(R1, R2, Sp), tripls1(T1, T2, Sp).
  812list_css1([], [], _).
  813list_css1([C1|R1], [C2|R], Sp):- member(spec(C1, C2), Sp),  list_css1(R1, R, Sp).
  814
  815/*test special_conc_in_graph(106, corporate_bond, NGrID)*/
  816special_conc_in_graph(Grid, Lbl, NGrid):-
  817    Param=['spec_conc_gr', Grid, Lbl, NGrid],
  818    if(exist_params(Param, Grid1), Grid1=NGrid,
  819    (
  820    cg(Grid, Rel, _, _), rel_to_list(Rel, List),
  821    (cgc(Cid, K, Lbl, Fs, _), member(Cid, List)), !,
  822    isa_cg(SLbl, Lbl), exist_cgc(K, SLbl, Fs, _, Cid1),
  823    cg_replace(Cid, Cid1, Rel, NRels), clean_help(NRels, NRel),
  824    to_string('This graph is received from graph ', Grid, Com1),
  825    to_string(' by specializing the concept with label ', Lbl, Com2),
  826    to_string(Com1, Com2, Comment), graph_clinks(Grid, L),
  827    help_link(L, Cid, Cid1, NL),
  828    exist_cg(NRel, NL, specialized, Comment, Param, NGrid),
  829    assertz(params(Param)))).
  830
  831
  832spectype(T1, T2, T):- if(max_sub_type(T1, T2, Type), T=Type, T=[]).
  833
  834/*PROJECTION*/
  835/*V:[Person]<-(agnt)<-[Eat].
  836U:[Girl]<-(agnt)<-[Eat]->(manr)->[Fast].
  837projection V->U:[Girl]<-(agnt)<-[Eat]. Projection from some general graph to some specialized graph e.g query to knowledge base*/
  838
  839/*projections_conc(General_graph, Spesific_graph, Projections); finds all projections from General graph to Specific graph considering relations with equal names*/
  840/*Test projections_conc(103, 106, Grs), projections_conc(1055, 1057, Grs), projections_conc(1055, 1053, Grs), projections_conc(1058, 106, , Grs),
  841projections_conc(100, 1053, Grs)*/
  842
  843projections_conc(Gid1, Gid2, NGids):-
  844findall(NGid, projection_conc(Gid1, Gid2, NGid), NGids1),
  845    (NGids1\=[]-> NGids=NGids1;
  846    write('No projections')).
  847
  848projection_conc(Gid1, Gid2, NGrid):-
  849    Param=['projection', Gid1, Gid2, NGrid],
  850    if(exist_params(Param, Grid), NGrid=Grid,
  851    (
  852    if(common_relsp1(Gid1, Gid2, Rel1, Rel2),
  853    (project1(Rel1, Rel2, NRel), clean_help(NRel, Rel),
  854    (Rel\=[]->
  855    (to_string('This graph is received from graphs ', Gid1, Com1), to_string(' and ', Gid2, Com2), to_string(Com1, Com2, Com3),
  856to_string(Com3, ' by performing the projection operation', Comment),
  857    graph_clinks(Gid2, L2), clean_links(L2, Rel2, L),
  858    exist_cg(Rel, L, projected, Comment, Param, NGrid)))),
  859    proj_simple(Gid1, Gid2, NGrid)))).
  860
  861proj_simple(Gid1, Gid2, C):- graph_relations(Gid1, R1),
  862    graph_relations(Gid2, R2), rel_to_list(R1, L1),
  863    rel_to_list(R2, L2), obh(L1, L2, C).
  864
  865obh([], _, _):- !, fail.
  866obh([C1|_], L, C):- obh1(C1, L, C), !.
  867obh([_|T], L, C):- obh1(T, L, C).
  868
  869obh1(_, [], _).
  870obh1(C1, [C2|_], C):- cgc(C1, simple, T1, F1, _), cgc(C2, simple, T2, F2, _),
  871    max_sub_type(T1, T2, T), !, project_referents(F1, F2),
  872    exist_cgc(simple, T, F2, _, C).
  873obh1(C1, [_|T], C):- obh1(C1, T, C).
  874
  875clean_links(L1, R, L):- rel_to_list(R, Lst), clean(Lst, Lst1), clean_lnk(L1, Lst1, L), !.
  876clean_lnk([], _, []).
  877clean_lnk([identity_line([C1, C2])|T], Lst, L):-
  878    cgp_not_member(C1, Lst), cgp_not_member(C2, Lst),
  879    clean_lnk(T, Lst, L).
  880clean_lnk([H|T], Lst, L):- clean_lnk(T, Lst, L1), append([H], L1, L).
  881
  882common_relsp1(Gid1, Gid2, Rel1, Rel2):- graph_relations(Gid1, Rel1),
  883    graph_relations(Gid2, R), result_trs(Rel1, R, Rel2).
  884
  885result_trs(R1, R2, R):- sub_trs(R1, R2, R), connect_rel(R).
  886
  887sub_trs([], _, []).
  888sub_trs([cgr(N, _, _)|L], Sp, [E|L1]):- memb(cgr(N, _, _), Sp, E),
  889    sub_trs(L, Sp, L1).
  890%sub_trs([_|L], Sp, L1):- sub_trs(L, Sp, L1).
  891memb(cgr(N, _, _), [cgr(N, R, A)|_], cgr(N, R, A)).
  892memb(cgr(N, _, _), [_|L], E):- memb(cgr(N, _, _), L, E).
  893
  894connect_rel(R):- len(R, 1).
  895connect_rel(R):- append(X, Y, R), ((X\=[], Y\=[])->
  896    (rel_to_list(X, L1), rel_to_list(Y, L2),
  897    sec1(L1, L2, R1), !, R1\=[]);fail).
  898
  899project1([], _, []).
  900project1([H|T], R2, R):- new_prs(H, R2, S), project1(T, R2, S1), append(S, S1, R), !.
  901
  902new_prs(_, [], []).
  903new_prs(cgr(N, R1, _), [cgr(N, R2, _)|T], [cgr(N, R, _)|Rl]):- spec(R1, R2, R),
  904    new_prs(cgr(N, R1, _), T, Rl).
  905new_prs(cgr(N, R, _), [_|T], Rl):- new_prs(cgr(N, R, _), T, Rl).
  906
  907/*returns specialization of two list of concepts
  908elements of the second list are specializaton of elements
  909from the first list*/
  910spec(_, [], []).
  911spec([], _, []).
  912spec([H|R1], [H1|R2], [H1|R]):-
  913    (cgc(H, simple, T1, F1, _), cgc(H1, simple, T2, F2, _),
  914    sub(T2, T1), project_referents(F1, F2), spec(R1, R2, R)), !;
  915    (cgc(H, complex, T1, _, _),
  916    cgc(H1, complex, T2, _, _),
  917    sub(T2, T1), spec(R1, R2, R)).
  918/*spec(_, _, [no]).*/
  919
  920project_referents(F1, F2):- razlika(F1, F2, L), (L=[];L=[fs(quant, lambda)]).
  921project_referents(F1, _Dmiles_F2):-
  922    (member_check(fs(quant, every), F1);member_check(fs(num, _), F1)),
  923    cgp_not_member(fs(quant, lambda), F1), cgp_not_member(fs(type, quest), F1),
  924    cgp_not_member(fs(type, def), F1), cgp_not_member(fs(type, meas), F1),
  925    cgp_not_member(fs(name, _), F1), cgp_not_member(fs(refID, _), F1),
  926    cgp_not_member(fs(set_type, _), F1).
  927
  928/*extended projection is projection of general graph to specific in which remaining relation triples of specific graph are merged to projection triples; this operation is very useful for projection of query graph to knowledge base*/
  929extended_projections(Gid1, Gid2, NGids):-
  930    findall(NGid, ext_proj(Gid1, Gid2, NGid), NGids2),
  931    clean_help(NGids2, NGids1),
  932    (NGids1\=[]-> NGids=NGids1;
  933    write('No projections')).
  934/*test ext_proj(1058, 106, Gr), ext_proj(1058, 103, Gr)*/
  935ext_proj(Gid1, Gid2, NGrid):-
  936    Param=['ext_projection', Gid1, Gid2, NGrid],
  937    if(exist_params(Param, Grid), NGrid=Grid,
  938    (
  939    projection_conc(Gid1, Gid2, PGid),
  940    graph_relations(PGid, Rel1),
  941    relsp(Gid1, Gid2, Rel2), append(Rel1, Rel2, NRel),
  942    clean_help(NRel, Rel),
  943    to_string('This graph is received from graphs ', Gid1, Com1), to_string(' and ', Gid2, Com2), to_string(Com1, Com2, Com3),
  944to_string(Com3, ' by performing the extended projection operation', Comment),
  945    graph_clinks(Gid1, L),
  946    exist_cg(Rel, L, ext_projected, Comment, Param, NGrid),
  947    assertz(params(Param)))).
  948
  949relsp(Gid1, Gid2, Rel2):-
  950    graph_relations(Gid1, S1), graph_relations(Gid2, S2),
  951    sec2(S2, S1, Rel1), razlika(S2, Rel1, Rel2).
  952
  953/*TYPE CONTRACTION*/
  954/*Subsumes subgraph of the given concept graph with concept using definition of the type of this concept*/
  955contract_type(Gid, TDef, NGrid):-
  956    Param=['contract_type', Gid, TDef, NGrid],
  957    if(exist_params(Param, Grid1), NGrid=Grid1,
  958    (
  959    cg(TDef, [cgr(def, [Conc, Lexp], _)], _, [fs(kind, typedef)|_]),
  960    cgc(Lexp, complex, _, [GTid], _),
  961    projection_conc(GTid, Gid, PrId),
  962    findgenus(GTid, Cid), find_prgenus(Cid, PrId, Gen),
  963    cgc(Gen, simple, _, Ref, _), exist_cgc(simple, Conc, Ref, _, Id1),
  964    graph_relations(PrId, Rel1), graph_relations(Gid, Rel2),
  965    razlika(Rel2, Rel1, Rel),
  966    cg_replace(Gen, Id1, Rel, Rel4), clean_help(Rel4, Rel3),
  967    to_string('This graph is received from graph ', Gid, Com1), to_string(' by performing the contract_type operation of type: ', Conc, Com2), to_string(Com1, Com2, Comment),
  968    exist_cg(Rel3, _, cotracted_type, Comment, Param, NGrid),
  969    assertz(params(Param)))).
  970
  971type_contraction(Gid, TLbl, NGrid):-
  972    Param=['type_contraction', Gid, TLbl, NGrid],
  973    if(exist_params(Param, Grid1), NGrid=Grid1,
  974    (
  975    cg(_Top_ID, [cgr(def, [Conc, Lexp], _)], _, [fs(kind, typedef)|_]),
  976    cgc(Conc, _, TLbl, _Fs, _),
  977    cgc(Lexp, complex, _, [GTid], _),
  978    projection_conc(GTid, Gid, PrId),
  979    findgenus(GTid, Cid), find_prgenus(Cid, PrId, Gen),
  980    cgc(Gen, simple, _, Ref, _), exist_cgc(simple, TLbl, Ref, _, Id1),
  981    graph_relations(PrId, Rel1), graph_relations(Gid, Rel2),
  982    razlika(Rel2, Rel1, Rel),
  983    cg_replace(Gen, Id1, Rel, Rel4), clean_help(Rel4, Rel3),
  984    to_string('This graph is received from graph ', Gid, Com1), to_string(' by performing the type_contraction operation of type: ', TLbl, Com2), to_string(Com1, Com2, Comment),
  985    exist_cg(Rel3, _, type_contracted, Comment, Param, NGrid),
  986    assertz(params(Param)))).
  987
  988findgenus(Gid, Cid):- graph_relations(Gid, Rels),
  989    rel_to_list(Rels, List),
  990    find_lambda(List, Cid).
  991
  992rel_to_list([], []).
  993rel_to_list([cgr(_, L1, _)|T], L):- rel_to_list(T, T1),
  994    append(L1, T1, L).
  995
  996find_lambda([C|_], C):- cgc(C, _, _, F, _),
  997    member(fs(quant, lambda), F), !.
  998find_lambda([_|T], C):- find_lambda(T, C).
  999
 1000find_prgenus(Gen, PrGraph, PrGen):-
 1001    graph_relations(PrGraph, Rel),
 1002    rel_to_list(Rel, List),
 1003    listfind(Gen, List, PrGen).
 1004
 1005listfind(Gen, [H|_], H):- spec([Gen], [H], _).
 1006listfind(Gen, [_|T], G):- listfind(Gen, T, G).
 1007
 1008findconc([], _, _):- !, fail.
 1009findconc([H|_], L, H):- member(H, L), !.
 1010findconc([_|T], L, C):- findconc(T, L, C).
 1011
 1012razlika([], _, []).
 1013razlika([H|L1], L2, [H|L]):- cgp_not_member(H, L2), !,
 1014    razlika(L1, L2, L).
 1015razlika([_|L1], L2, L):- razlika(L1, L2, L).
 1016
 1017/*TYPE EXPANSION*/
 1018/*type_expansion(Graph_id, Typedef_graph_id, NewGraph_id):
 1019replaces some type label of Graph_id with his definition in Typedef_graph_id*/
 1020type_exp(Grid, T, Relg1, Reld1):-
 1021    cgc(Concept, _, T, _Fs, _),
 1022    cg(_, [cgr(def, [Concept, Lexp], _)], _, [fs(kind, typedef)|_]),
 1023    cgc(Lexp, _, _, [Gr], _),
 1024    graph_relations(Gr, Reld),
 1025    graph_relations(Grid, Relg), findgenus(Gr, Gen),
 1026    findc_number(Relg, T, Num), cgc(Num, simple, T, F, _),
 1027    cgc(Gen, _, T1, _, _), exist_cgc(simple, T1, F, _, Id),
 1028    cg_replace(Num, Id, Relg, Relg1),
 1029    cg_replace(Gen, Id, Reld, Reld1).
 1030
 1031type_expansion(Grid, T, NGrid):-
 1032    Param=['type_expansion', Grid, T, NGrid],
 1033    if(exist_params(Param, Grid1), NGrid=Grid1,
 1034    (
 1035    type_exp(Grid, T, Rg, Rd),
 1036    sec(Rd, Rg, R),
 1037    (R=[] -> (append(Rd, Rg, Rh), clean_help(Rh, Rel));
 1038    (type_exp1(Rd, Rg, R, Rh), clean_help(Rh, Rel))),
 1039    to_string('This graph is received from graph ', Grid, Com1), to_string(' and definition graph of type with label: ', T, Com2), to_string(Com1, Com2, Com3),
 1040to_string(Com3, ' by performing the type_expansion operation', Comment),
 1041    exist_cg(Rel, _, type_expanded, Comment, Param, NGrid),
 1042    assertz(params(Param)))).
 1043type_exp1(Reld, Relg, Rels, Rel):-
 1044    findrep(Rels, Relg, Rep),
 1045    replacement(Rep, Reld, Reld1),
 1046    append(Relg, Reld1, Rel).
 1047
 1048type_expan(Grid, TGrid, Relg1, Reld1):-
 1049    cg(TGrid, [cgr(def, [Concept, Lexp], _)], _, [fs(kind, typedef)|_]),
 1050    cgc(Lexp, _, _, [Gr], _),
 1051    cgc(Concept, _, T, _Fs, _),
 1052    graph_relations(Gr, Reld),
 1053    graph_relations(Grid, Relg), findgenus(Gr, Gen),
 1054    findc_number(Relg, T, Num), cgc(Num, simple, T, F, _),
 1055    cgc(Gen, _, T1, _, _), exist_cgc(simple, T1, F, _, Id),
 1056    cg_replace(Num, Id, Relg, Relg1),
 1057    cg_replace(Gen, Id, Reld, Reld1).
 1058
 1059expand_type(Grid, TGrid, NGrid):-
 1060    Param=['expand_type', Grid, TGrid, NGrid],
 1061    if(exist_params(Param, Grid1), NGrid=Grid1,
 1062    (
 1063    type_expan(Grid, TGrid, Rg, Rd),
 1064    sec(Rd, Rg, R),
 1065    (R=[] -> (append(Rd, Rg, Rh), clean_help(Rh, Rel));
 1066    (type_exp1(Rd, Rg, R, Rh), clean_help(Rh, Rel))),
 1067    to_string('This graph is received from graph ', Grid, Com1), to_string(' and type definition graph ', TGrid, Com2),
 1068    to_string(Com1, Com2, Com3),
 1069    to_string(Com3, ' by performing the expand_type operation', Comment),
 1070    exist_cg(Rel, _, expanded_type, Comment, Param, NGrid),
 1071    assertz(params(Param)))).
 1072
 1073
 1074findc_number(L, T, Num):-
 1075rel_to_list(L, L1), (member(Num, L1), cgc(Num, simple, T, _, _)).
 1076
 1077com_rel(_, [], []).
 1078com_rel(cgr(N, [C|C1], _), [cgr(N, [C|C2], _)|L], R):-
 1079    com_rel(cgr(N, [C|C1], _), L, L1),
 1080    append([rep(C1, C2)], L1, R).
 1081com_rel(cgr(N, [C1|C], _), [cgr(N, [C2|C], _)|L], R):-
 1082    com_rel(cgr(N, [C1|C], _), L, L1),
 1083    append([rep(C1, C2)], L1, R).
 1084com_rel(cgr(N, [C|C1], _), [_|L], L1):-
 1085    com_rel(cgr(N, [C|C1], _), L, L1).
 1086
 1087
 1088findrep([], _, []):- !.
 1089findrep([cgr(N, [C|C1], _)|T], L, R):-
 1090    com_rel(cgr(N, [C|C1], _), L, L1), !, findrep(T, L, L2),
 1091    append(L1, L2, R).
 1092findrep([_|T], L, T1):-  findrep(T, L, T1).
 1093
 1094replacement([], _, []).
 1095replacement([rep(C1, C2)|L], Reld, Reld1):-
 1096    (replace1(C1, C2, Reld, R1), !;
 1097    cg_replace(C1, C2, Reld, R1)),
 1098    replacement(L, Reld, R2),
 1099    append(R1, R2, Reld1).
 1100
 1101replace1([C1], [C2], R1, R2):- cg_replace(C1, C2, R1, R2).
 1102
 1103copygraph(GrID, NGrID):- grounded(id(g), GrID),
 1104    cg(GrID, Rels, Idl, Fs),
 1105    newId(NGrID),
 1106    assertz(cg(NGrID, Rels, Idl, Fs)).
 1107
 1108
 1109/*Services*/
 1110get_concept(Cid, Cgc):- grounded(id(c), Cid), cgc(Cid, K, T, F, A),
 1111    Cgc=cgc(Cid, K, T, F, A).
 1112get_cgcType(Cid, Type):- grounded(id(c), Cid), cgc(Cid, Type, _, _, _).
 1113get_cgcName(Cid, Name):- grounded(id(c), Cid), cgc(Cid, _, Name, _, _).
 1114get_cgcFeature(Cid, Fs):- grounded(id(c), Cid), cgc(Cid, _, _, Fs, _).
 1115get_cgcComment(Cid, Com):- grounded(id(c), Cid), cgc(Cid, _, _, _, Com).
 1116
 1117get_graph(Gid, Cg):- grounded(id(g), Gid), cg(Gid, Rel, CoL, Fs),
 1118    Cg=cg(Gid, Rel, CoL, Fs).
 1119get_cgRelations(Gid, Rel):- grounded(id(g), Gid), cg(Gid, Rel, _, _).
 1120get_cgCoreference(Gid, CoL):- grounded(id(g), Gid), cg(Gid, _, CoL, _).
 1121get_cgComment(Gid, Com):- grounded(id(g), Gid), cg(Gid, _, _, Com).
 1122/*returns list of relations with the given name */
 1123get_RelfromCg(Gid, Rname, Rels):- graph_relations(Gid, R),
 1124    new_list(R, Rname, Rels).
 1125get_RelwithConc(Gid, Cid, Rels):- graph_relations(Gid, R),
 1126    findall(cgr(N, L, A), (member(cgr(N, L, A), R), member(Cid, L)), Rels).
 1127
 1128/*unifies V with the value of the F-Feature in Ref*/
 1129getValue(Ref, F, V ):- grounded(ref, Ref), grounded(feature, F),
 1130    var(V), member(fs(F, V), Ref).
 1131
 1132/*unifies F with feauture which has value V*/
 1133getFeauture(Ref, F, V):- grounded(ref, Ref), grounded(value, V),
 1134    var(F), member(fs(F, V), Ref).
 1135
 1136/*unifies F and V from fs(F, V) with their values*/
 1137getVal(Ref, F, V):- grounded(ref, Ref), var(F),
 1138    var(V), member(fs(F, V), Ref).
 1139
 1140/*finds feature fs(F, _) in the list Ref, change its value with fs(F, V)and returns new list NRef*/
 1141setValue(Ref, F, V, NRef):- grounded(ref, Ref),
 1142    grounded(feature, F), grounded(value, V), ( member(fs(F, V), Ref) -> NRef=Ref )
 1143    ;( (member(fs(F, V1), Ref), V1\==V) ->
 1144    changeValue(Ref, F, V, NRef) )
 1145    ; (append(fs(F, V), Ref, Ref1),
 1146    sort(Ref1, NRef)).
 1147
 1148/*change value of fs(F, _) from the list Ref with fs(F, V) and returns new list of features Ref1*/
 1149changeValue(Ref, F, V, Ref1):- grounded(ref, Ref), grounded(feature, F), grounded(value, V),
 1150    (member(fs(F, V1), Ref), V1\==V)->
 1151    del(fs(F, _), Ref, Ref2),
 1152    append([fs(F, V)], Ref2, Ref3), sort(Ref3, Ref1).
 1153
 1154/*unifies Num with the value of the num-Feature in Ref*/
 1155getRefNum(Ref, Num):- grounded(ref, Ref), var(Num),
 1156    member(fs(num, Num), Ref).
 1157
 1158/*changes the num-Feature in RfIn and returns the result as RfOut*/
 1159setRefNum(RfIn, Num, RfOut):- grounded(ref, RfIn), grounded(id(g), Num), var(RfOut),
 1160    find_rep(fs(num, _), fs(num, Num), RfIn, RfOut).
 1161
 1162
 1163getRefType(Ref, Type):- grounded(ref, Ref), var(Type),
 1164    member(fs(type, Type), Ref).
 1165
 1166setRefType(RfIn, Type, RfOut):- grounded(ref, RfIn), grounded(type, Type), var(RfOut),
 1167    find_rep(fs(type, _), fs(type, Type), RfIn, RfOut).
 1168
 1169addCgFuture(Gid, F1, V1, Fs):- grounded(id(g), Gid), grounded(feature, F1), grounded(value, V1),
 1170    cg(Gid, _, _, Fs1), append(Fs1, [fs(F1, V1)], Fs).
 1171
 1172to_string(S1, S2, S):- name(S1, L1), name(S2, L2), append(L1, L2, L),
 1173    name(S, L).
 1174
 1175paths_up(X, Y, P):- findall(P1, path_up(X, Y, P1), P).
 1176
 1177paths_down(X, Y, P):- findall(P1, path_down(X, Y, P1), P).
 1178
 1179sec([], _, []).
 1180sec([H|T], S2, [H|S]):- member(H, S2), !, sec(T, S2, S).
 1181sec([H|T], S2, S):- non_member(H, S2), !, sec(T, S2, S).
 1182
 1183cgp_not_member(E, L):- non_member(E, L).
 1184
 1185non_member(E, L):- member(E, L), !, fail.
 1186non_member(_, _).
 1187
 1188union1([], L, L).
 1189union1([H|T], L, L1):- member(H, L), !, union1(T, L, L1).
 1190union1([H|T], L, [H|L1]):- union(T, L, L1).
 1191
 1192
 1193len([], 0).
 1194len([_|T], N):- len(T, N1), N is N1+1.
 1195
 1196last_el([H], [H]).
 1197last_el([_|T], E):- last_el(T, E).
 1198
 1199not_last(L, E):- last_el(L, E), !, fail.
 1200not_last(_, _).
 1201
 1202del(E, [E|T], T1):- del(E, T, T1).
 1203del(E, [H|T], [H|T1]):- del(E, T, T1).
 1204del(_, [], []).
 1205
 1206inRels([], []).
 1207inRels([H|T], [H1|T1]):- inRel(H, H1), inRels(T, T1).
 1208    outRels([], []).
 1209outRels([H|T], [H1|T1]):- outRel(H, H1), outRels(T, T1).
 1210
 1211
 1212not_sub(X, Y):- sub(X, Y), !, fail.
 1213not_sub(_, _).
 1214
 1215%dobavka
 1216not_son(X):- isa_cg(X, _), !, fail.
 1217not_son(_).
 1218
 1219find_top(X):- isa_cg(_, X), not_son(X), !, assertz(top(X)).
 1220
 1221:- find_top(_X). 1222
 1223not_father(X):- isa_cg(_, X), !, fail.
 1224not_father(_).
 1225
 1226find_bottom(X):- isa_cg(X, _), not_father(X), !, assertz(bottom(X)).
 1227
 1228:- find_bottom(_X). 1229
 1230depth(Y, 0):- top(Y), !.
 1231depth(X, N):- isa_cg(X, Y), !, depth(Y, N1), N is N1+1.
 1232
 1233depth1(Y, 0):- bottom(Y).
 1234depth1(X, N):- isa_cg(Y, X), !, depth1(Y, N1), N is N1+1.
 1235
 1236%new_join(Grid1, Grid2, NewGrid):-
 1237%cg(Grid1, R1, F1, _), cg(Grid2, R2, F2, _),
 1238%rel_to_list(R1, L1), rel_to_list(R2, L2),
 1239%unification(L1, L2, L).
 1240
 1241sec1([], _, []).
 1242sec1([H|T], L, [H|L1]):- member(H, L), sec1(T, L, L1).
 1243sec1([_|T], L, L1):- sec1(T, L, L1).
 1244
 1245sec2([], _, []).
 1246sec2([H|T], L, [H|L1]):- member1(H, L), !, sec2(T, L, L1).
 1247sec2([_|T], L, L1):- sec2(T, L, L1).
 1248member1(cgr(N, _, _), [cgr(N, _, _)|_]).
 1249member1(cgr(N, L, _), [_|T]):- member1(cgr(N, L, _), T).
 1250
 1251super_type_labels(L, []):- top(L).
 1252super_type_labels(L, S):- isa_cg(L, S1), super_type_labels(S1, S2),
 1253    append([S1], S2, S).
 1254sub_type_labels(L, []):- bottom(L).
 1255sub_type_labels(L, S):- isa_cg(S1, L), sub_type_labels(S1, S2),
 1256    append([S1], S2, S).
 1257/*Replaces all relation wchich point to the same concepts with the same relation but point to different concepts*/
 1258clean_help(R, Rel):- rel_point_to_same_conc(R, RC), razlika(R, RC, RR),
 1259    new_r(RC, NRC), f_rep(NRC, Rep), frepl(Rep, RR, NRR),
 1260    append(NRC, NRR, Rel).
 1261
 1262rel_point_to_same_conc(R, NR):- serv(R, R1), help1(R1, R, NR).
 1263/*make list with elements eqrel(name, concept)*/
 1264serv(R1, R):- subserv(R1, R2), !, clean(R2, R).
 1265subserv([], []).
 1266subserv([H|L], L1):- memb_spec(H, L, E), !, subserv(L, L2), append([E], L2, L1).
 1267subserv([_|L], L1):- subserv(L, L1).
 1268memb_spec(cgr(N, [_, C], _), [cgr(N, [_, C], _)|_], E):-
 1269    E=eqrel(N, C).
 1270memb_spec(cgr(N, [C1, C], _), [_|T], E):- memb_spec(cgr(N, [C1, C], _), T, E).
 1271
 1272help1([], _, []).
 1273help1([eqrel(N, C)|T], R, L):- get_RelwSCN(C, N, R, L1), help1(T, R, L2),
 1274    append(L1, L2, L).
 1275/*returns all relation with name N and second concept Cid*/
 1276get_RelwSCN(Cid, N, R, Rels):-
 1277    findall(cgr(N, [C1, Cid], A), member(cgr(N, [C1, Cid], A), R), Rels).
 1278
 1279new_r([], []).
 1280new_r([H|T], NRel):- new_crel(H, H1), new_r(T, R), append([H1], R, NRel).
 1281new_crel(cgr(N, [C, C1], A), cgr(N, [C, C2], A)):- cgc(C1, Kd, Lb, Fs, _),
 1282    newId(C2), assertz(cgc(C2, Kd, Lb, Fs, rep(C1, C2))).
 1283f_rep(Rel, Rep):- rel_to_list(Rel, Lst),
 1284    findall(rep(C1, C), (member(C, Lst), cgc(C, _, _, _, rep(C1, C)), grounded(id(c), C1)), Rep).
 1285frepl([], R, R).
 1286frepl([rep(C1, C)|T], R, Rel):- cg_replace(C1, C, R, R1), frepl(T, R1, Rel).
 1287
 1288member_check(E, [E|_]):- !.
 1289member_check(E, [_|T]):- member_check(E, T).
 1290
 1291check_idline(identity_line([C1, C2]), L):- member_check(C1, L);
 1292    member_check(C2, L).
 1293
 1294/*procedures of maximal join*/
 1295comn_relsj(R1, R2, Rel1, Rel2):-
 1296    comn(R1, R2, Rl2), comn(R2, R1, Rl1),
 1297    cleanr(Rl2, Rel2), cleanr(Rl1, Rel1).
 1298
 1299/*returns new list of triples which are some specialization of the given lists of triples*/
 1300comparetrsj([], _).
 1301comparetrsj([H|T], R2):- new_trsj(H, R2), comparetrsj(T, R2), !.
 1302
 1303new_trsj(_, []).
 1304new_trsj(cgr(N, R1, _), [cgr(N, R2, _)|T]):-
 1305    comparel_mj(R1, R2),
 1306    new_trsj(cgr(N, R1, _), T).
 1307new_trsj(cgr(N, R, _), [_|T]):- new_trsj(cgr(N, R, _), T).
 1308
 1309comparel_mj([], _).
 1310comparel_mj(_, []).
 1311comparel_mj([H|T], [H1|T1]):- unifyconcepts(H, H1, _),
 1312    !, comparel_mj(T, T1).
 1313
 1314all_un(R1, R2, L):- 	findall(u_conc(C1, C2, K), (u_conc(C1, C2, K), memb_rel(C1, R1),
 1315    memb_rel(C2, R2)), L).
 1316
 1317memb_rel(C, R):- rel_to_list(R, L), member_check(C, L).
 1318un_process([], R1, R2, R1, R2).
 1319un_process([u_conc(C1, C2, Id)|T], R1, R2, NR1, NR2):- 	cg_replace(C1, Id, R1, R11), cg_replace(C2, Id, R2, R22),
 1320    un_process(T, R11, R22, NR1, NR2).
 1321
 1322un_processl([], L1, L2, L1, L2).
 1323un_processl([u_conc(C1, C2, Id)|T], L1, L2, NL1, NL2):-
 1324    help_link(L1, C1, Id, L11), help_link(L2, C2, Id, L22),
 1325    un_processl(T, L11, L22, NL1, NL2).
 1326exist_params(Param, Grid):- params(Param), take_last(Param, Grid),
 1327    grounded(id(g), Grid).
 1328not_exist_params(Param, Grid):- exist_params(Param, Grid), !, fail.
 1329not_exist_params(_, _).
 1330take_last(L, E):- append(_, [E], L).
 1331
 1332:- fixup_exports. 1333
 1334
 1335
 1336
 1337/*
 1338
 1339Warning: findrel/3, which is referenced by
 1340Warning:    /pack/logicmoo_nlu/prolog/cgworld/cgprolog_operations.pl:1047:14: 3-th clause of findrep/3
 1341Warning: kb_index/1, which is referenced by
 1342Warning:    /pack/logicmoo_nlu/prolog/cgworld/cgprolog_translator.pl:63:13: 2-nd clause of add_relations/2
 1343Warning: referents/3, which is referenced by
 1344Warning:    /pack/logicmoo_nlu/prolog/cgworld/cgprolog_operations.pl:728:0: 1-st clause of spec_simple/5
 1345Warning: reldef/3, which is referenced by
 1346Warning:    /pack/logicmoo_nlu/prolog/cgworld/cgprolog_operations.pl:43:24: 1-st clause of isRelDefGraph/1
 1347
 1348*/