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 : MISC.PL 34Creation Date : 90/06/16 By: mw 35Abbreviations : mw - Michel Wermelinger 36Description : Implements miscellaneous operations on conceptual graphs 37 38************************************************************************/ 39 40/* HISTORY ************************************************************** 41 420.0 90/06/23 mw show_obj/1, _id predicates 430.1 90/08/23 mw mark-&-sweep memory management 44 error handling predicates 450.2 90/09/09 mw added quantity, name and measure expansion/contraction 46 debugged mark-&-sweep predicates 470.3 90/10/19 mw added delete_concepts/1 480.4 90/10/23 mw added cg_warning/1, new_type/3 and _db predicates 490.5 90/10/29 mw improved mark-&-sweep predicates 500.6 90/11/04 mw generalized delete_concepts/1 to shallow_delete/1 51 added sweep_all/0; debugged sweep/0 520.7 90/11/05 mw show_obj/1 now deterministic; added take_crl/2 530.71 90/11/07 mw put_crl/2 deterministic 540.72 90/11/08 mw referent/2 deterministic 55 changed direct calls to c/3 560.8 90/12/05 mw changed some predicates to work with CGE 57 ( heads of contraction preedicates ) 580.81 90/12/06 mw added same_context/2 590.9 90/12/10 mw added description file to save_db and load_db 601.0 90/12/13 mw added notion of current database 611.1 91/05/02 mw free_id/1 takes into account that an object may have 62 been marked in a mark level superior to the current one; 63 sweep/0 now also deletes the level mark 641.2 91/05/14 mw free_id/1 now ignores at what level an object was marked 651.21 92/04/23 mw added comments 661.22 92/05/05 mw augmented copyright notice; 67 'lexicon' isn't reconsulted by start_cgp/1 anymore 68 69************************************************************************/ 70 71/* CONTENTS ************************************************************* 72 73start_cgp/1 start processing conceptual graphs 74end_cgp/1 stop processing conceptual graphs 75clear_db/0 clears current database 76current_db/1 returns current database name 77load_db/1 loads a graph database 78save_db/1 saves current database 79 80mark/0 starts a new level to mark objects created henceforth 81unmark/0 unmarks all objects created in current level 82sweep/0 deletes all object marked in current level 83new_id/1 returns a new unique identifier for the created object 84free_id/1 makes an identifier available again 85shallow_delete/1 deletes an object but not its sub-components 86delete_obj/1 deletes an object (graph, abstraction or concept) 87 88number2var/2 given N returns Nth variable (a, b, ..., z, aa, ab, ...) 89dir_reference/2 makes relations refer directly to attached concepts 90ind_reference/4 makes relations refer indirectly to attached concepts 91new_type/3 creates a new concept or relation type 92 93referent/2 returns referent of given concept (Assumption 3.3.1) 94basic_ref/2 returns referent of given concept without coref. links 95change_ref/2 changes a referent or coreference link 96put_crl/2 creates a coreference link between two given concepts 97take_crl/2 removes coreference link between two given concepts 98 99meas_expansion/2 measure expansion 100meas_contraction/2 measure contraction 101qty_expansion/2 quantity expansion 102qty_contraction/2 quantity contraction 103name_expansion/2 name expansion 104name_contraction/2 name contraction 105del_univ_quant/5 universal quantifier expansion 106 107which_graph/3 returns graph containing a given concept 108which_context/2 returns deepest context containing given graph 109same_context/2 succeeds if given graphs are all in the same context 110 111check_graph/1 checks if given graph is well defined 112 113cg_error/2 outputs an error message 114 115************************************************************************/ 116 117/************************************************************************ 118 119 D A T A B A S E O P E R A T I O N S 120 121************************************************************************/ 122 123/* start_cgp/1 ********************************************************** 124 125Usage : start_cgp(+Canon) 126Argument(s) : atom 127Description : starts a session loading the database from Canon 128Notes : 129 130************************************************************************/ 131 132start_cgp(Canon) :- 133 clear_db, load_id, load_db(Canon), nl, nl, 134 write('Conceptual Graph Tools (CGT) version 1.0'), nl, 135 write('Copyright (C) 1990 Miguel Alexandre Wermelinger'), nl, nl, 136 write('CGT comes with ABSOLUTELY NO WARRANTY.'), nl, 137 write('This is free software, and you are welcome to redestribute it'), 138 nl, 139 write('according to the GNU General Public License (version 2 or later);'), 140 nl, 141 write('see the acompanying file "COPYING".'), nl, nl, 142 write('If you have not received it, contact the Free Software'), nl, 143 write('Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA'), nl, 144 write('or'), nl, 145 write('Michel Wermelinger, Dep. de Informatica, Univ. Nova de Lisboa,'), 146 nl, 147 write('Quinta da Torre, 2825 Monte da Caparica, PORTUGAL'), nl, 148 write('E-mail: mw@fct.unl.pt'), nl, nl. 149 150 151/* end_cgp/1 ************************************************************ 152 153Usage : end_cgp(+Canon) 154Argument(s) : atom 155Description : ends the session saving the current database to Canon 156Notes : 157 158************************************************************************/ 159 160end_cgp(Canon) :- 161 save_id, save_db(Canon), clear_db. 162 163/* clear_db/0 *********************************************************** 164 165Usage : clear_db 166Argument(s) : 167Description : clears the current database 168Notes : succeeds always 169 170************************************************************************/ 171 172clear_db :- 173 abolish(g/3), abolish(c/3), abolish(p/4), abolish(l/3), sweep_all, 174 member(Key, [c,g,p,l]), recorded(Key, _, Ref), erase(Ref), fail. 175clear_db. 176 177/* current_db/1 ********************************************************* 178 179Usage : current_db(-Canon) 180Argument(s) : atom 181Description : returns the name of the current database 182Notes : 183 184************************************************************************/ 185 186current_db(Canon) :- 187 recorded(get_current_db, Canon, _). 188 189/* load_db/1 ************************************************************ 190 191Usage : load_db(+Canon) 192Argument(s) : atom 193Description : loads the current database from the given Canon 194Notes : 195 196************************************************************************/ 197 198 199load_db_dir(Canon,CanonFull):- 200 absolute_file_name(library(cgt/Canon),File,[extensions([gr]),access(read)]), 201 atom_concat(CanonFull,'.gr',File),!. 202load_db(Canon0) :- 203 load_db_dir(Canon0,Canon), 204 name(Canon, L), 205 name('.gr', E1), conc(L, E1, L1), name(File1, L1), reconsult(File1), 206 name('.hrc', E2), conc(L, E2, L2), name(File2, L2), reconsult(File2), 207 name('.rty', E3), conc(L, E3, L3), name(File3, L3), reconsult(File3), 208 name('.cty', E4), conc(L, E4, L4), name(File4, L4), reconsult(File4), 209 name('.dsc', E5), conc(L, E5, L5), name(File5, L5), reconsult(File5), 210 ( recorded(get_current_db, _, Ref), erase(Ref) ; true ), 211 recorda(get_current_db, Canon, _). 212 213% the following clause is to be used iff CGE is available 214load_db(Canon) :- 215 acknowledge([Canon, ' is not a valid GET database!']), !, fail. 216 217/* the following clause is to be used iff CGE isn't available 218load_db(Canon) :- 219 nl, write(Canon), write(' is not a valid GET database!'), nl, !, fail. 220*/ 221 222/* save_db/1 ************************************************************ 223 224Usage : save_db(+Canon) 225Argument(s) : atom 226Description : saves the current database to the given Canon 227Notes : 228 229************************************************************************/ 230 231save_db(Canon) :- 232 telling(Old), told, 233 save_gr(Canon), save_cty(Canon), save_rty(Canon), 234 save_hrc(Canon), save_dsc(Canon), 235 tell(Old), save_id, recorded(get_current_db, OldDb, Ref), 236 ( OldDb = Canon 237 ; erase(Ref), recorda(get_current_db, Canon, _) 238 ). 239 240/* save_gr/1 ************************************************************ 241 242Usage : save_gr(+Canon) 243Argument(s) : atom 244Description : saves the currently stored graphs to the given Canon 245Notes : 246 247************************************************************************/ 248 249save_gr(Canon) :- 250 name(Canon, L1), name('.gr', L2), conc(L1, L2, L3), name(File, L3), 251 tell(File), write(':- dynamic g/3, c/3, p/4, l/3.'), nl, 252 g(ID, C, R), portray_clause( g(ID, C, R) ), fail. 253save_gr(_) :- 254 c(ID, T, R), portray_clause( c(ID, T, R) ), fail. 255save_gr(_) :- 256 p(ID, T, R, E), portray_clause( p(ID, T, R, E) ), fail. 257save_gr(_) :- 258 l(ID, C, G), portray_clause( l(ID, C, G) ), fail. 259save_gr(_) :- told. 260 261/* save_cty/1 *********************************************************** 262 263Usage : save_cty(+Canon) 264Argument(s) : atom 265Description : saves the current concept types to the given Canon 266Notes : 267 268************************************************************************/ 269 270save_cty(Canon) :- 271 name(Canon, L1), name('.cty', L2), conc(L1, L2, L3), name(File, L3), 272 tell(File), write(':- dynamic concept_type/5.'), nl, 273 concept_type(T, L, D, C, S), 274 portray_clause( concept_type(T, L, D, C, S) ), 275 fail. 276save_cty(_) :- told. 277 278/* save_rty/1 *********************************************************** 279 280Usage : save_rty(+Canon) 281Argument(s) : atom 282Description : saves the current relation types to the given Canon 283Notes : 284 285************************************************************************/ 286 287save_rty(Canon) :- 288 name(Canon, L1), name('.rty', L2), conc(L1, L2, L3), name(File, L3), 289 tell(File), write(':- dynamic relation_type/5.'), nl, 290 relation_type(T, L, D, C, S), 291 portray_clause( relation_type(T, L, D, C, S) ), fail. 292save_rty(_) :- told. 293 294/* save_hrc/1 *********************************************************** 295 296Usage : save_hrc(+Canon) 297Argument(s) : atom 298Description : saves the current type hierarchy to the given Canon 299Notes : 300 301************************************************************************/ 302 303save_hrc(Canon) :- 304 name(Canon, L1), name('.hrc', L2), conc(L1, L2, L3), name(File, L3), 305 tell(File), write(':- dynamic ''<<''/2.'), nl, 306 X << Y, portray_clause( X << Y), fail. 307save_hrc(_) :- told. 308 309/* save_dsc/1 *********************************************************** 310 311Usage : save_dsc(+Canon) 312Argument(s) : atom 313Description : saves the current descriptions to the given Canon 314Notes : 315 316************************************************************************/ 317 318save_dsc(Canon) :- 319 name(Canon, L1), name('.dsc', L2), conc(L1, L2, L3), name(File, L3), 320 tell(File), write(':- dynamic description/3.'), nl, 321 description(Kind, Obj, Desc), 322 portray_clause( description(Kind, Obj, Desc) ), 323 fail. 324save_dsc(_) :- told. 325 326/************************************************************************ 327 328 M E M O R Y M A N A G E M E N T 329 330************************************************************************/ 331 332/* mark/0 *************************************************************** 333 334Usage : mark 335Argument(s) : 336Description : starts a new mark level 337Notes : all objects created after this will be automatically marked 338 339************************************************************************/ 340 341mark :- recorded(mark_level, N, _), succ(N, M), recorda(mark_level, M, _), !. 342mark :- recorda(mark_level, 0, _). 343 344/* unmark/0 ************************************************************* 345 346Usage : unmark 347Argument(s) : 348Description : unmarks all objects marked at the current mark level 349Notes : 350 351************************************************************************/ 352 353unmark :- 354 recorded(mark_level, N, Ref), 355 ( recorded(cg_mark, _ID-N, R), erase(R), fail 356 ; erase(Ref) 357 ), !. 358 359/* sweep/0 ************************************************************** 360 361Usage : sweep 362Argument(s) : 363Description : deletes all objects marked at the current mark level 364Notes : 365 366************************************************************************/ 367 368sweep :- 369 recorded(mark_level, N, Ref), 370 ( recorded(cg_mark, ID-N, DbRef), erase(DbRef), 371 ( delete_obj(ID) ; delete_obj(ID-_) ), fail 372 ; erase(Ref) 373 ), !. 374sweep. 375 376/* sweep_all/0 ********************************************************** 377 378Usage : sweep_all 379Argument(s) : 380Description : deletes all objects currently marked 381Notes : 382 383************************************************************************/ 384 385sweep_all :- 386 recorded(mark_level, _, _), sweep, fail. 387sweep_all. 388 389/* new_id/1 ************************************************************* 390 391Usage : new_id(?Identifier) 392Argument(s) : ID 393Description : returns a new unique Identifier 394Notes : the kind of identifier (concept, context, graph, or 395 abstraction) must be indicated 396 397************************************************************************/ 398 399new_id(Key/Id) :- 400 recorded(Key, Id, Ref), erase(Ref), 401 ( recorded(mark_level, N, _), recorda(cg_mark, Key/Id-N, _) 402 ; true 403 ), 404 ( recorded(Key, _, _) 405 ; succ(Id, NewId), recorda(Key, NewId, _) 406 ), !. 407 408/* free_id/1 ************************************************************ 409 410Usage : free_id(+Identifier) 411Argument(s) : ID 412Description : makes Identifier available for reuse by a new concept, 413 graph, or lambda abstraction 414Notes : 415 416************************************************************************/ 417 418free_id(Key/Id) :- 419 % recorded(mark_level, N, _), % !, 420 recorded(cg_mark, Key/Id- _N, Ref), erase(Ref), 421 recorda(Key, Id, _), !. 422free_id(Key/Id) :- 423 recorda(Key, Id, _). 424 425/* load_id/0 ************************************************************ 426 427Usage : load_id 428Argument(s) : 429Description : loads identifiers from a file 430Notes : 431 432************************************************************************/ 433 434cgp_id_dat(File):- absolute_file_name(library('cgt/cgp_id.dat'), File,[access(read)]). 435 436load_id :- 437 cgp_id_dat(File), 438 seeing(Old), seen, see(File), 439 repeat, read(T), 440 ( T = end_of_file 441 ; T = id(Key, Id), recordz(Key, Id, _), fail 442 ), 443 seen, seeing(Old). 444load_id :- 445 cgp_id_dat(File), 446 format('File ~w is misssing!~n',[File]), abort. 447 448/* save_id/0 ************************************************************ 449 450Usage : save_id 451Argument(s) : 452Description : saves current state of used identifiers to a file 453Notes : succeeds always 454 455************************************************************************/ 456 457save_id :- 458 cgp_id_dat(File), 459 telling(Old), told, tell(File), 460 ( member(Key, [c,g,p,l]), recorded(Key, Id, _Ref),% erase(Ref), 461 write(id(Key, Id)), write('.'), nl, fail 462 ; told, tell(Old) 463 ). 464 465/* shallow_delete/1 ***************************************************** 466 467Usage : shallow_delete(+Object) 468Argument(s) : ID/list 469Description : deletes non-recursively the Object 470Notes : succeeds always; Object may be a list of IDs 471 472************************************************************************/ 473 474shallow_delete([ID|List]) :- 475 shallow_delete(ID), shallow_delete(List). 476shallow_delete(g/Id) :- 477 retract( g(g/Id, _, _) ), free_id(g/Id). 478shallow_delete(c/Id-_) :- 479 retract( c(c/Id, _, _) ), free_id(c/Id). 480shallow_delete(p/Id-_) :- 481 retract( p(p/Id, _, _, _) ), free_id(p/Id). 482shallow_delete(l/Id) :- 483 retract( l(l/Id, _, _) ), free_id(l/Id). 484shallow_delete(_). 485 486/* delete_obj/1 ********************************************************* 487 488Usage : delete_obj(+Object) 489Argument(s) : ID/list 490Description : deletes the Object and recursively all its components 491Notes : succeeds always; Object may be a list of IDs 492 493************************************************************************/ 494 495delete_obj([ID|List]) :- 496 delete_obj(ID), delete_obj(List), !. 497delete_obj(g/Id) :- 498 retract( g(g/Id, CL, _) ), free_id(g/Id), delete_obj(CL), !. 499delete_obj(p/Id-_) :- 500 retract( p(p/Id, Type, Ref, _) ), 501 free_id(p/Id), delete_obj(Type), 502 basic_ref(Ref, GIDs), delete_obj(GIDs), !. 503delete_obj(c/Id-_) :- 504 retract( c(c/Id, Type, _) ), free_id(c/Id), delete_obj(Type), !. 505delete_obj(l/Id) :- 506 retract( l(l/Id, _, GIDs) ), free_id(l/Id), delete_obj(GIDs), !. 507delete_obj(_) :- !. 508 509/************************************************************************ 510 511 M I S C E L A N N E O U S 512 513************************************************************************/ 514 515/* show_obj/1 *********************************************************** 516 517Usage : show_obj(+Object) 518Argument(s) : ID/list 519Description : displays the data structures representing the Object 520Notes : succeeds always; Object may be a list of IDs 521 this predicate is only for debugging purposes 522 523************************************************************************/ 524 525:- style_check(-singleton). 526 527getable_objects(g/Id) :- g(g/Id, CL, RL). 528getable_objects(p/Id-_) :- p(p/Id, Type, Ref, Env). 529getable_objects(c/Id-_) :- type(c/Id, Type) ; referent(c/Id, Ref). 530getable_objects(l/Id) :- l(l/Id, CL, GIDs). 531getable_objects(Rel) :- relation_type(Rel, Label, Def, Can, Arcs). 532getable_objects(Type) :- concept_type(Type, Label, Def, Can, SL). 533 534 535 536show_obj(Var):-var(Var),!,getable_objects(Var),nonvar(Var),show_obj(Var). 537show_obj([ID|List]) :- 538 show_obj(ID), show_obj(List), !. 539show_obj(g/Id) :- 540 g(g/Id, CL, RL), write( g(g/Id, CL, RL) ), nl, show_obj(CL), !. 541show_obj(p/Id-_) :- 542 p(p/Id, Type, Ref, Env), write( p(p/Id, Type, Ref, Env) ), nl, 543 ( Type = l/Id -> show_obj(Type) ; true ), 544 basic_ref(Ref, GIDs), show_obj(GIDs), !. 545show_obj(c/Id-_) :- 546 type(c/Id, Type), referent(c/Id, Ref), 547 write( c(c/Id, Type, Ref) ), nl, 548 ( Type = l/_ -> show_obj(Type) ; true ), !. 549show_obj(l/Id) :- 550 l(l/Id, CL, GIDs), write( l(l/Id, CL, GIDs) ), nl, show_obj(GIDs), !. 551show_obj(Rel) :- 552 relation_type(Rel, Label, Def, Can, Arcs), 553 write( relation_type(Rel, Label, Def, Can, Arcs) ), nl, 554 show_obj(Def), show_obj(Can), !. 555show_obj(Type) :- 556 concept_type(Type, Label, Def, Can, SL), 557 write( concept_type(Type, Label, Def, Can, SL) ), nl, 558 show_obj(Def), show_obj(Can), show_obj(SL), !. 559show_obj(_). 560 561 562/* number2var/2 ********************************************************* 563 564Usage : number2var(+Number, ?Variable) 565Argument(s) : integer atom 566Description : Variable is the atom corresponding to Number according 567 the following sequence: 0 - a, 1 - b, ..., 26 - aa, ... 568Notes : 569 570************************************************************************/ 571 572number2var(X, V) :- 573 n2v(X, L1), reverse(L1, L2), name(V, L2). 574 575n2v(-1, []). 576n2v(0, [97]). 577n2v(X, [Y|L]) :- 578 Y is X mod 26 + 97, Z is X // 26 - 1, n2v(Z, L). 579 580/* dir_reference/2 ****************************************************** 581 582Usage : dir_reference(+Concepts, +Relations) 583Argument(s) : lists 584Description : each variable in Relations is substitued with the CID it 585 stands for (direct reference) 586Notes : 587 588************************************************************************/ 589 590dir_reference([CID-CID|T], RL) :- 591 dir_reference(T, RL). 592dir_reference([], _). 593 594/* ind_reference/4 ****************************************************** 595 596Usage : ind_reference(+OldRel, -NewRel, +OldConcepts, -NewConcepts) 597Argument(s) : lists 598Description : each argument in OldRel is substitued with the 599 corresponding variable (indirect reference) 600Notes : OldConcepts is the list of CID-Var pairs already known 601 602************************************************************************/ 603 604ind_reference([Rel|T1], [NewRel|T2], CL, NewCL) :- 605 Rel =.. [Type|Args], args_reference(Args, NewArgs, CL, TmpCL), 606 NewRel =.. [Type|NewArgs], ind_reference(T1, T2, TmpCL, NewCL). 607ind_reference([], [], CL, CL). 608 609/* args_reference/4 ***************************************************** 610 611Usage : args_reference(+Args, -NewArgs, +OldConcepts, -NewConcepts) 612Argument(s) : lists 613Description : Args, a list of CIDs, is translated into a list of the 614 corresponding variables 615Notes : OldConcepts is the list of CID-Var pairs already known 616 617************************************************************************/ 618 619args_reference([ID|T1], [Var|T2], CL, NewCL) :- 620 member(ID-Var, CL), args_reference(T1, T2, CL, NewCL). 621args_reference([ID|T1], [Var|T2], CL, NewCL) :- 622 args_reference(T1, T2, [ID-Var|CL], NewCL). 623args_reference([], [], CL, CL). 624 625/* new_type/3 *********************************************************** 626 627Usage : new_type(+Type, +Label, +Supertypes_or_NumberOfArgs) 628Argument(s) : atom atom list/number 629Description : adds Type and the corresponding Label to the database 630Notes : if Type is to be a concept type then the third argument 631 must be a (possibly empty) list of its immediate 632 supertypes (excluding T) 633 if Type is to be a relation type, then the third argument 634 must be an integer (greater then 0) stating the 635 relation's arity 636 it is not checked whether Type already exists 637 638************************************************************************/ 639 640new_type(Type, Label, []) :- 641 assert( concept_type(Type, Label, none, none, []) ). 642new_type(Type, Label, [SuperLabel|T]) :- 643 concept_type(SuperType, SuperLabel, _, _, _), 644 assert( Type << SuperType ), new_type(Type, Label, T). 645 646new_type(Type, Label, Args) :- 647 assert( relation_type(Type, Label, none, none, Args) ). 648 649/************************************************************************ 650 651 R E F E R E N T O P E R A T I O N S 652 653************************************************************************/ 654 655/* referent/2 *********************************************************** 656 657Usage : referent(+Concept, ?Referent) 658Argument(s) : CID/PID term 659Description : succeeds iff Referent is the referent of Concept 660Notes : 661 662************************************************************************/ 663 664referent(p/Id, Ref) :- 665 p(p/Id, _, Ref, _), !. 666referent(c/Id, Ref) :- 667 c(c/Id, _, Ref), !. 668 669/* basic_ref/2 ********************************************************** 670 671Usage : basic_ref(+Referent, ?Basic) 672Argument(s) : terms 673Description : succeeds iff Basic is the basic part of Referent 674Notes : Basic is just Referent with the coreference links 675 stripped off 676 677************************************************************************/ 678 679basic_ref(A = _CRL, C) :- basic_ref(A, C). 680basic_ref(A, A). 681 682/* change_ref/4 ********************************************************* 683 684Usage : change_ref(+OldPart, +OldRef, +NewPart, -NewRef) 685Argument(s) : terms 686Description : the part of OldRef which matches OldPart is changed to NewPart 687Notes : NewRef is the resulting referent 688 689************************************************************************/ 690 691change_ref(OldCRL, Ref = OldCRL, none, Ref) :- !. 692change_ref(OldCRL, Ref = OldCRL, NewCRL, Ref = NewCRL). 693change_ref(Old, OldRef = CRL, New, NewRef = CRL) :- 694 change_ref(Old, OldRef, New, NewRef). 695change_ref(OldRef, OldRef, NewRef, NewRef). 696 697/* put_crl/2 ************************************************************ 698 699Usage : put_crl(+Concept1, +Concept2) 700Argument(s) : ID ID 701Description : links the two concepts with a coreference link 702Notes : 703 704************************************************************************/ 705 706put_crl(ID1, ID2) :- 707 retract( c(ID1, Type1, Ref1) ), assert( c(ID1, Type1, Ref1 = ID2) ), 708 retract( c(ID2, Type2, Ref2) ), assert( c(ID2, Type2, Ref2 = ID1) ), !. 709put_crl(ID1, ID2) :- 710 retract( p(ID1, Type1, Ref1, Env1) ), 711 assert( p(ID1, Type1, Ref1 = ID2, Env1) ), 712 retract( p(ID2, Type2, Ref2, Env2) ), 713 assert( p(ID2, Type2, Ref2 = ID1, Env2) ), !. 714 715/* take_crl/2 *********************************************************** 716 717Usage : take_crl(+Concept1, +Concept2) 718Argument(s) : ID ID 719Description : removes the coreference link between the two concepts 720Notes : 721 722************************************************************************/ 723 724take_crl(ID1, ID2) :- 725 retract( c(ID1, Type1, OldRef1) ), 726 change_ref(ID2, OldRef1, none, NewRef1), 727 assert( c(ID1, Type1, NewRef1) ), 728 retract( c(ID2, Type2, OldRef2) ), 729 change_ref(ID1, OldRef2, none, NewRef2), 730 assert( c(ID2, Type2, NewRef2) ), !. 731take_crl(ID1, ID2) :- 732 retract( p(ID1, Type1, OldRef1, Env1) ), 733 change_ref(ID2, OldRef1, none, NewRef1), 734 assert( p(ID1, Type1, NewRef1, Env1) ), 735 retract( p(ID2, Type2, OldRef2, Env2) ), 736 change_ref(ID1, OldRef2, none, NewRef2), 737 assert( p(ID2, Type2, NewRef2, Env2) ), !. 738 739/* meas_expansion/2 ***************************************************** 740 741Usage : meas_expansion(+Concept, +Graph) 742Argument(s) : ID GID 743Description : expands the Concept of Graph according to measure expansion 744Notes : this predicate assumes the referent of Concept is a measure 745 746************************************************************************/ 747 748meas_expansion(CID, GID) :- 749 retract( c(CID, Type, Ref) ), change_ref(meas(M), Ref, '*', NewRef), 750 assert( c(CID, Type, NewRef) ), 751 new_id(c/Id), assert( c(c/Id, measure, name(M)) ), 752 retract( g(GID, CL, RL) ), member(CID-X, CL), 753 assert( g(GID, [c/Id-Y|CL], [meas(X, Y)|RL]) ). 754 755/* meas_contraction/2 *************************************************** 756 757Usage : meas_contraction(+Relation, +Graph) 758Argument(s) : term GID 759Description : tries to contract the measure Relation of Graph 760Notes : this predicate fails iff 761 a) the concept with the dimension is not generic 762 or b) the concept with the measure is coreferenced 763 or c) the concept with the measure is generic 764 765************************************************************************/ 766 767meas_contraction(meas(ID1, ID2), GID) :- 768 g(GID, CL, RL), dir_reference(CL, RL), member(meas(ID1, ID2), RL), !, 769 referent(ID2, name(M)), referent(ID1, Ref), %c(ID1, _, Ref), 770 change_ref('*', Ref, name(M), NewRef), 771 retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ), 772 join_on(GID, GID, [ID1-Var], [ID2-Var]), 773 retract( g(GID, NewCL, NewRL) ), delete_one(meas(_, _), NewRL, RL2), 774 assert( g(GID, NewCL, RL2) ). 775 776/* qty_expansion/2 ****************************************************** 777 778Usage : qty_expansion(+Concept, +Graph) 779Argument(s) : ID GID 780Description : expands the Concept of Graph according to quantity expansion 781Notes : this predicate assumes the referent of Concept is a set 782 with known cardinality 783 784************************************************************************/ 785 786qty_expansion(CID, GID) :- 787 retract( c(CID, Type, Ref) ), 788 change_ref(set(Kind, Set, Card), Ref, set(Kind, Set, _), NewRef), 789 assert( c(CID, Type, NewRef) ), 790 new_id(c/Id), assert( c(c/Id, number, name(Card)) ), 791 retract( g(GID, CL, RL) ), member(CID-X, CL), 792 assert( g(GID, [c/Id-Y|CL], [qty(X, Y)|RL]) ). 793 794/* qty_contraction/2 **************************************************** 795 796Usage : qty_contraction(+Relation, +Graph) 797Argument(s) : term GID 798Description : tries to contract the quantity Relation of Graph 799Notes : this predicate fails iff there is a qty/2 relation but 800 a) the concept with the set has known cardinality 801 or b) the referent of the number concept isn't an integer 802 or c) the number concept is coreferenced 803 804************************************************************************/ 805 806qty_contraction(qty(ID1, ID2), GID) :- 807 g(GID, CL, RL), dir_reference(CL, RL), member(qty(ID1, ID2), RL), !, 808 referent(ID2, name(Number)), integer(Number), referent(ID1, Ref), 809 change_ref(set(Kind, Set, Card), Ref, set(Kind, Set, Number), NewRef), 810 var(Card), retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ), 811 join_on(GID, GID, [ID1-Var], [ID2-Var]), 812 retract( g(GID, NewCL, NewRL) ), delete_one(qty(_, _), NewRL, RL2), 813 assert( g(GID, NewCL, RL2) ). 814 815/* name_expansion/2 ***************************************************** 816 817Usage : name_expansion(+Concept, +Graph) 818Argument(s) : ID GID 819Description : expands the Concept of Graph according to name expansion 820Notes : this predicate assumes the referent of Concept is a name 821 822************************************************************************/ 823 824name_expansion(CID, GID) :- 825 retract( c(CID, Type, Ref) ), change_ref(name(N), Ref, '*', NewRef), 826 assert( c(CID, Type, NewRef) ), 827 new_id(c/Id), assert( c(c/Id, N, '*') ), 828 retract( g(GID, CL, RL) ), member(CID-X, CL), 829 assert( g(GID, [c/Id-Y|CL], [name(X, Y)|RL]) ). 830 831/* name_contraction/2 *************************************************** 832 833Usage : name_contraction(+Relation, +Graph) 834Argument(s) : term GID 835Description : tries to contract the name Relation of Graph 836Notes : this predicate fails iff 837 a) the concept to be named is not generic 838 or b) the concept with the name is coreferenced 839 or c) the concept with the name is not generic 840 841************************************************************************/ 842 843name_contraction(name(ID1, ID2), GID) :- 844 g(GID, CL, RL), dir_reference(CL, RL), member(name(ID1, ID2), RL), !, 845 type(ID2, Name), referent(ID2, '*'), referent(ID1, Ref), 846 change_ref('*', Ref, name(Name), NewRef), 847 retract( c(ID1, Type, _) ), assert( c(ID1, Type, NewRef) ), 848 join_on(GID, GID, [ID1-Var], [ID2-Var]), 849 retract( g(GID, NewCL, NewRL) ), delete_one(name(_, _), NewRL, RL2), 850 assert( g(GID, NewCL, RL2) ). 851 852/* del_univ_quant/5 ***************************************************** 853 854Usage : del_univ_quant(+Con, +Graph, -NewCon, -NewGraph, -DoubleNeg) 855Argument(s) : ID GID ID GID GID 856Description : deletes the universal quantifier of Con(cept) in Graph 857Notes : NewCon in NewGraph is the Con(cept)'s coreferenced copy 858 DoubleNeg is the double negation created during the process 859 860************************************************************************/ 861 862del_univ_quant(ID, GID, NewID, NewGraph, NewGID) :- 863 ( retract( c(ID, Type, Ref) ) ; retract( p(ID, Type, Ref, Env) ) ), 864 change_ref(every, Ref, '*', NewRef), 865 ( ID = c/_ -> assert( c(ID, Type, NewRef) ) 866 ; assert( p(ID, Type, NewRef, Env) ) 867 ), 868 which_context(GID, PID), 869/* ( PID = outer -> GIDs = [GID] 870 ; p(PID, _, Ref1, _), basic_ref(Ref1, GIDs) 871 ), 872*/ double_negation([GID], PID, NewGID), 873 g(NewGID, [NewEnv-_], _), 874 copy_concept(ID-_, NewID-_, NewEnv), 875 new_id(g/NewGraph), assert( g(g/NewGraph, [NewID-_], []) ), 876 retract( p(NewEnv, Type2, GIDs2, Env2) ), 877 assert( p(NewEnv, Type2, [g/NewGraph|GIDs2], Env2) ), 878 put_crl(ID, NewID). 879 880/************************************************************************ 881 882 S E A R C H O P E R A T I O N S 883 884************************************************************************/ 885 886/* which_graph/3 ******************************************************** 887 888Usage : which_graph(+Concept, ?Possible, -Graph) 889Argument(s) : CID/PID list GID 890Description : returns the Graph containing Concept 891Notes : Possible is the list of graphs searched for Concept 892 if Possible is a variable, all graphs in the database are 893 searched 894 895************************************************************************/ 896 897which_graph(ID, GIDList, GID) :- 898 member(GID, GIDList), g(GID, CL, _), member(ID-_, CL). 899 900/* which_context/2 ****************************************************** 901 902Usage : which_context(+Graph, ?Context) 903Argument(s) : GID term 904Description : succeeds iff Context is the deepest context containing Graph 905Notes : 906 907************************************************************************/ 908 909which_context(g/Id, Env) :- 910 p(ID, _, Ref, _), basic_ref(Ref, GIDs), member(g/Id, GIDs), !, Env = ID. 911which_context(g/_, outer). 912 913/* same_context/2 ******************************************************* 914 915Usage : same_context(+Graphs, ?Context) 916Argument(s) : GIDs term 917Description : succeeds iff Graphs are all in the same Context 918Notes : 919 920************************************************************************/ 921 922same_context([GID], Env) :- 923 !, which_context(GID, Env). 924same_context([GID|List], Env) :- 925 which_context(GID, p/Id), !, Env= p/Id, 926 referent(p/Id, Ref), basic_ref(Ref, GIDs), 927 subset(List, GIDs), Env = p/Id. 928same_context([_|List], outer) :- 929 !, same_context(List, outer). 930same_context(GID, Env) :- 931 which_context(GID, Env). 932 933/************************************************************************ 934 935 O U T P U T O P E R A T I O N S 936 937************************************************************************/ 938 939/* cg_warning/1 ********************************************************* 940 941Usage : cg_warning(+Msg) 942Argument(s) : atom 943Description : issues a warning message 944Notes : 945 946************************************************************************/ 947 948cg_warning(Msg) :- 949 nl, write('Warning: '), write(Msg), nl. 950 951/* cg_error/2 *********************************************************** 952 953Usage : cg_error(+Kind, +Culprit) 954Argument(s) : atom term 955Description : issues an error message and aborts execution 956Notes : Kind describes the nature of the error 957 Culprit describes the location of the error 958 959************************************************************************/ 960 961% the following clause is to be used iff CGE is available 962cg_error(Kind, Culprit) :- 963 acknowledge(write_msg(Kind, Culprit)), sweep, get_back. 964 965/* the following clause is to be used iff CGE isn't available 966cg_error(Kind, Culprit) :- 967 nl, write_msg(Kind, Culprit), nl, sweep, abort. 968*/ 969 970/* write_msg/2 ********************************************************** 971 972Usage : write_msg(+Kind, +Culprit) 973Argument(s) : atom term 974Description : displays an error message 975Notes : Kind describes the nature of the error 976 Culprit describes the location of the error 977 978************************************************************************/ 979 980write_msg(dup_type_def, Label) :- 981 write('Type '), write(Label), write(' is already defined!'). 982write_msg(dup_rel_def, Relation) :- 983 write('Relation '), write(Relation), write(' is already defined!'). 984write_msg(dup_type_can, Label) :- 985 write('Type '), write(Label), write(' already has a canonical graph!'). 986write_msg(dup_rel_can, Relation) :- 987 write('Relation '), write(Relation), 988 write(' already has a canonical graph!'). 989write_msg(too_many_arcs, Rel) :- 990 write('Relation '), write_rel(Rel), 991 write(' has too many arcs attached to it!'). 992write_msg(too_few_arcs, Rel) :- 993 write('Relation '), write_rel(Rel), 994 write(' has not enough arcs attached to it!'). 995write_msg(point_away, Rel) :- 996 write('The last arc attached to '), write_rel(Rel), 997 write(' must point away from it!'). 998write_msg(point_into, Rel) :- 999 write('All but one arc attached to '), write_rel(Rel), 1000 write(' must point to it!'). 1001write_msg(duplicate_arc, N-Rel) :- 1002 write('Arc '), write(N), write(' of relation '), 1003 write_rel(Rel), write(' is duplicate!'). 1004write_msg(ambiguous_arc, Rel) :- 1005 write('Relation '), write_rel(Rel), 1006 write(' has ambiguous arcs attached to it!'). 1007write_msg(undef_param, Var) :- 1008 write('Parameter '), write(Var), 1009 write(' does not denote any concept in the abstraction body!'). 1010write_msg(ambiguous_var, Var) :- 1011 write('Variable '), write(Var), write(' denotes different concepts!'). 1012write_msg(wrong_crl, Var) :- 1013 write('Coreference link '), write(Var), 1014 write(' denotes incompatible concepts!'). 1015write_msg(unknown_type, Type) :- 1016 write('Concept type '), write(Type), write(' is not defined!'). 1017write_msg(unknown_rel, Type) :- 1018 write('Relation type '), write(Type), write(' is not defined!'). 1019write_msg(inv_name, Name) :- 1020 write(Name), write(' is not a valid name!'). 1021write_msg(wrong_rel_arg, Rel-N-Type) :- 1022 write('The concept attached to arc '), write(N), 1023 write(' of '), write_rel(Rel), write(' must be of a subtype of '), 1024 concept_type(Type, Label, _, _, _), write(Label), write('!'). 1025write_msg(double_def, Ref) :- 1026 write('Referent '), reffield(Ref, L, []), apply(write(_), L), 1027 write(' denotes a concept defined in the same graph!'). 1028write_msg(context_type, Type) :- 1029 concept_type(Type, Label, _, _, _), write(Label), 1030 write(' should be a subtype of PROPOSITION!'). 1031write_msg(context_ref, Ref) :- 1032 write('Referent '), reffield(Ref, L, []), apply(write(_), L), 1033 write(' should be generic or a set of graphs!'). 1034write_msg(not_measure, Type) :- 1035 concept_type(Type, Label, _, _, _), write('A concept of type '), 1036 write(Label), write(' cannot have a measure as referent!'). 1037 1038/* write_rel/1 ********************************************************** 1039 1040Usage : write_rel(+Relation) 1041Argument(s) : term 1042Description : writes Relation in the form label/arity 1043Notes : 1044 1045************************************************************************/ 1046 1047write_rel(Rel) :- 1048 functor(Rel, Type, NumArgs), 1049 relation_type(Type, Label, _, _, _), write(Label/NumArgs). 1050 1051/************************************************************************ 1052 1053 C H E C K I N G O P E R A T I O N S 1054 1055************************************************************************/ 1056 1057/* check_graph/1 ******************************************************** 1058 1059Usage : check_graph(+Graph) 1060Argument(s) : GID 1061Description : succeeds iff Graph is well defined 1062Notes : 1063 1064************************************************************************/ 1065 1066check_graph(GID) :- 1067 g(GID, CL, RL), dir_reference(CL, RL), 1068 apply(check_relation(_, GID), RL), apply(check_concept(_, GID), CL). 1069 1070/* check_relation/2 ***************************************************** 1071 1072Usage : check_relation(+Relation, +Graph) 1073Argument(s) : term GID 1074Description : succeeds iff Relation of Graph is well used 1075Notes : 1076 1077************************************************************************/ 1078 1079check_relation(Rel, GID) :- 1080 functor(Rel, Type, NumArgs), relation_type(Type, _, Def, Can, NumArgs), 1081 check_rel_def(Def, Rel, GID), check_rel_can(Can, Rel, GID). 1082 1083/* check_rel_def/3 ****************************************************** 1084 1085Usage : check_rel_def(+Definition, +Relation, +Graph) 1086Argument(s) : LID term GID 1087Description : succeeds iff Relation of Graph is well used according 1088 to its Definition 1089Notes : Definition may be the atom 'none' 1090 1091************************************************************************/ 1092 1093check_rel_def(LID, Rel, GID) :- 1094 l(LID, CL, _), Rel =.. [_RelType|Args], 1095 nth_member(CID1, Args, N), type(CID1, Type1), 1096 nth_member(CID2, CL, N), type(CID2, Type2), 1097 ( subtype(Type1, Type2) -> fail ; 1098 delete_obj(GID), cg_error(wrong_rel_arg, Rel-N-Type2) 1099 ). 1100check_rel_def(_, _, _). 1101 1102/* check_rel_can/3 ****************************************************** 1103 1104Usage : check_rel_can(+Canonical, +Relation, +Graph) 1105Argument(s) : GID term GID 1106Description : succeeds iff Relation of Graph is well used according 1107 to its Canonical graph 1108Notes : 1109 1110************************************************************************/ 1111 1112check_rel_can(Can, Rel1, GID) :- 1113 g(Can, CL, RL), dir_reference(CL, RL), 1114 Rel1 =.. [RelType|Args1], member(Rel2, RL), Rel2 =.. [RelType|Args2], 1115 nth_member(CID1, Args1, N), type(CID1, Type1), 1116 nth_member(CID2, Args2, N), type(CID2, Type2), 1117 ( subtype(Type1, Type2) -> fail ; 1118 delete_obj(GID), cg_error(wrong_rel_arg, Rel1-N-Type2) 1119 ). 1120check_rel_can(_, _, _). 1121 1122/* check_concept/2 ****************************************************** 1123 1124Usage : check_concept(+Concept, +Graph) 1125Argument(s) : ID GID 1126Description : succeeds iff Concept (a node of Graph) is well-formed 1127Notes : if Concept is a context, it must be subtype of PROPOSITION 1128 and it may not be coreferenced 1129 if Concept's referent is a measure then its type must 1130 be a dimension 1131 1132************************************************************************/ 1133 1134check_concept(p/Id-_, GID) :- 1135 p(p/Id, Type, Ref, _), basic_ref(Ref, Ident), 1136 ( subtype(Type, proposition) 1137 ; delete_obj(GID), cg_error(context_type, Type) 1138 ), 1139 ( Ident = [_|_] ; Ident = ('*') 1140 ; delete_obj(GID), cg_error(context_ref, Ident) 1141 ). 1142check_concept(c/Id-_, _) :- 1143 type(c/Id, Type), referent(c/Id, Ref), basic_ref(Ref, meas(_)), 1144 ( subtype(Type, dimension) ; cg_error(not_measure, Type) ). 1145check_concept(c/_-_, _). 1146 1147%%% unused 1148 1149%partially_specified(set(_, Set, _)) :- delete_one('*', Set, [_|_]).