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 : CAN_OPS.PL 34Creation Date : 90/06/16 By: mw 35Abbreviations : mw - Michel Wermelinger 36Description : Implements the canonical formation rules 37 38************************************************************************/ 39 40/* HISTORY ************************************************************** 41 420.0 90/06/24 mw works only for graphs without coreferent links 430.1 90/07/01 mw single-use types added 440.2 90/07/17 mw restrict/3 works for contexts 45 bugs in copy_type/2 corrected 460.3 90/08/19 mw max_join/2 added; bug in simplify/1 corrected 47 copy/3 simplified 480.4 90/08/29 mw copy/3 supports compound graphs 490.5 90/09/03 mw compound graphs supported; simplified more code 50 join_graphs_on/4 and join_concept/2 added 51 copy/3 renamed to copy_graph/3 520.6 90/10/17 mw extend_join/4 added 530.61 90/10/19 mw delete_obj/1 in join_on/4 changed to delete_concepts/1 54 corrected bug in conform/2 550.62 90/10/22 mw debugging 560.7 90/10/26 mw added is_generalization/2 and is_specialization/2 570.8 90/11/05 mw match_concept/4 and join_graphs_on/4 deterministic 580.9 90/11/08 mw call to c/3 and p/4 in match_concept/4 removed 591.0 90/12/12 mw debugged first clause of join_on/4 60 61************************************************************************/ 62 63/* CONTENTS ************************************************************* 64 65join_graphs_on/4 joins arbitrary graphs on arbitrary concepts 66join_on/4 joins two given graphs on the given concepts 67max_join/3 maximally joins two graphs 68extend_join/4 extends maximally a join of two concepts 69join_graph/2 joins two given graphs on one concept 70join_concept/2 tries to join two given concepts 71simplify/1 eliminates duplicate relations 72restrict/3 restricts a concept 73copy_graph/3 copies a graph in a given context 74copy_parameter/4 finds the abstraction's copy corresponding parameters 75 76is_generalization/2 implements the definition of generalization 77is_specialization/2 implements the definition of specialization 78 79************************************************************************/ 80 81/* join_graphs_on/4 ***************************************************** 82 83Usage : join_graphs_on(+Graphs, +Concepts1, +Concepts2, -NewGraphs) 84Argument(s) : lists 85Description : joins Concepts1 and Concepts2 obtaining NewGraphs 86Notes : assumes that the concepts are already restricted and 87 the join is thus possible 88 89************************************************************************/ 90 91join_graphs_on(OldGIDs, [ID1|T1], [ID2|T2], NewGIDs) :- 92 which_graph(ID1, OldGIDs, G1), which_graph(ID2, OldGIDs, G2), 93 join_on(G1, G2, [ID1-X], [ID2-X]), 94 delete_one(G2, OldGIDs, TmpGIDs), 95 join_graphs_on(TmpGIDs, T1, T2, NewGIDs), !. 96join_graphs_on(GIDs, [], [], GIDs). 97 98/* join_on/4 ************************************************************ 99 100Usage : join_on(+Graph1, +Graph2, +Concepts1, +Concepts2) 101Argument(s) : GID GID list list 102Description : joins Graph1 and Graph2 on Concepts1 and Concepts2 103Notes : assumes that the concepts are already restricted and 104 the join is thus possible 105 106************************************************************************/ 107 108join_on(CG, CG, Cs1, Cs2) :- 109 retract( g(CG, CL, RL) ), subset(Cs1, CL), difference(CL, Cs2, CL2), 110 assert( g(CG, CL2, RL) ), shallow_delete(Cs2), !. 111join_on(CG1, CG2, Cs1, Cs2) :- 112 retract( g(CG1, CL1, RL1) ), retract( g(CG2, CL2, RL2) ), free_id(CG2), 113 subset(Cs1, CL1), difference(CL2, Cs2, Tmp), 114 conc(RL1, RL2, RL3), conc(CL1, Tmp, CL3), 115 assert( g(CG1, CL3, RL3) ), shallow_delete(Cs2), !. 116 117/************************************************************************ 118 119 A S S U M P T I O N 3 . 5 . 9 120 121************************************************************************/ 122 123/* max_join/3 *********************************************************** 124 125Usage : max_join(+Graph1, +Graph2, -NewGraph) 126Argument(s) : GID GID GID 127Description : succeeds iff Graph1 and Graph2 can be maximally joined 128Notes : 129 130************************************************************************/ 131 132max_join(GIDs1, GIDs2, NewGIDs) :- 133 member(G1, GIDs1), member(G2, GIDs2), max_join(G1, G2, G1), 134 delete_one(G2, GIDs2, TmpGIDs), max_join(GIDs1, TmpGIDs, NewGIDs). 135max_join(GIDs, [], GIDs). 136max_join(CG1, CG2, CG1) :- 137 g(CG1, CL1, _RL1), g(CG2, CL2, _RL2), 138 member(C1-_, CL1), member(C2-_, CL2), join_concept(C1, C2), 139 extend_join(CG1, CG2, C1, C2). 140 141/* extend_join/4 ******************************************************** 142 143Usage : extend_join(+Graph1, +Graph2, +Concept1, +Concept2) 144Argument(s) : GID GID CID/PID CID/PID 145Description : extends maximally the join of Concept1 of Graph1 with 146 Concept2 of Graph2 147Notes : succeeds always 148 149************************************************************************/ 150 151extend_join(CG1, CG2, C1, C2) :- 152 g(CG1, CL1, RL1), dir_reference(CL1, RL1), map(_ =.. _, RL1, Rel1), 153 g(CG2, CL2, RL2), dir_reference(CL2, RL2), map(_ =.. _, RL2, Rel2), 154 matched_concepts([C1-C2], Rel1, Rel2, MCL1, MCL2), 155 join_on(CG1, CG2, MCL1, MCL2), simplify(CG1), !. 156 157/* matched_concepts/5 *************************************************** 158 159Usage : matched_concepts(+Matched, +Rel1, +Rel2, -Conc1, -Conc2) 160Argument(s) : lists 161Description : returns the concept lists Conc1 and Conc2 on which to join 162Notes : Matched is a list of terms CID1-CID2 denoting the concepts 163 which are known to match 164 Rel1 and Rel2 contain the relations of the two graphs in 165 list form (head = relation type, tail = CIDs) 166 167************************************************************************/ 168 169matched_concepts([C1-C2|T], RL1, RL2, L1, L2) :- 170 member([Rel|Args1], RL1), nth_member(C1, Args1, N), 171 member([Rel|Args2], RL2), nth_member(C2, Args2, N), 172 match_args(Args1, Args2, [C1-C2|T], Matches), 173 delete_one([Rel|Args1], RL1, RL11), 174 delete_one([Rel|Args2], RL2, RL21), 175 matched_concepts(Matches, RL11, RL21, L1, L2). 176matched_concepts([C1-C2|T], RL1, RL2, [C1-Var|T1], [C2-Var|T2]) :- 177 matched_concepts(T, RL1, RL2, T1, T2). 178matched_concepts([], _, _, [], []). 179 180/* match_args/4 ********************************************************* 181 182Usage : match_args(+CIDList1, +CIDList2, +OldMatches, -NewMatches) 183Argument(s) : lists 184Description : succeeds iff all concepts in CIDList1 and CIDList2 match 185 respectively 186Notes : OldMatches/NewMatches is a list of terms CID1-CID2 denoting 187 the concepts known to match before/after this predicate 188 189************************************************************************/ 190 191match_args([ID1|T1], [ID2|T2], OldMatches, NewMatches) :- 192 member(ID1-ID2, OldMatches), !, 193 match_args(T1, T2, OldMatches, NewMatches). 194match_args([ID1|T1], [ID2|T2], OldMatches, [ID1-ID2|NewMatches]) :- 195 match_concept(ID1, ID2, Type, Ref), 196 match_args(T1, T2, OldMatches, NewMatches), 197 restrict(ID1, Type, Ref), referent(ID2, Referent), 198 update_crl(ID2, ID1, Referent). 199match_args([], [], Matches, Matches). 200 201/************************************************************************ 202 203 A S S U M P T I O N 3 . 4 . 3 204 205************************************************************************/ 206 207/* join_graph/3 ********************************************************* 208 209Usage : join_graph(+Graph1, +Graph2, -NewGraph) 210Argument(s) : GIDs 211Description : succeeds iff Graph1 and Graph2 can be joined on one concept 212Notes : 213 214************************************************************************/ 215 216join_graph(GIDs1, GIDs2, NewGIDs) :- 217 member(G1, GIDs1), member(G2, GIDs2), join_graph(G1, G2, G1), 218 delete_one(G2, GIDs2, TmpGIDs), conc(GIDs1, TmpGIDs, NewGIDs), !. 219join_graph(CG1, CG2, CG1) :- 220 g(CG1, CL1, _), g(CG2, CL2, _), 221 member(C1-_, CL1), member(C2-_, CL2), join_concept(C1, C2), 222 join_on(CG1, CG2, [C1-Var], [C2-Var]). 223 224/* join_concept/2 ******************************************************* 225 226Usage : join_concept(+Concept1, +Concept2) 227Argument(s) : CID/PID CID/PID 228Description : succeeds iff Concept1 and Concept2 were joined together 229Notes : 230 231************************************************************************/ 232 233join_concept(ID1, ID2) :- 234 match_concept(ID1, ID2, Type, Ref), restrict(ID1, Type, Ref), 235 referent(ID2, Referent), update_crl(ID2, ID1, Referent), !. 236 237/* match_concept/4 ****************************************************** 238 239Usage : match_concept(+Concept1, +Concept2, -Type, -Referent) 240Argument(s) : CID/PID CID/PID 241Description : succeeds iff Concept1 and Concept2 match on Type and Referent 242Notes : 243 244************************************************************************/ 245 246match_concept(c/C1, c/C2, ST, Ref) :- 247 type(c/C1, T1), referent(c/C1, Ref1), 248 type(c/C2, T2), referent(c/C2, Ref2), 249 match_referent(Ref1, Ref2, Ref), 250 max_common_subtype(T1, T2, ST), 251 ( ST = absurd, !, fail 252 ; conform(ST, Ref), ! 253 ). 254match_concept(p/P1, p/P2, ST, Ref) :- 255 type(p/P1, T1), referent(p/P1, Ref1), 256 type(p/P2, T2), referent(p/P2, Ref2), 257 match_referent(Ref1, Ref2, Ref), 258 max_common_subtype(T1, T2, ST), !. 259 260/* match_referent/3 ***************************************************** 261 262Usage : match_referent(+Concept1, +Concept2, -Type, -Referent) 263Argument(s) : CID/PID CID/PID 264Description : succeeds iff Concept1 and Concept2 match on Type and Referent 265Notes : 266 267************************************************************************/ 268 269match_referent(X, X, X). 270match_referent('*', X, X). 271match_referent(X, '*', X). 272match_referent(A, B = CRL, C = CRL) :- 273 match_referent(A, B, C). 274match_referent(A = CRL, B, C = CRL) :- 275 match_referent(A, B, C). 276match_referent(A, B, set(coll, [A, B], 2)) :- % set coercion and join 277 set_element(A, _, _), set_element(B, _, _). 278match_referent(set(Kind, S1, C), set(Kind, S2, C), set(Kind, S3, C)) :- 279 union(S1, S2, S3). 280 281/************************************************************************ 282 283 A S S U M P T I O N 3 . 3 . 3 284 285************************************************************************/ 286 287/* conform/2 ************************************************************ 288 289Usage : conform(+Type, +Referent) 290Argument(s) : atom term 291Description : succeeds iff Referent conforms to Type 292Notes : Referent may be a list of referents 293 294************************************************************************/ 295 296conform(Type, [Ref]) :- 297 conform(Type, Ref), !. 298conform(Type, [Ref|List]) :- 299 conform(Type, Ref), conform(Type, List), !. 300conform(universal, _) :- !. 301conform(absurd, _) :- 302 !, fail. 303conform(_, '*') :- !. 304conform(_, #) :- !. 305conform(_, every) :- !. 306conform(Type, Ref = _CRL) :- 307 conform(Type, Ref), !. 308conform(Type, set(_, Set, _)) :- 309 conform(Type, Set), !. 310conform(Type, Ref) :- 311 c(_, Type, Ref), !. 312conform(Type, Ref) :- 313 proper_subtype(SubType, Type), conform(SubType, Ref). 314conform(Type, Ref) :- 315 conform(Type1, Ref), conform(Type2, Ref), Type1 \= Type2, 316 max_common_subtype(Type1, Type2, Type). 317 318/* simplify/1 *********************************************************** 319 320Usage : simplify(+Graph) 321Argument(s) : GID 322Description : deletes all duplicate relations of Graph 323Notes : succeeds always 324 325************************************************************************/ 326 327simplify([Graph|List]) :- 328 apply(simplify(_), [Graph|List]). 329simplify(CG) :- 330 g(CG, CL, RL), delete_eq(RL, RL2), 331 ( RL == RL2 332 ; retract( g(CG, _, _) ), assert( g(CG, CL, RL2) ) 333 ). 334 335/* restrict/3 *********************************************************** 336 337Usage : restrict(+Concept, +Type, +Referent) 338Argument(s) : CID type referent 339Description : restricts Concept to have the given Type and Referent 340Notes : doesn't check the conformity of Type and Referent 341 342************************************************************************/ 343 344restrict(CID, Type, Ref) :- 345 type(CID, Type), referent(CID, Ref), !. 346restrict(CID, Type, Ref) :- 347 retract( c(CID, _, _) ), assert( c(CID, Type, Ref) ), !. 348restrict(PID, Type, Ref) :- 349 retract( p(PID, _, _, Env) ), assert( p(PID, Type, Ref, Env) ), !. 350 351/* update_crl/3 ********************************************************* 352 353Usage : update_crl(+OldCRL, +NewCRL, +Referent) 354Argument(s) : CID/PID CID/PID term 355Description : updates OldCRL to NewCRL in all concepts pointed by Referent 356Notes : 357 358************************************************************************/ 359 360update_crl(OldCRL, NewCRL, Ref = CID) :- 361 retract( c(CID, Type, OldRef) ), 362 change_ref(OldCRL, OldRef, NewCRL, NewRef), 363 assert( c(CID, Type, NewRef) ), 364 update_crl(OldCRL, NewCRL, Ref). 365update_crl(OldCRL, NewCRL, Ref = PID) :- 366 retract( p(PID, Type, OldRef, Env) ), 367 change_ref(OldCRL, OldRef, NewCRL, NewRef), 368 assert( p(PID, Type, NewRef, Env) ), 369 update_crl(OldCRL, NewCRL, Ref). 370update_crl(_, _, _). 371 372/* copy_graph/3 ********************************************************* 373 374Usage : copy_graph(+Graph, -Copy, +Environment) 375Argument(s) : GID GID PID 376Description : copies Graph in Environment and returns the Copy's GID 377Notes : if Graph is in the outer context, Environment is the 378 atom 'outer' 379 Graph and Copy are lists if they are compound graphs 380 381************************************************************************/ 382 383copy_graph([GID], [NewGID], Env) :- 384 copy_graph(GID, NewGID, Env), !. 385copy_graph([GID|List], [NewGID|NewList], Env) :- 386 copy_graph(GID, NewGID, Env), copy_graph(List, NewList, Env), !. 387copy_graph(CG1, g/G2, Env) :- 388 g(CG1, CL, RL), new_id(g/G2), 389 map(copy_concept(_, _, Env), CL, CL2), 390 assert( g(g/G2, CL2, RL) ), !. 391 392/* copy_concept/3 ******************************************************* 393 394Usage : copy_concept(+Concept1, -Concept2, +Env) 395Argument(s) : CID/PID CID/PID PID 396Description : copies Concept1 to Concept2 397Notes : Env is the context of Concept2 398 399************************************************************************/ 400 401copy_concept(X/C1-Var, X/C2-Var, Env) :- 402 type(X/C1, Type1), referent(X/C1, Ref1), new_id(X/C2), 403 ( copy_abstraction(Type1, Type2) ; Type1 = Type2 ), 404 copy_ref(X/C1, X/C2, Ref1, Ref2), 405 ( X = p -> assert( p(X/C2, Type2, Ref2, Env) ) 406 ; assert( c(X/C2, Type2, Ref2) ) 407 ). 408 409/* copy_abstraction/2 *************************************************** 410 411Usage : copy_abstraction(+Abstraction1, -Abstraction2) 412Argument(s) : LIDs 413Description : copies Abstraction1 to Abstraction2 414Notes : 415 416************************************************************************/ 417 418copy_abstraction(l/L1, l/L2) :- 419 l(l/L1, CIDs, GIDs), copy_graph(GIDs, NewGIDs, outer), 420 map(copy_parameter(_, _, GIDs, NewGIDs), CIDs, NewCIDs), 421 new_id(l/L2), assert( l(l/L2, NewCIDs, NewGIDs) ). 422 423/* copy_parameter/4 ***************************************************** 424 425Usage : copy_parameter(+Param1, -Param2, +OldGraph, +NewGraph) 426Argument(s) : PID/CID PID/CID list list 427Description : returns the Param2 of NewGraph corresponding 428 to Param1 of OldGraph 429Notes : 430 431************************************************************************/ 432 433copy_parameter(ID1, ID2, G1s, G2s) :- 434 nth_member(CG1, G1s, N), g(CG1, CL1, _), nth_member(ID1-_, CL1, M), 435 nth_member(CG2, G2s, N), g(CG2, CL2, _), nth_member(ID2-_, CL2, M), !. 436 437/* copy_ref/4 *********************************************************** 438 439Usage : copy_ref(+OldID, +NewID, +Ref1, -Ref2) 440Argument(s) : terms 441Description : copies Ref1 to Ref2 442Notes : OldID/NewID is the ID of the original/duplicate concept 443 444************************************************************************/ 445 446copy_ref(Old, New, Ref = CRL, NewRef = NewCRL) :- 447 copy_ref(Old, New, CRL, NewCRL), copy_ref(Old, New, Ref, NewRef). 448copy_ref(Old, New, Ref = _, NewRef) :- 449 copy_ref(Old, New, Ref, NewRef). 450copy_ref(Old, _New, ID, _) :- 451 recorded(crl, _ = ID, DbRef), erase(DbRef), 452 ( retract( c(Old, Type, OldRef) ), 453 change_ref(ID, OldRef, none, NewRef), 454 assert( c(Old, Type, NewRef) ) 455 ; retract( p(Old, Type, OldRef, Env) ), 456 change_ref(ID, OldRef, none, NewRef), 457 assert( p(Old, Type, NewRef, Env) ) 458 ), !, fail. 459copy_ref(Old, New, ID, NewID) :- 460 recorded(crl, ID = NewID, DbRef), erase(DbRef), 461 ( retract( c(NewID, Type, OldRef) ), 462 change_ref(Old, OldRef, New, NewRef), 463 assert( c(NewID, Type, NewRef) ) 464 ; retract( p(NewID, Type, OldRef, Env) ), 465 change_ref(Old, OldRef, New, NewRef), 466 assert( p(NewID, Type, NewRef, Env) ) 467 ). 468copy_ref(Old, New, c/ID, c/ID) :- 469 recorda(crl, Old = New, _), recorda(crl, Old = New, _), 470 retract( c(c/ID, Type, Ref) ), assert( c(c/ID, Type, Ref = New) ). 471copy_ref(Old, New, p/ID, p/ID) :- 472 recorda(crl, Old = New, _), recorda(crl, Old = New, _), 473 retract( p(p/ID, Type, Ref, Env) ), 474 assert( p(p/ID, Type, Ref = New, Env) ). 475/*copy_ref(Old, New, X/ID, _) :- 476 recorda(crl, Old = New, _), !, fail.*/ 477copy_ref(_, ID2, [GID|List], NewGIDList) :- 478 copy_graph([GID|List], NewGIDList, ID2). 479copy_ref(_, _, X, X). 480 481/************************************************************************ 482 483 D E F I N I T I O N 3 . 5 . 1 484 485************************************************************************/ 486 487/* is_specialization/2 ************************************************** 488 489Usage : is_specialization(+Graph1, +Graph2) 490Argument(s) : GIDs 491Description : succeeds iff Graph1 <= Graph2 492Notes : deterministic 493 494************************************************************************/ 495 496is_specialization(G1, G2) :- 497 is_generalization(G2, G1). 498 499/* is_generalization/2 ************************************************** 500 501Usage : is_generalization(+Graph1, +Graph2) 502Argument(s) : GIDs 503Description : succeeds iff Graph1 >= Graph2 504Notes : deterministic 505 506************************************************************************/ 507 508is_generalization(G1, G2) :- 509 mark, 510 copy_graph(G1, Tmp1, outer), copy_graph(G2, Tmp2, outer), 511 ( max_join(Tmp1, Tmp2, Tmp1), is_copy(Tmp1, G2), sweep, ! 512 ; sweep, !, fail 513 )