git.iko.soy/project-m36
on master help sign in
fix critical join functions broken in Tuple-vectorization
f2b923dAgentM
ProjectM36/Attribute.hs+14−14
compare with master
unifiedsplit
@@ -22,7 +22,7 @@ attributesFromList = V.fromList -- . L.nub
22attributeName :: Attribute -> AttributeName
22attributeName :: Attribute -> AttributeName
23attributeName (Attribute name _) = name
23attributeName (Attribute name _) = name
24
24
25−atomType :: Attribute -> AtomType
25+atomType :: Attribute -> AtomType
26atomType (Attribute _ atype) = atype
26atomType (Attribute _ atype) = atype
27
27
28isRelationAtomType :: AtomType -> Bool
28isRelationAtomType :: AtomType -> Bool
@@ -38,9 +38,9 @@ joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
38joinAttributes attrs1 attrs2 = if V.length (vectorUniqueify overlappingAttributes) /= V.length overlappingAttributes then
38joinAttributes attrs1 attrs2 = if V.length (vectorUniqueify overlappingAttributes) /= V.length overlappingAttributes then
39 Left $ TupleAttributeTypeMismatchError overlappingAttributes
39 Left $ TupleAttributeTypeMismatchError overlappingAttributes
40 else
40 else
41− Right $ attrs1 V.++ otherAttributes
41+ Right $ vectorUniqueify (attrs1 V.++ attrs2)
42 where
42 where
43− (overlappingAttributes, otherAttributes) = V.partition (\attr -> V.elem attr attrs2) attrs1
43+ overlappingAttributes = V.filter (\attr -> V.elem attr attrs2) attrs1
44
44
45addAttributes :: Attributes -> Attributes -> Attributes
45addAttributes :: Attributes -> Attributes -> Attributes
46addAttributes = (V.++)
46addAttributes = (V.++)
@@ -48,22 +48,22 @@ addAttributes = (V.++)
48deleteAttributeName :: AttributeName -> Attributes -> Attributes
48deleteAttributeName :: AttributeName -> Attributes -> Attributes
49deleteAttributeName attrName = V.filter (\attr -> attributeName attr /= attrName)
49deleteAttributeName attrName = V.filter (\attr -> attributeName attr /= attrName)
50
50
51−renameAttribute :: AttributeName -> Attribute -> Attribute
51+renameAttribute :: AttributeName -> Attribute -> Attribute
52renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo
52renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo
53
53
54renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
54renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
55renameAttributes oldAttrName newAttrName attrs = V.map renamer attrs
55renameAttributes oldAttrName newAttrName attrs = V.map renamer attrs
56 where
56 where
57− renamer attr = if attributeName attr == oldAttrName then
57+ renamer attr = if attributeName attr == oldAttrName then
58 renameAttribute newAttrName attr
58 renameAttribute newAttrName attr
59− else
59+ else
60 attr
60 attr
61−
61+
62atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType
62atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType
63atomTypeForAttributeName attrName attrs = do
63atomTypeForAttributeName attrName attrs = do
64 (Attribute _ atype) <- attributeForName attrName attrs
64 (Attribute _ atype) <- attributeForName attrName attrs
65 return atype
65 return atype
66−
66+
67attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
67attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
68attributeForName attrName attrs = case V.find ((attrName ==) . attributeName) attrs of
68attributeForName attrName attrs = case V.find ((attrName ==) . attributeName) attrs of
69 Nothing -> Left $ NoSuchAttributeNameError attrName
69 Nothing -> Left $ NoSuchAttributeNameError attrName
@@ -73,7 +73,7 @@ attributesForNames :: S.Set AttributeName -> Attributes -> Attributes
73attributesForNames attrNameSet attrs = V.filter filt attrs
73attributesForNames attrNameSet attrs = V.filter filt attrs
74 where
74 where
75 filt attr = S.member (attributeName attr) attrNameSet
75 filt attr = S.member (attributeName attr) attrNameSet
76−
76+
77attributeNameSet :: Attributes -> S.Set AttributeName
77attributeNameSet :: Attributes -> S.Set AttributeName
78attributeNameSet attrVec = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) attrVec
78attributeNameSet attrVec = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) attrVec
79
79
@@ -95,13 +95,13 @@ matchingAttributeNameSet = S.intersection
95-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
95-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
96sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
96sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
97sortedAttributeNameList attrNameSet= L.sort $ S.toList attrNameSet
97sortedAttributeNameList attrNameSet= L.sort $ S.toList attrNameSet
98−
98+
99-- take two attribute sets and return an attribute set with the attributes which do not match
99-- take two attribute sets and return an attribute set with the attributes which do not match
100−attributesDifference :: Attributes -> Attributes -> Attributes
100+attributesDifference :: Attributes -> Attributes -> Attributes
101attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)
101attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)
102 where
102 where
103 diff a b = (a L.\\ b) ++ (b L.\\ a)
103 diff a b = (a L.\\ b) ++ (b L.\\ a)
104−
104+
105vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a
105vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a
106vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn
106vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn
107
107
@@ -113,6 +113,6 @@ verifyAttributes attrs = if collapsedAttrs /= attrs then
113 Right attrs
113 Right attrs
114 where
114 where
115 collapsedAttrs = vectorUniqueify attrs
115 collapsedAttrs = vectorUniqueify attrs
116−
116+
117attributesEqual :: Attributes -> Attributes -> Bool
117attributesEqual :: Attributes -> Attributes -> Bool
118−attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)
118+attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)
ProjectM36/Tuple.hs+25−25
@@ -21,20 +21,20 @@ tupleAttributeNameSet (RelationTuple tupAttrs _) = S.fromList $ V.toList $ V.map
21
21
22tupleAttributes :: RelationTuple -> Attributes
22tupleAttributes :: RelationTuple -> Attributes
23tupleAttributes (RelationTuple tupAttrs _) = tupAttrs
23tupleAttributes (RelationTuple tupAttrs _) = tupAttrs
24−
24+
25−-- return atoms in some arbitrary but consistent key order
25+-- return atoms in some arbitrary but consistent key order
26tupleAtoms :: RelationTuple -> V.Vector Atom
26tupleAtoms :: RelationTuple -> V.Vector Atom
27tupleAtoms (RelationTuple _ tupVec) = tupVec
27tupleAtoms (RelationTuple _ tupVec) = tupVec
28
28
29atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
29atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
30atomForAttributeName attrName (RelationTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of
30atomForAttributeName attrName (RelationTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of
31 Nothing -> Left $ NoSuchAttributeNameError attrName
31 Nothing -> Left $ NoSuchAttributeNameError attrName
32− Just index -> case tupVec V.!? index of
32+ Just index -> case tupVec V.!? index of
33 Nothing -> Left $ NoSuchAttributeNameError attrName
33 Nothing -> Left $ NoSuchAttributeNameError attrName
34 Just atom -> Right atom
34 Just atom -> Right atom
35−
35+
36−{- -- resolve naming clash with Attribute and Relation later
36+{- -- resolve naming clash with Attribute and Relation later
37−atomTypeForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
37+atomTypeForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
38atomTypeForAttributeName attrName tup = do
38atomTypeForAttributeName attrName tup = do
39 atom <- atomForAttributeName attrName tup
39 atom <- atomForAttributeName attrName tup
40 return $ atomTypeForAtom atom
40 return $ atomTypeForAtom atom
@@ -46,15 +46,15 @@ atomsForAttributeNames attrNames tuple = V.foldr folder V.empty attrNames
46 folder attrName acc = case atomForAttributeName attrName tuple of
46 folder attrName acc = case atomForAttributeName attrName tuple of
47 Left _ -> acc
47 Left _ -> acc
48 Right atom -> V.snoc acc atom
48 Right atom -> V.snoc acc atom
49−
49+
50relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation
50relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation
51relationForAttributeName attrName tuple = do
51relationForAttributeName attrName tuple = do
52 aType <- atomTypeForAttributeName attrName (tupleAttributes tuple)
52 aType <- atomTypeForAttributeName attrName (tupleAttributes tuple)
53 if not (isRelationAtomType aType) then
53 if not (isRelationAtomType aType) then
54− Left $ AttributeIsNotRelationValuedError attrName
54+ Left $ AttributeIsNotRelationValuedError attrName
55− else do
55+ else do
56 atomVal <- atomForAttributeName attrName tuple
56 atomVal <- atomForAttributeName attrName tuple
57− relationForAtom atomVal
57+ relationForAtom atomVal
58
58
59--in case the oldattr does not exist in the tuple, then return the old tuple
59--in case the oldattr does not exist in the tuple, then return the old tuple
60tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple
60tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple
@@ -81,21 +81,21 @@ singleTupleSetJoin tup tupSet = HS.foldr tupleJoiner HS.empty tupSet
81-- the keys/values don't need to be resorted
81-- the keys/values don't need to be resorted
82-- if the keys share some keys and values, then merge the tuples
82-- if the keys share some keys and values, then merge the tuples
83singleTupleJoin :: RelationTuple -> RelationTuple -> Maybe RelationTuple
83singleTupleJoin :: RelationTuple -> RelationTuple -> Maybe RelationTuple
84−singleTupleJoin tup1@(RelationTuple tupAttrs1 _) tup2@(RelationTuple tupAttrs2 _) = if
84+singleTupleJoin tup1@(RelationTuple tupAttrs1 _) tup2@(RelationTuple tupAttrs2 _) = if
85 V.null keysIntersection || atomsForAttributeNames keysIntersection tup1 /= atomsForAttributeNames keysIntersection tup2
85 V.null keysIntersection || atomsForAttributeNames keysIntersection tup1 /= atomsForAttributeNames keysIntersection tup2
86 then
86 then
87 Nothing
87 Nothing
88− else
88+ else
89 Just $ RelationTuple newAttrs newVec
89 Just $ RelationTuple newAttrs newVec
90 where
90 where
91 keysIntersection = V.map attributeName attrsIntersection
91 keysIntersection = V.map attributeName attrsIntersection
92− attrsIntersection = V.filter (flip V.notElem $ tupAttrs1) tupAttrs2
92+ attrsIntersection = V.filter (flip V.elem $ tupAttrs1) tupAttrs2
93 newAttrs = vectorUnion tupAttrs1 tupAttrs2
93 newAttrs = vectorUnion tupAttrs1 tupAttrs2
94 newVec = V.map (findAtomForAttributeName . attributeName) newAttrs
94 newVec = V.map (findAtomForAttributeName . attributeName) newAttrs
95− --search both tuples for the
95+ --search both tuples for the
96 findAtomForAttributeName attrName = head $ rights $ fmap (atomForAttributeName attrName) [tup1, tup2]
96 findAtomForAttributeName attrName = head $ rights $ fmap (atomForAttributeName attrName) [tup1, tup2]
97−
97+
98−--same consideration as Data.List.union- duplicates in v1 are not de-duped
98+--same consideration as Data.List.union- duplicates in v1 are not de-duped
99vectorUnion :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
99vectorUnion :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
100vectorUnion v1 v2 = V.foldr folder v1 v2
100vectorUnion v1 v2 = V.foldr folder v1 v2
101 where
101 where
@@ -110,18 +110,18 @@ tupleExtend (RelationTuple tupAttrs1 tupVec1) (RelationTuple tupAttrs2 tupVec2)
110 where
110 where
111 newAttrs = tupAttrs1 V.++ tupAttrs2
111 newAttrs = tupAttrs1 V.++ tupAttrs2
112 newVec = tupVec1 V.++ tupVec2
112 newVec = tupVec1 V.++ tupVec2
113−
113+
114tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple
114tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple
115tupleAtomExtend newAttrName atom tupIn = tupleExtend tupIn newTup
115tupleAtomExtend newAttrName atom tupIn = tupleExtend tupIn newTup
116 where
116 where
117 newTup = RelationTuple (V.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)
117 newTup = RelationTuple (V.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)
118
118
119−{- sort the associative list to match the header sorting -}
119+{- sort the associative list to match the header sorting -}
120tupleSortedAssocs :: RelationTuple -> [(AttributeName, Atom)]
120tupleSortedAssocs :: RelationTuple -> [(AttributeName, Atom)]
121tupleSortedAssocs (RelationTuple tupAttrs tupVec) = V.toList $ V.map (\(index,attr) -> (attributeName attr, tupVec V.! index)) $ V.indexed tupAttrs
121tupleSortedAssocs (RelationTuple tupAttrs tupVec) = V.toList $ V.map (\(index,attr) -> (attributeName attr, tupVec V.! index)) $ V.indexed tupAttrs
122−
122+
123--this could be cheaper- it may not be wortwhile to update all the tuples for projection, but then the attribute management must be slightly different- perhaps the attributes should be a vector of association tuples [(name, index)]
123--this could be cheaper- it may not be wortwhile to update all the tuples for projection, but then the attribute management must be slightly different- perhaps the attributes should be a vector of association tuples [(name, index)]
124−tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple
124+tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple
125tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec
125tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec
126 where
126 where
127 deleteIndices = V.findIndices (\attr -> S.notMember (attributeName attr) projectAttrs) attrs
127 deleteIndices = V.findIndices (\attr -> S.notMember (attributeName attr) projectAttrs) attrs
@@ -136,14 +136,14 @@ tupleIntersection tuple1 tuple2 = RelationTuple newAttrs newTupVec
136 where
136 where
137 attrs1 = tupleAttributes tuple1
137 attrs1 = tupleAttributes tuple1
138 attrs2 = tupleAttributes tuple2
138 attrs2 = tupleAttributes tuple2
139− matchingIndices = V.findIndices (\attr -> V.elem attr attrs2 &&
139+ matchingIndices = V.findIndices (\attr -> V.elem attr attrs2 &&
140 atomForAttributeName (attributeName attr) tuple1 ==
140 atomForAttributeName (attributeName attr) tuple1 ==
141 atomForAttributeName (attributeName attr) tuple2
141 atomForAttributeName (attributeName attr) tuple2
142 ) attrs1
142 ) attrs1
143 indexFilter = V.ifilter (\index _ -> V.elem index matchingIndices)
143 indexFilter = V.ifilter (\index _ -> V.elem index matchingIndices)
144 newAttrs = indexFilter attrs1
144 newAttrs = indexFilter attrs1
145 newTupVec = indexFilter (tupleAtoms tuple1)
145 newTupVec = indexFilter (tupleAtoms tuple1)
146−
146+
147updateTuple :: (M.Map AttributeName Atom) -> RelationTuple -> RelationTuple
147updateTuple :: (M.Map AttributeName Atom) -> RelationTuple -> RelationTuple
148updateTuple updateMap (RelationTuple attrs tupVec) = RelationTuple attrs newVec
148updateTuple updateMap (RelationTuple attrs tupVec) = RelationTuple attrs newVec
149 where
149 where
@@ -156,9 +156,9 @@ tupleToMap :: RelationTuple -> (M.Map AttributeName Atom)
156tupleToMap (RelationTuple attrs tupVec) = M.fromList assocList
156tupleToMap (RelationTuple attrs tupVec) = M.fromList assocList
157 where
157 where
158 assocList = V.toList $ V.map (\(index, attr) -> (attributeName attr, tupVec V.! index)) (V.indexed attrs)
158 assocList = V.toList $ V.map (\(index, attr) -> (attributeName attr, tupVec V.! index)) (V.indexed attrs)
159−
159+
160verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
160verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
161−verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs
161+verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs
162 tupleTypes = V.map atomTypeForAtom (tupleAtoms tuple) in
162 tupleTypes = V.map atomTypeForAtom (tupleAtoms tuple) in
163 if V.length attrs /= V.length tupleTypes then
163 if V.length attrs /= V.length tupleTypes then
164 Left $ TupleAttributeCountMismatchError 0
164 Left $ TupleAttributeCountMismatchError 0
@@ -168,7 +168,7 @@ verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs
168 else
168 else
169 Right $ tuple
169 Right $ tuple
170
170
171−--two tuples can be equal but the vectors of attributes could be out-of-order
171+--two tuples can be equal but the vectors of attributes could be out-of-order
172--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering
172--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering
173reorderTuple :: Attributes -> RelationTuple -> RelationTuple
173reorderTuple :: Attributes -> RelationTuple -> RelationTuple
174reorderTuple attrs tupIn = if tupleAttributes tupIn == attrs then
174reorderTuple attrs tupIn = if tupleAttributes tupIn == attrs then