1/* COPYRIGHT ************************************************************
    2
    3Conceptual Graph Tools (CGT) - a partial implementation of Sowa's CS Theory
    4Copyright (C) 1990 Miguel Alexandre Wermelinger
    5
    6    This program is free software; you can redistribute it and/or modify
    7    it under the terms of the GNU General Public License as published by
    8    the Free Software Foundation; either version 2 of the License, or
    9    (at your option) any later version.
   10
   11    This program is distributed in the hope that it will be useful,
   12    but WITHOUT ANY WARRANTY; without even the implied warranty of
   13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14    GNU General Public License for more details.
   15
   16    You should have received a copy of the GNU General Public License
   17    along with this program; if not, write to the Free Software
   18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   19
   20************************************************************************/
   21
   22/* AUTHOR(S) ************************************************************
   23
   24Michel Wermelinger
   25Dept. de Informatica, Univ. Nova de Lisboa, Quinta da Torre
   26P - 2825 Monte da Caparica, PORTUGAL
   27Phone: (+351) (1) 295 44 64 ext. 1360  Internet: mw@fct.unl.pt
   28
   29************************************************************************/
   30
   31/* GENERALITIES *********************************************************
   32 
   33File Name	: LOG_OPS.PL
   34Creation Date	: 90/09/04 	By: mw
   35Abbreviations	: mw - Michel Wermelinger 
   36Description	: Implements logical operations with conceptual graphs
   37 
   38************************************************************************/
   39
   40/* HISTORY **************************************************************
   41
   420.0	90/09/04  mw	Definition 4.2.2, erasure/1, insertion/2, double_neg/2
   430.1	90/09/08  mw	Definition 4.2.4, (de)iteration, check predicates
   440.2	90/11/08  mw	changed direct calls to c/3
   450.3     90/12/11  mw    double_negation now handles the empty set of graphs
   461.0     91/01/03  mw    debugged check_deiteration/3 and made it faster
   47
   48************************************************************************/
   49 
   50/* CONTENTS *************************************************************
   51
   52is_neg_context/1	succeeds iff a graph represents a negative context
   53is_double_neg/1		succeeds iff a graph represents a double negation
   54
   55depth/2			returns the depth of a graph or concept
   56evenly_enclosed/1	succeeds iff a graph or concept is evenly enclosed
   57oddly_enclosed/1	succeeds iff a graph or concept is oddly enclosed
   58dominates/2		succeeds iff a context dominates another one
   59
   60erasure/1		erases a given graph
   61insertion/2		inserts a given graph in a given context
   62check_iteration/2	succeeds if the conditions for an iteration are met
   63iteration/3		copies a given graph into a given context
   64check_deiteration/2	succeeds if the conditions for a deiteration are met
   65deiteration/1		deiterates a given graph
   66double_neg/3		draws or removes a double negation
   67
   68	
   69************************************************************************/
   70
   71/************************************************************************
   72
   73			D E F I N I T I O N   4 . 2 . 2
   74
   75************************************************************************/
   76 
   77/* is_neg_context/1 *****************************************************
   78
   79Usage		: is_neg_context(+Graph)
   80Argument(s)	: 	      	   GID
   81Description	: succeeds iff Graph represents a negative context
   82Notes		: 
   83
   84************************************************************************/
   85
   86is_neg_context(GID) :-
   87	g(GID, [p/Id-_], [neg(_)]), p(p/Id, proposition, _, _).
   88
   89/* is_double_neg/1 ******************************************************
   90
   91Usage		: is_double_neg(+Graph)
   92Argument(s)	: 	      	  GID
   93Description	: succeeds iff Graph is a double negation
   94Notes		: 
   95
   96************************************************************************/
   97
   98is_double_neg(g/G1) :-
   99	g(g/G1, [p/P1-_], [neg(_)]), p(p/P1, proposition, [g/G2], _),
  100	g(g/G2, [p/P2-_], [neg(_)]), p(p/P2, proposition, _, p/P1).
  101
  102/************************************************************************
  103
  104			D E F I N I T I O N   4 . 2 . 4
  105
  106************************************************************************/
  107 
  108/* depth/2 **************************************************************
  109
  110Usage		: depth(+Object, -Depth)
  111Argument(s)	: 	   ID	 integer
  112Description	: returns the depth of Object (a graph or concept)
  113Notes		: this predicate assumes Object isn't a list (compound graph)
  114
  115************************************************************************/
  116
  117depth(outer, 0) :- !.
  118depth(g/Id, N) :-
  119	which_context(g/Id, PID), depth(PID, N), !.
  120depth(p/Id, N) :-
  121	which_graph(p/Id, _, GID), depth(GID, M),
  122	( is_neg_context(GID) -> succ(M, N) ; M = N ), !.
  123depth(c/Id, N) :-
  124	which_graph(c/Id, _, GID), depth(GID, N), !.
  125	
  126/* evenly_enclosed/1 ****************************************************
  127
  128Usage		: evenly_enclosed(+Object)
  129Argument(s)	: 	   	     ID
  130Description	: succeeds if Object (a graph or concept) is evenly enclosed
  131Notes		: this predicate assumes Object isn't a list (compound graph)
  132
  133************************************************************************/
  134
  135evenly_enclosed(ID) :-
  136	depth(ID, N), 0 is N mod 2.
  137
  138/* oddly_enclosed/1 *****************************************************
  139
  140Usage		: oddly_enclosed(+Object)
  141Argument(s)	: 	   	    ID
  142Description	: succeeds if Object (a graph or concept) is oddly enclosed
  143Notes		: this predicate assumes Object isn't a list (compound graph)
  144
  145************************************************************************/
  146
  147oddly_enclosed(ID) :-
  148	depth(ID, N), 1 is N mod 2.
  149
  150/* dominates/2 **********************************************************
  151
  152Usage		: dominates(?Context1, ?Context2)
  153Argument(s)	: 	       PID	  PID 
  154Description	: succeeds iff Context1 dominates Context2
  155Notes		: at least one of the arguments must be instantiated
  156		  generates through backtracking all dominating (dominated)
  157		  	contexts of Context2 (by Context1)
  158
  159************************************************************************/
  160
  161dominates(Env1, Env2) :-
  162	p(Env2, _, _, Env1).
  163dominates(Env1, Env2) :-
  164	var(Env2), !, p(TmpEnv, _, _, Env1), dominates(TmpEnv, Env2).
  165dominates(Env1, Env2) :-
  166	p(Env2, _, _, TmpEnv), !, dominates(Env1, TmpEnv).
  167dominates(outer, _).
  168	
  169/************************************************************************
  170
  171			A S S U M P T I O N   4 . 3 . 1
  172
  173************************************************************************/
  174
  175/* erasure/1 ************************************************************
  176
  177Usage		: erasure(+Graph)
  178Argument(s)	: 	    GID
  179Description	: erases Graph
  180Notes		: this predicate assumes Graph is evenly enclosed
  181
  182************************************************************************/
  183
  184erasure(CG) :-
  185	which_context(CG, ID), delete_obj(CG),
  186	( ID = outer
  187	; retract( p(ID, Type, Ref, Env) ), take_graph([CG], Ref, NewRef),
  188	  assert( p(ID, Type, NewRef, Env) )
  189	).
  190
  191/* insertion/2 **********************************************************
  192
  193Usage		: insertion(+Graph, +Context)
  194Argument(s)	: 	      GID      PID
  195Description	: inserts Graph in Context
  196Notes		: this predicate assumes Context is oddly enclosed
  197
  198************************************************************************/
  199
  200insertion(CG, PID) :-
  201	retract( p(PID, Type, Ref, Env) ), put_graph([CG], Ref, NewRef),
  202	assert( p(PID, Type, NewRef, Env) ), update_env(CG, PID).
  203
  204/* check_iteration/2 ****************************************************
  205
  206Usage		: check_iteration(+Graph, +Context)
  207Argument(s)	: 	     	    GID     term
  208Description	: succeeds iff Graph may be iterated into Context 
  209Notes		: 
  210
  211************************************************************************/
  212
  213check_iteration(CG, Env) :-
  214	which_context(CG, ID), ( ID = Env ; dominates(ID, Env) ).
  215 
  216/* iteration/3 **********************************************************
  217
  218Usage		: iteration(+OldGraph, +Context, -NewGraph)
  219Argument(s)	: 	       GID       term	    GID
  220Description	: copies OldGraph into Context returning the copy's ID
  221Notes		: this predicate assumes Context is OldGraph's context
  222			or a context dominated by OldGraph 
  223
  224************************************************************************/
  225
  226iteration(CG, outer, NewCG) :-
  227	copy_graph(CG, NewCG, outer).
  228iteration(CG, PID, NewCG) :-
  229	copy_graph(CG, NewCG, PID), retract( p(PID, Type, Ref, Env) ),
  230	put_graph([NewCG], Ref, NewRef), assert( p(PID, Type, NewRef, Env) ).
  231
  232/* check_deiteration/3 **************************************************
  233
  234Usage		: check_deiteration(+Graph, -Copy, -Context)
  235Argument(s)	: 	      	      GID    GID     term	
  236Description	: succeeds iff Graph may be deiterated because of the presence
  237			of Copy in Context
  238Notes		: 
  239
  240************************************************************************/
  241
  242check_deiteration(CG, Copy, p/Id) :-
  243        which_context(CG, p/P),
  244        ( p/Id = p/P ; dominates(p/Id, p/P) ),
  245        referent(p/Id, GIDs), member(Copy, GIDs), Copy \= CG, is_copy(Copy, CG).
  246check_deiteration(CG, Copy, outer) :-
  247        g(Copy, _, _), Copy \= CG, which_context(Copy, outer), 
  248        is_copy(CG, Copy).
  249
  250/* is_copy/2 ************************************************************
  251
  252Usage		: is_copy(+Object1, +Object2)
  253Argument(s)	: 	    term      term
  254Description	: succeeds iff Object2 is an exact copy of Object1
  255Notes		: Object is a graph, concept, abstraction, referent
  256			or a list of objects
  257
  258************************************************************************/
  259
  260is_copy([O1|List1], [O2|List2]) :-
  261	length(List1, N), length(List2, N), 
  262	map(is_copy(_, _), [O1|List1], [O2|List2]).
  263is_copy(g/G1, g/G2) :-
  264	g(g/G1, [C1-_], []), !, g(g/G2, [C2-_], []), is_copy(C1, C2).
  265is_copy(g/G1, g/G2) :-
  266	g(g/G1, CL1, RL1), dir_reference(CL1, RL1), map(_ =.. _, RL1, RL11),
  267	g(g/G2, CL2, RL2), dir_reference(CL2, RL2), map(_ =.. _, RL2, RL21),
  268	is_copy_rel(RL11, RL21, [], [], Cs1, Cs2), is_copy(Cs1, Cs2).
  269is_copy(ID1, ID2) :-
  270	type(ID1, Type1), referent(ID1, Ref1), basic_ref(Ref1, Basic1),
  271	type(ID2, Type2), referent(ID2, Ref2), basic_ref(Ref2, Basic2),
  272	is_copy(Type1, Type2), is_copy(Basic1, Basic2).
  273is_copy(l/L1, l/L2) :-
  274	l(l/L1, IDs1, GIDs1), l(l/L2, IDs2, GIDs2), is_copy(GIDs1, GIDs2), 
  275	map(copy_parameter(_, _, GIDs1, GIDs2), IDs1, IDs2).
  276is_copy(set(Kind, Set1, X), set(Kind, Set2, X)) :-
  277	subset(Set1, Set2), subset(Set2, Set1).
  278is_copy(X, X).
  279
  280/* is_copy_rel/6 ********************************************************
  281
  282Usage		: is_copy_rel(+Rels1, +Rels2, +CLI1, +CLI2, -CLO1, -CLO2)
  283Argument(s)	: lists
  284Description	: succeeds iff Rels1 is a copy of Rels2, i.e. the same 
  285			relations are connected to the same concepts
  286Notes		: CLI1 and CLI2 (CLO1 and CLO2) are the lists of concepts 
  287			that must be copies before (after) this predicate
  288		  Rels1 and Rels2 are lists of lists with 
  289		  	head = type of relation and tail = connected concepts
  290
  291************************************************************************/
  292
  293is_copy_rel([[Type|Args1]|T1], RL2, CLI1, CLI2, CLO1, CLO2) :-
  294	member([Type|Args2], RL2), 
  295	correspond_args(Args1, Args2, CLI1, CLI2, TmpCL1, TmpCL2),
  296	delete_one([Type|Args2], RL2, TmpRL),
  297	is_copy_rel(T1, TmpRL, TmpCL1, TmpCL2, CLO1, CLO2).
  298is_copy_rel([], [], CL1, CL2, CL1, CL2).
  299
  300/* correspond_args/6 ****************************************************
  301
  302Usage		: correspond_args(+IDs1, +IDs2, +CLI1, +CLI2, -CLO1, -CLO2)
  303Argument(s)	: lists
  304Description	: succeeds iff concepts IDs1 correspond to concepts IDs2
  305Notes		: CLI1 and CLI2 (CLO1 and CLO2) are the lists of concepts 
  306			that must be copies before (after) this predicate
  307
  308************************************************************************/
  309
  310correspond_args([ID1|T1], [ID2|T2], CLI1, CLI2, CLO1, CLO2) :-
  311	nth_member(ID1, CLI1, N), !, nth_member(ID2, CLI2, N),
  312	correspond_args(T1, T2, CLI1, CLI2, CLO1, CLO2).
  313correspond_args([_ID1|_T1], [ID2|_T2], _CLI1, CLI2, _CLO1, _CLO2) :-
  314	member(ID2, CLI2), !, fail.
  315correspond_args([ID1|T1], [ID2|T2], CLI1, CLI2, CLO1, CLO2) :-
  316	correspond_args(T1, T2, [ID1|CLI1], [ID2|CLI2], CLO1, CLO2).
  317correspond_args([], [], CL1, CL2, CL1, CL2).
  318
  319/* deiteration/1 ********************************************************
  320
  321Usage		: deiteration(+Graph)
  322Argument(s)	: 	        GID
  323Description	: erases the Graph
  324Notes		: this predicate assumes Graph has a copy in the same 
  325			or a dominating context
  326
  327************************************************************************/
  328
  329deiteration(CG) :-
  330	which_context(CG, ID), delete_obj(CG),
  331	( ID = outer
  332	; retract( p(ID, Type, Ref, Env) ), take_graph([CG], Ref, NewRef),
  333	  assert( p(ID, Type, NewRef, Env) )
  334	).
  335
  336/* double_negation/3 ****************************************************
  337
  338Usage		: double_negation(+OldGraph, +Context, -NewGraph)
  339Argument(s)	: 	      	   GID/list     PID,    list/GID
  340Description	: puts or removes a double negation
  341Notes		: if OldGraph is a GID, it is assumed to be a double negation
  342			which is removed returning the list of GIDs inside it
  343		  if OldGraph is a list of GIDs, this predicate puts a double
  344		  	negation around them and returns its GID (NewGraph)
  345		  Context is OldGraph's context
  346
  347************************************************************************/
  348
  349double_negation(g/G1, PID, GIDs) :-			% takes double negation
  350	retract( g(g/G1, [p/P1-_], _) ), free_id(g/G1), 
  351	retract( p(p/P1, _, [g/G2], Env) ), free_id(p/P1),
  352	retract( g(g/G2, [p/P2-_], _) ), free_id(g/G2),
  353	retract( p(p/P2, _, Ref, _) ), free_id(p/P2),
  354        ( Ref = '*', GIDs = []
  355	; GIDs = Ref, update_env(GIDs, Env)
  356	), %which_context(g/G1, PID),
  357	( PID = outer
  358	; retract( p(PID, Type, Ref, Env2) ),
  359	  take_graph([g/G1], Ref, TmpRef), put_graph(GIDs, TmpRef, NewRef),
  360	  assert( p(PID, Type, NewRef, Env2) )
  361	).
  362double_negation([], Env, g/G2) :-                       % puts double negation
  363	new_id(p/P1), new_id(p/P2), new_id(g/G1), new_id(g/G2),
  364        assert( p(p/P1, proposition, *, p/P2) ),
  365	assert( g(g/G1, [p/P1-X], [neg(X)]) ),
  366	assert( p(p/P2, proposition, [g/G1], Env) ),
  367	assert( g(g/G2, [p/P2-X], [neg(X)]) ),
  368        ( Env = outer
  369	; retract( p(Env, Type, Ref, Env2) ),
  370	  put_graph([g/G2], Ref, NewRef),
  371	  assert( p(Env, Type, NewRef, Env2) )
  372	).
  373double_negation(GIDs, Env, g/G2) :-			% puts double negation
  374	%GIDs = [GID|_], %which_context(GID, Env),
  375	new_id(p/P1), new_id(p/P2), new_id(g/G1), new_id(g/G2),
  376	assert( p(p/P1, proposition, GIDs, p/P2) ),
  377	assert( g(g/G1, [p/P1-X], [neg(X)]) ),
  378	assert( p(p/P2, proposition, [g/G1], Env) ),
  379	assert( g(g/G2, [p/P2-X], [neg(X)]) ),
  380	update_env(GIDs, p/P1),
  381	( Env = outer
  382	; retract( p(Env, Type, Ref, Env2) ),
  383	  take_graph(GIDs, Ref, TmpRef), put_graph([g/G2], TmpRef, NewRef),
  384	  assert( p(Env, Type, NewRef, Env2) )
  385	).
  386
  387/* update_env/2 *********************************************************
  388
  389Usage		: update_env(+Object, +Context)
  390Argument(s)	: 	        ID       PID
  391Description	: changes the context of Object to Context
  392Notes		: Object is a graph, concept or a list of objects
  393
  394************************************************************************/
  395
  396update_env([ID|List], Env) :-
  397	update_env(ID, Env), update_env(List, Env), !.
  398update_env(g/Id, Env) :-
  399	g(g/Id, CL, _), update_env(CL, Env), !.
  400update_env(p/Id-_, Env) :-
  401	retract( p(p/Id, Type, Ref, _) ), assert( p(p/Id, Type, Ref, Env) ), !.
  402update_env(_, _).			% update a concept or empty list
  403	
  404/* put_graph/3 **********************************************************
  405
  406Usage		: put_graph(+Graph, +OldRef, -NewRef)
  407Argument(s)	: 	     list     term     term 
  408Description	: adds Graph to OldRef, obtaining NewRef
  409Notes		: this predicate assumes OldRef contains no coreference links
  410
  411************************************************************************/
  412
  413put_graph(GIDs, '*', GIDs).
  414put_graph(GIDs, Ref, NewRef) :-
  415	conc(GIDs, Ref, NewRef).
  416
  417/* take_graph/3 *********************************************************
  418
  419Usage		: take_graph(+Graph, +OldRef, -NewRef)
  420Argument(s)	: 	      list     term     term 
  421Description	: takes Graph out of OldRef, obtaining NewRef
  422Notes		: this predicate assumes OldRef contains no coreference links
  423
  424************************************************************************/
  425
  426take_graph(GIDs, Ref, NewRef) :-
  427	difference(Ref, GIDs, TmpRef),
  428	( TmpRef = [] -> NewRef = ('*') ; NewRef = TmpRef )