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 : TYPE_OPS.PL 34Creation Date : 90/06/16 By: mw 35Abbreviations : mw - Michel Wermelinger 36Description : Implements operations on concept and relation types 37 38************************************************************************/ 39 40/* HISTORY ************************************************************** 41 421.0 90/06/23 mw doesn't work for single-use types (lambda 43 abstractions) 441.1 90/07/01 mw now it does: changed subtype/2 and proper_subtype/2 451.2 90/09/05 mw max_common_subtype/3 much more efficient 46 added type expansion operations 47 correted bugs for single-use types 481.3 90/10/29 mw corrected bug in build_graphs/3 491.4 90/11/07 mw type/1 is deterministic 50 51************************************************************************/ 52 53/* CONTENTS ************************************************************* 54 55type/2 returns the type of a concept 56subtype/2 succeeds iff a type is subtype of another 57supertype/2 succeeds iff a type is supertype of another 58proper_subtype/2 implements the definition of proper subtype 59proper_supertype/2 implements the definition of proper supertype 60common_subtype/3 returns a common subtype of two given types 61common_supertype/3 returns a common supertype of two given types 62max_common_subtype/3 returns the maximal common subtype of two types 63min_common_supertype/3 returns the minimal common supertype of two types 64 65rel_expansion/3 implements relational expansion 66min_type_expansion/3 implements minimal type expansion 67max_type_expansion/3 implements maximal type expansion 68 69************************************************************************/ 70 71/************************************************************************ 72 73 A S S U M P T I O N 3 . 2 . 1 74 75************************************************************************/ 76 77/* type/2 *************************************************************** 78 79Usage : type(+ConceptId, ?Type) 80Argument(s) : term atom 81Description : succeeds iff Type is the type of the given concept 82Notes : 83 84************************************************************************/ 85 86type(p/Id, Type) :- 87 p(p/Id, Type, _, _), !. 88type(CID, Type) :- 89 c(CID, Type, _), !. 90 91/************************************************************************ 92 93 A S S U M P T I O N S 3 . 2 . 3 and 3 . 6 . 8 94 95************************************************************************/ 96 97/* subtype/2 ************************************************************ 98 99Usage : subtype(?Type1, ?Type2) 100Argument(s) : atom atom 101Description : succeeds iff Type1 <= Type2 in the type hierarchy 102Notes : generates all (sub/super)types of a given type by 103 backtracking 104 105************************************************************************/ 106 107subtype(X, X). 108subtype(l/Id, Type) :- 109 l(l/Id, [ID], [GID]), g(GID, [_], []), 110 type(ID, SomeType), subtype(SomeType, Type). 111subtype(X, Y) :- 112 proper_subtype(X, Y). 113 114/* supertype/2 ********************************************************** 115 116Usage : supertype(?Type1, ?Type2) 117Argument(s) : atom atom 118Description : succeeds iff Type1 >= Type2 in the type hierarchy 119Notes : generates all (sub/super)types of a given type by 120 backtracking 121 122************************************************************************/ 123 124supertype(X, Y) :- 125 subtype(Y, X). 126 127/* proper_subtype/2 ***************************************************** 128 129Usage : proper_subtype(?Type1, ?Type2) 130Argument(s) : atom atom 131Description : succeeds iff Type1 < Type2 in the type hierarchy 132Notes : generates all proper (sub/super)types of a given type 133 by backtracking 134 135************************************************************************/ 136 137proper_subtype(X, Y) :- 138 call('<<'(X , Z)), subtype(Z, Y). 139proper_subtype(absurd, X) :- 140 concept_type(X, _, _, _, _), X \= absurd. 141proper_subtype(X, universal) :- 142 concept_type(X, _, _, _, _), X \= universal. 143proper_subtype(l/Id, Type) :- 144 l(l/Id, [ID], [GID]), g(GID, [_], []), !, 145 type(ID, SomeType), proper_subtype(SomeType, Type). 146proper_subtype(l/Id, Type) :- 147 l(l/Id, [ID], _), type(ID, SomeType), subtype(SomeType, Type). 148 149/* proper_supertype/2 *************************************************** 150 151Usage : proper_supertype(?Type1, ?Type2) 152Argument(s) : atom atom 153Description : succeeds iff Type1 > Type2 in the type hierarchy 154Notes : generates all proper (sub/super)types of a given type 155 by backtracking 156 157************************************************************************/ 158 159proper_supertype(X, Y) :- 160 proper_subtype(Y, X). 161 162/* common_subtype/3 ***************************************************** 163 164Usage : common_subtype(?Common, +Type1, +Type2) 165Argument(s) : atom atom atom 166Description : succeeds iff Common <= Type1 and Common <= Type2 167Notes : generates all common subtypes by backtracking 168 169************************************************************************/ 170 171common_subtype(X, Y, Z) :- 172 subtype(X, Y), subtype(X, Z). 173 174/* common_supertype/3 *************************************************** 175 176Usage : common_supertype(?Common, +Type1, +Type2) 177Argument(s) : atom atom atom 178Description : succeeds iff Common >= Type1 and Common >= Type2 179Notes : generates all common supertypes by backtracking 180 181************************************************************************/ 182 183common_supertype(X, Y, Z) :- 184 supertype(X, Y), supertype(X, Z). 185 186/************************************************************************ 187 188 A S S U M P T I O N 3 . 2 . 5 189 190************************************************************************/ 191 192/* max_common_subtype/3 ************************************************* 193 194Usage : max_common_subtype(+Type1, +Type2, ?MCommon) 195Argument(s) : atom atom atom 196Description : MCommon is the maximal common subtype of Type1 and Type2 197Notes : 198 199************************************************************************/ 200 201max_common_subtype(X, Y, X) :- 202 subtype(X, Y). 203max_common_subtype(X, Y, Y) :- 204 subtype(Y, X). 205max_common_subtype(X, Y, Z) :- 206 common_subtype(Z, X, Y), 207 \+ (( common_subtype(W, X, Y), proper_supertype(W, Z) )), !. 208 209/* min_common_supertype/3 *********************************************** 210 211Usage : min_common_supertype(+Type1, +Type2, ?MCommon) 212Argument(s) : atom atom atom 213Description : MCommon is the minimal common supertype of Type1 and Type2 214Notes : 215 216************************************************************************/ 217 218min_common_supertype(X, Y, Z) :- 219 common_supertype(Z, X, Y), 220 \+ (( common_supertype(W, X, Y), proper_subtype(W, Z) )), !. 221 222/************************************************************************ 223 224 D E F I N I T I O N 3 . 6 . 15 225 226************************************************************************/ 227 228/* rel_expansion/3 ****************************************************** 229 230Usage : rel_expansion(+Relation, +Graph, -Result) 231Argument(s) : term GID list 232Description : returns the Result of expanding the Graph's Relation 233Notes : the functor of Relation is its type 234 the arguments of Relation are the connected concepts' IDs 235 Result is a list of GIDs 236 237************************************************************************/ 238 239rel_expansion(Rel, GID, GIDList) :- 240 Rel =.. [Type|Args], 241 relation_type(Type, _, l/Id, _, _), l(l/Id, Param, GIDs), 242 remove_rel(Rel, GID, SomeGIDs), 243 which_context(GID, Env), copy_graph(GIDs, NewGIDs, Env), 244 map(copy_parameter(_, _, GIDs, NewGIDs), Param, NewParam), 245 map(join_concept(_, _), Args, NewParam), 246 conc(SomeGIDs, NewGIDs, MoreGIDs), 247 join_graphs_on(MoreGIDs, Args, NewParam, GIDList). 248rel_expansion(_, GID, [GID]). 249 250/* remove_rel/3 ********************************************************* 251 252Usage : remove_rel(+Relation, +Graph, -Graphs) 253Argument(s) : term GID list 254Description : removes Relation from Graph creating disconnected Graphs 255Notes : the functor of Relation is its type 256 the arguments of Relation are the connected concepts' IDs 257 258************************************************************************/ 259 260remove_rel(Rel, GID, GIDs) :- 261 retract( g(GID, CL, RL) ), free_id(GID), dir_reference(CL, RL), 262 delete_one(Rel, RL, RestRels), Rel =.. [_Type|Args], 263 build_graphs(Args, RestRels, GIDs). 264 265/* build_graphs/3 ******************************************************* 266 267Usage : build_graphs(+Concepts, +Relations, -Graphs) 268Argument(s) : lists 269Description : builds Graphs using Relations 270Notes : if Concepts are still connected, then Graphs is just one 271 272************************************************************************/ 273 274build_graphs([Arg|ArgList], RelList, [g/Id|GIDList]) :- 275 part_of_graph([Arg], RelList, IDs, TmpRL), 276 ind_reference(TmpRL, RL, [Arg-_Var], CL), 277 new_id(g/Id), assert( g(g/Id, CL, RL) ), 278 difference(RelList, TmpRL, RestRels), 279 difference(ArgList, IDs, RestArgs), 280 build_graphs(RestArgs, RestRels, GIDList). 281build_graphs([], [], []). 282 283/* part_of_graph/4 ****************************************************** 284 285Usage : part_of_graph(+Concepts, +Graph, -ConList, -RelList) 286Argument(s) : lists 287Description : ConList/RelList is the list of concepts/relations that form 288 the part of the Graph attached to Concepts 289Notes : Graph is a list of relations with CIDs as arguments 290 291************************************************************************/ 292 293part_of_graph(IDs, [Rel|List], CL, RL) :- 294 Rel =.. [_|Args], intersection(Args, IDs, []), 295 part_of_graph(IDs, List, CL, RL). 296part_of_graph(IDs, [Rel|T1], CL, [Rel|T2]) :- 297 Rel =.. [_|Args], delete_dup(Args, MoreIDs), 298 union(IDs, MoreIDs, NewIDs), part_of_graph(NewIDs, T1, CL, T2). 299part_of_graph(IDs, [], IDs, []). 300 301/************************************************************************ 302 303 D E F I N I T I O N 3 . 6 . 6 304 305************************************************************************/ 306 307/* min_type_expansion/3 ************************************************* 308 309Usage : min_type_expansion(+Concept, +Graph, -Result) 310Argument(s) : CID/PID GID list 311Description : returns the Result of expanding minimally the Concept's type 312Notes : Concept belongs to Graph; Result is a list of GIDs 313 314************************************************************************/ 315 316min_type_expansion(ID, GID, Result) :- 317 type(ID, Type), concept_type(Type, _, l/Id, _, _), l(l/Id, [CID], GIDs), 318 which_context(GID, Env), copy_graph(GIDs, NewGIDs, Env), 319 copy_parameter(CID, NewCID, GIDs, NewGIDs), 320 join_concept(ID, NewCID), 321 join_graphs_on([GID|NewGIDs], [ID], [NewCID], Result). 322min_type_expansion(_, GID, [GID]). 323 324/************************************************************************ 325 326 D E F I N I T I O N 3 . 6 . 7 327 328************************************************************************/ 329 330/* max_type_expansion/3 ************************************************* 331 332Usage : max_type_expansion(+Concept, +Graph, -Result) 333Argument(s) : CID/PID GID list 334Description : returns the Result of expanding maximally the Concept's type 335Notes : Concept belongs to Graph; Result is a list of GIDs 336 337************************************************************************/ 338 339max_type_expansion(ID, GID, [GID|RestGIDs]) :- 340 type(ID, Type), 341 ( concept_type(Type, _, l/Id, _, _) ; Type = l/Id ), 342 l(l/Id, [CID], GIDs), 343 which_context(GID, Env), copy_graph(GIDs, NewGIDs, Env), 344 copy_parameter(CID, NewCID, GIDs, NewGIDs), 345 which_graph(NewCID, NewGIDs, NewGID), 346 join_concept(ID, NewCID), type(NewCID, SuperType), 347 ( retract( c(ID, Type, Ref) ), assert( c(ID, SuperType, Ref) ) 348 ; retract( p(ID, Type, Ref, Env) ), assert( p(ID, SuperType, Ref, Env) ) 349 ), 350 g(GID, CL1, RL1), dir_reference(CL1, RL1), map(_ =.. _, RL1, Rel1), 351 g(NewGID, CL2, RL2), dir_reference(CL2, RL2), map(_ =.. _, RL2, Rel2), 352 matched_concepts([ID-NewCID], Rel1, Rel2, MC1, MC2), 353 join_on(GID, NewGID, MC1, MC2), delete_one(NewGID, NewGIDs, RestGIDs), 354 ( Env = outer 355 ; retract( p(Env, TyEnv, RefEnv, EnvEnv) ), 356 put_graph(RestGIDs, RefEnv, NewRefEnv), 357 assert( p(Env, TyEnv, NewRefEnv, EnvEnv) ) 358 ). 359max_type_expansion(_, GID, [GID])