requires: {#Mapping. #Set. #SingleSet. #Association}. provides: {#Relation}. prototypes ensureDelegatedNamespace: #relations. relations addPrototype: #Relation derivedFrom: {Cloneable}. "Relations are objects that map objects to an arbitrary number of other objects, and include a protocol of relational algebra." relations addSlot: #Top valued: Relation clone. relations addSlot: #Bottom valued: Relation clone. relations addPrototype: #IdentityRelation derivedFrom: {Relation}. ir@(IdentityRelation traits) applyTo: x "Identities return the element input." [ x ]. ir@(IdentityRelation traits) inverseApplyTo: x "Identities return the element input." [ x ]. ir@(IdentityRelation traits) invert "The inverse of an identity is that identity." [ ir ]. ir@(IdentityRelation traits) transitiveClosure "The transitive closure of an identity is that identity." [ ir ]. ir@(IdentityRelation traits) reflexiveClosure "The reflexive closure of an identity is that identity." [ ir ]. relations addPrototype: #UnaryArgumentRelation derivedFrom: {Relation}. UnaryArgumentRelation addSlot: #relation. uar@(UnaryArgumentRelation traits) newFor: rel [| newR | newR: uar clone. newR relation: rel. newR ]. relations addPrototype: #InvertedRelation derivedFrom: {UnaryArgumentRelation}. "This represents the result of an inversion of a relation." ir@(InvertedRelation traits) applyTo: obj [ ir relation inverseApplyTo: obj ]. ir@(InvertedRelation traits) inverseApplyTo: obj [ ir relation applyTo: obj ]. ir@(InvertedRelation traits) invert "The inverse of an inverse is the original relation." [ ir relation ]. relations addPrototype: #TransitiveClosureRelation derivedFrom: {UnaryArgumentRelation}. "This represents the transitive closure (applying * times to oneself) of a relation." tc@(TransitiveClosureRelation traits) applyTo: obj [| nextStep | nextStep: (tc relation applyTo: obj). temp union: (tc applyToAll: nextStep) ]. tc@(TransitiveClosureRelation traits) transitiveClosure [ tc ]. relations addPrototype: #MappingRelation derivedFrom: {Relation}. MappingRelation addSlot: #mapping valued: Mapping newEmpty. mr@(MappingRelation traits) applyTo: obj [ (mr mapping at: obj) as: SingleSet ]. mr@(MappingRelation traits) inverseApplyTo: obj [| result | result: Set newEmpty. mr mapping doWithIndex: [| :each :index | each = obj ifTrue: [result add: index]]. result ]. relations addPrototype: #AssociationTable derivedFrom: {Relation}. "A Set of Associations with no organizational restrictions." AssociationTable addSlot: #associations valued: Set newEmpty. at@(AssociationTable traits) applyTo: obj [| result | result: Set newEmpty. at associations do: [| :each | each key = obj ifTrue: [result add: each value]]. result ]. at@(AssociationTable traits) inverseApplyTo: obj [| result | result: Set newEmpty. at associations do: [| :each | each value = obj ifTrue: [result add: each key]]. result ].