git.iko.soy/project-m36
on master help sign in
add difference operator
281683dAgentM
ProjectM36/Base.hs+2
compare with master
unifiedsplit
@@ -252,6 +252,8 @@ data RelationalExpr where
252 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr
252 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr
253 --- | Rename an attribute (first argument) to another (second argument).
253 --- | Rename an attribute (first argument) to another (second argument).
254 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
254 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
255+ --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).
256+ Difference :: RelationalExpr -> RelationalExpr -> RelationalExpr
255 --- | Create a sub-relation composed of the first argument's attributes which will become an attribute of the result expression. The unreferenced attributes are not altered in the result but duplicate tuples in the projection of the expression minus the attribute names are compressed into one. For more information, <https://github.com/agentm/project-m36/blob/master/docs/introduction_to_the_relational_algebra.markdown#group read the relational algebra tutorial.>
257 --- | Create a sub-relation composed of the first argument's attributes which will become an attribute of the result expression. The unreferenced attributes are not altered in the result but duplicate tuples in the projection of the expression minus the attribute names are compressed into one. For more information, <https://github.com/agentm/project-m36/blob/master/docs/introduction_to_the_relational_algebra.markdown#group read the relational algebra tutorial.>
256 Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr
258 Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr
257 --- | Create an expression to unwrap a sub-relation contained within at an attribute's name. Note that this is not always an inverse of a group operation.
259 --- | Create an expression to unwrap a sub-relation contained within at an attribute's name. Note that this is not always an inverse of a group operation.
ProjectM36/Relation.hs+14−1
@@ -217,7 +217,20 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do
217 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)
217 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)
218 newTupSet <- mkTupleSet newAttrs newTupSetList
218 newTupSet <- mkTupleSet newAttrs newTupSetList
219 return $ Relation newAttrs newTupSet
219 return $ Relation newAttrs newTupSet
220−
220+
221+-- | Difference takes two relations of the same type and returns a new relation which contains only tuples which appear in the first relation but not the second.
222+difference :: Relation -> Relation -> Either RelationalError Relation
223+difference relA relB =
224+ if not (A.attributesEqual (attributes relA) (attributes relB))
225+ then
226+ Left $ AttributeNamesMismatchError (A.attributeNameSet (A.attributesDifference attrsA attrsB))
227+ else
228+ restrict rfilter relA
229+ where
230+ attrsA = attributes relA
231+ attrsB = attributes relB
232+ rfilter tupInA = relFold (\tupInB acc -> if acc == False then False else if tupInB == tupInA then False else True) True relB
233+
221--a map should NOT change the structure of a relation, so attributes should be constant
234--a map should NOT change the structure of a relation, so attributes should be constant
222relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation
235relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation
223relMap mapper (Relation attrs tupleSet) = do
236relMap mapper (Relation attrs tupleSet) = do
ProjectM36/RelationalExpression.hs+10−1
@@ -51,7 +51,16 @@ evalRelationalExpr (Join exprA exprB) = do
51 Right relA2 -> case relB of
51 Right relA2 -> case relB of
52 Left err -> return $ Left err
52 Left err -> return $ Left err
53 Right relB2 -> return $ join relA2 relB2
53 Right relB2 -> return $ join relA2 relB2
54−
54+
55+evalRelationalExpr (Difference exprA exprB) = do
56+ relA <- evalRelationalExpr exprA
57+ relB <- evalRelationalExpr exprB
58+ case relA of
59+ Left err -> return $ Left err
60+ Right relA2 -> case relB of
61+ Left err -> return $ Left err
62+ Right relB2 -> return $ difference relA2 relB2
63+
55evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) = do
64evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) = do
56 case mkRelation attributeSet tupleSet of
65 case mkRelation attributeSet tupleSet of
57 Right rel -> return $ Right rel
66 Right rel -> return $ Right rel
ProjectM36/StaticOptimizer.hs+15
@@ -58,6 +58,21 @@ applyStaticRelationalOptimization (Join exprA exprB) = do
58 else
58 else
59 return $ Right (Join optExprA2 optExprB2)
59 return $ Right (Join optExprA2 optExprB2)
60
60
61+applyStaticRelationalOptimization (Difference exprA exprB) = do
62+ optExprA <- applyStaticRelationalOptimization exprA
63+ optExprB <- applyStaticRelationalOptimization exprB
64+ case optExprA of
65+ Left err -> return $ Left err
66+ Right optExprA2 -> case optExprB of
67+ Left err -> return $ Left err
68+ Right optExprB2 -> if optExprA == optExprB then do --A difference A == A where false
69+ eEmptyRel <- typeForRelationalExpr optExprA2
70+ case eEmptyRel of
71+ Left err -> pure (Left err)
72+ Right emptyRel -> pure (Right (ExistingRelation emptyRel))
73+ else
74+ return $ Right (Difference optExprA2 optExprB2)
75+
61applyStaticRelationalOptimization e@(Rename _ _ _) = return $ Right e
76applyStaticRelationalOptimization e@(Rename _ _ _) = return $ Right e
62
77
63applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) = do
78applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) = do
TutorialD/Interpreter/RelationalExpr.hs+1
@@ -116,6 +116,7 @@ relOperators = [
116 [Postfix ungroupP],
116 [Postfix ungroupP],
117 [Infix (reservedOp "join" >> return Join) AssocLeft],
117 [Infix (reservedOp "join" >> return Join) AssocLeft],
118 [Infix (reservedOp "union" >> return Union) AssocLeft],
118 [Infix (reservedOp "union" >> return Union) AssocLeft],
119+ [Infix (reservedOp "minus" >> return Difference) AssocLeft],
119 [Infix (reservedOp "=" >> return Equals) AssocNone],
120 [Infix (reservedOp "=" >> return Equals) AssocNone],
120 [Postfix extendP]
121 [Postfix extendP]
121 ]
122 ]
test/TutorialD/Interpreter.hs+5−1
@@ -35,6 +35,8 @@ main = do
35 simpleRelTests = [("x:=true", Right relationTrue),
35 simpleRelTests = [("x:=true", Right relationTrue),
36 ("x:=false", Right relationFalse),
36 ("x:=false", Right relationFalse),
37 ("x:=true union false", Right relationTrue),
37 ("x:=true union false", Right relationTrue),
38+ ("x:=true minus false", Right relationTrue),
39+ ("x:=false minus true", Right relationFalse),
38 ("x:=true; x:=false", Right relationFalse),
40 ("x:=true; x:=false", Right relationFalse),
39 ("x:=relation{a Int}{}", mkRelation simpleAAttributes emptyTupleSet),
41 ("x:=relation{a Int}{}", mkRelation simpleAAttributes emptyTupleSet),
40 ("x:=relation{c Int}{} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),
42 ("x:=relation{c Int}{} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),
@@ -82,6 +84,7 @@ main = do
82 ("x:=s where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),
84 ("x:=s where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),
83 ("x:=p where color=\"Blue\" and city=\"Paris\"", mkRelationFromList (attributes productsRel) [[textAtom "P5", textAtom "Cam", textAtom "Blue", intAtom 12, textAtom "Paris"]]),
85 ("x:=p where color=\"Blue\" and city=\"Paris\"", mkRelationFromList (attributes productsRel) [[textAtom "P5", textAtom "Cam", textAtom "Blue", intAtom 12, textAtom "Paris"]]),
84 ("a:=s; update a (status:=50); x:=a{status}", mkRelation (A.attributesFromList [Attribute "status" intAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "status" intAtomType]) (V.fromList [intAtom 50])])),
86 ("a:=s; update a (status:=50); x:=a{status}", mkRelation (A.attributesFromList [Attribute "status" intAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "status" intAtomType]) (V.fromList [intAtom 50])])),
87+ ("x:=s minus (s where status=20)", mkRelationFromList (attributes suppliersRel) [[textAtom "S2", textAtom "Jones", intAtom 10, textAtom "Paris"], [textAtom "S3", textAtom "Blake", intAtom 30, textAtom "Paris"], [textAtom "S5", textAtom "Adams", intAtom 30, textAtom "Athens"]]),
85 --atom function tests
88 --atom function tests
86 ("x:=((s : {status2 := add(10,@status)}) where status2=add(10,@status)){city,s#,sname,status}", Right suppliersRel),
89 ("x:=((s : {status2 := add(10,@status)}) where status2=add(10,@status)){city,s#,sname,status}", Right suppliersRel),
87 ("x:=s; update x where sname=\"Blake\" (city:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "sname" tuple == (Right $ textAtom "Blake") then updateTuple (M.singleton "city" (textAtom "Boston")) tuple else tuple) suppliersRel),
90 ("x:=s; update x where sname=\"Blake\" (city:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "sname" tuple == (Right $ textAtom "Blake") then updateTuple (M.singleton "city" (textAtom "Boston")) tuple else tuple) suppliersRel),
@@ -286,4 +289,5 @@ testTypeConstructors = TestCase $ do
286 executeTutorialD sessionId dbconn "data Hair = Color Text | Bald | UserRefusesToSpecify"
289 executeTutorialD sessionId dbconn "data Hair = Color Text | Bald | UserRefusesToSpecify"
287 executeTutorialD sessionId dbconn "x:=relation{a Hair}{tuple{a Color \"Blonde\"},tuple{a Bald},tuple{a UserRefusesToSpecify}}"
290 executeTutorialD sessionId dbconn "x:=relation{a Hair}{tuple{a Color \"Blonde\"},tuple{a Bald},tuple{a UserRefusesToSpecify}}"
288 executeTutorialD sessionId dbconn "data Tree a = Node a (Tree a) (Tree a) | EmptyNode"
291 executeTutorialD sessionId dbconn "data Tree a = Node a (Tree a) (Tree a) | EmptyNode"
289− executeTutorialD sessionId dbconn "y:=relation{a Tree Int}{tuple{a Node 3 (Node 4 EmptyNode EmptyNode) EmptyNode},tuple{a Node 4 EmptyNode EmptyNode}}"
292+ executeTutorialD sessionId dbconn "y:=relation{a Tree Int}{tuple{a Node 3 (Node 4 EmptyNode EmptyNode) EmptyNode},tuple{a Node 4 EmptyNode EmptyNode}}"
293+