requires: {#Mapping. #Set. #SingleSet. #Association}.
provides: {#Relation}.

prototypes addDelegate: #relations valued: Namespace clone.
relations addSlot: #Relation valued: Cloneable derive.

"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 addSlot: #IdentityRelation valued: Relation derive.

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 addSlot: #UnaryArgumentRelation valued: Relation derive.
UnaryArgumentRelation addSlot: #relation.

uar@(UnaryArgumentRelation traits) newFor: rel
[| newR |
  newR: uar clone.
  newR relation: rel.
  newR
].

relations addSlot: #InvertedRelation valued: UnaryArgumentRelation derive.
"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 addSlot: #TransitiveClosureRelation valued: UnaryArgumentRelation derive.
"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 addSlot: #MappingRelation valued: Relation derive.
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 addSlot: #AssociationTable valued: Relation derive.
"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
].