src/unfinished/relation.slate

   1
   2 prototypes ensureNamespace: #relations &delegate: True.
   3 relations define: #Relation &parents: {Cloneable}.
   4 "Relations are objects that map objects to an arbitrary number of other
   5 objects, and include a protocol of relational algebra."
   6
   7 r@(Relation traits) applyTo: x
   8 [overrideThis].
   9
  10 r@(Relation traits) inverseApplyTo: x
  11 [overrideThis].
  12
  13 r@(Relation traits) applyToAll: x
  14 [overrideThis].
  15
  16 r@(Relation traits) inverseApplyToAll: x
  17 [overrideThis].
  18
  19 relations define: #Top &builder: [Relation clone].
  20
  21 relations define: #Bottom &builder: [Relation clone].
  22
  23 relations define: #IdentityRelation &parents: {Relation}.
  24
  25 ir@(IdentityRelation traits) applyTo: x
  26 "Identities return the element input."
  27 [{x}].
  28
  29 ir@(IdentityRelation traits) inverseApplyTo: x
  30 "Identities return the element input."
  31 [{x}].
  32
  33 ir@(IdentityRelation traits) applyToAll: objs
  34 [objs].
  35
  36 ir@(IdentityRelation traits) inverseApplyToAll: objs
  37 [objs].
  38
  39 ir@(IdentityRelation traits) invert
  40 "The inverse of an identity is that identity."
  41 [ir].
  42
  43 ir@(IdentityRelation traits) transitiveClosure
  44 "The transitive closure of an identity is that identity."
  45 [ir].
  46
  47 ir@(IdentityRelation traits) reflexiveClosure
  48 "The reflexive closure of an identity is that identity."
  49 [ir].
  50
  51 relations define: #UnaryArgumentRelation &parents: {Relation}
  52   &slots: {#relation}.
  53
  54 uar@(UnaryArgumentRelation traits) newFor: rel
  55 [uar cloneSettingSlots: #{#relation} to: {rel}].
  56
  57 relations define: #InvertedRelation &parents: {UnaryArgumentRelation}.
  58 "This represents the result of an inversion of a relation."
  59
  60 r@(Relation traits) invert
  61 [
  62 ].
  63
  64 ir@(InvertedRelation traits) applyTo: obj
  65 [
  66   ir relation inverseApplyTo: obj
  67 ].
  68
  69 ir@(InvertedRelation traits) inverseApplyTo: obj
  70 [
  71   ir relation applyTo: obj
  72 ].
  73
  74 ir@(InvertedRelation traits) invert
  75 "The inverse of an inverse is the original relation."
  76 [
  77   ir relation
  78 ].
  79
  80 relations define: #TransitiveClosureRelation &parents: {UnaryArgumentRelation}.
  81 "This represents the transitive closure (applying * times to oneself) of a
  82 relation."
  83
  84 tc@(TransitiveClosureRelation traits) applyTo: obj
  85 [| nextStep |
  86   nextStep := (tc relation applyTo: obj).
  87   temp union: (tc applyToAll: nextStep)
  88 ].
  89
  90 tc@(TransitiveClosureRelation traits) transitiveClosure
  91 [
  92   tc
  93 ].
  94
  95 relations define: #MappingRelation &parents: {Relation}
  96   &slots: {#mapping -> EmptyMapping}.
  97
  98 mr@(MappingRelation traits) applyTo: obj
  99 [
 100   (mr mapping at: obj) as: SingleSet
 101 ].
 102
 103 mr@(MappingRelation traits) inverseApplyTo: obj
 104 [
 105   [| :result |
 106    mr mapping doWithIndex: [| :each :index |
 107       each = obj ifTrue: [result add: index]]
 108   ] writingAs: Set
 109 ].
 110
 111 relations define: #AssociationTable &parents: {Relation}
 112   &slots: {#associations -> Set new}.
 113 "A Set of Associations with no organizational restrictions."
 114
 115 at@(AssociationTable traits) applyTo: obj
 116 [
 117   [| :result |
 118    at associations
 119      do: [| :each | each key = obj ifTrue: [result add: each value]].
 120   ] writingAs: Set
 121 ].
 122
 123 at@(AssociationTable traits) inverseApplyTo: obj
 124 [
 125   [| :result |
 126    at associations
 127      do: [| :each | each value = obj ifTrue: [result nextPut: each key]].
 128   ] writingAs: Set
 129 ].
 130
 131 relations define: #NAryRelation &parents: {Relation}
 132   &slots: {#elements -> {}}.
 133
 134 r@(NAryRelation traits) newFor: rels
 135 [r cloneSettingSlots: #{#elements} to: {rels}].
 136
 137 relations define: #RelationIntersection &parents: {NAryRelation}.
 138
 139 r1@(Relation traits) /\ r2@(Relation traits)
 140 [RelationIntersection newFor: {r1. r2}].
 141
 142 r@(RelationIntersection traits) applyTo: obj
 143 [
 144   r elements gather: [| :a :b | (a applyTo: obj) /\ (b applyTo: obj)] &initial: {}
 145 ].
 146
 147 r@(RelationIntersection traits) inverseApplyTo: obj
 148 [
 149   r elements gather: [| :a :b | (a inverseApplyTo: obj) /\ (b inverseApplyTo: obj)] &initial: {}
 150 ].
 151
 152 r@(RelationIntersection traits) applyToAll: obj
 153 [
 154   r elements gather: [| :a :b | (a applyToAll: obj) /\ (b applyToAll: obj)] &initial: {}
 155 ].
 156
 157 r@(RelationIntersection traits) inverseApplyToAll: obj
 158 [
 159   r elements gather: [| :a :b | (a inverseApplyToAll: obj) /\ (b inverseApplyToAll: obj)] &initial: {}
 160 ].
 161
 162 relations define: #RelationUnion &parents: {NAryRelation}.
 163
 164 r1@(Relation traits) \/ r2@(Relation traits)
 165 [RelationUnion newFor: {r1. r2}].
 166
 167 r@(RelationUnion traits) applyTo: obj
 168 [
 169   r elements gather: [| :a :b | (a applyTo: obj) \/ (b applyTo: obj)] &initial: {}
 170 ].
 171
 172 r@(RelationUnion traits) inverseApplyTo: obj
 173 [
 174   r elements gather: [| :a :b | (a inverseApplyTo: obj) \/ (b inverseApplyTo: obj)] &initial: {}
 175 ].
 176
 177 r@(RelationUnion traits) applyToAll: obj
 178 [
 179   r elements gather: [| :a :b | (a applyToAll: obj) \/ (b applyToAll: obj)] &initial: {}
 180 ].
 181
 182 r@(RelationUnion traits) inverseApplyToAll: obj
 183 [
 184   r elements gather: [| :a :b | (a inverseApplyToAll: obj) \/ (b inverseApplyToAll: obj)] &initial: {}
 185 ].