git.iko.soy/project-m36
on master help sign in
add difference operator
commit281683d0a8b0515b25fe84f7479fac7f0d7be854 authorAgentM <agentm@themactionfaction.com> dateFri 1 Apr 2016, 13:48 (11 years ago) parent489f43e
6 files changed+47−3
compare with master
unifiedsplit
ProjectM36/Base.hs+2 ProjectM36/Relation.hs+14−1 ProjectM36/RelationalExpression.hs+10−1 ProjectM36/StaticOptimizer.hs+15 TutorialD/Interpreter/RelationalExpr.hs+1 test/TutorialD/Interpreter.hs+5−1
ProjectM36/Base.hs+2
@@ -252,6 +252,8 @@ data RelationalExpr where
252252 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr
253253 --- | Rename an attribute (first argument) to another (second argument).
254254 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
255257 --- | 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.>
256258 Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr
257259 --- | 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
217217 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)
218218 newTupSet <- mkTupleSet newAttrs newTupSetList
219219 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+
221234--a map should NOT change the structure of a relation, so attributes should be constant
222235relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation
223236relMap mapper (Relation attrs tupleSet) = do
ProjectM36/RelationalExpression.hs+10−1
@@ -51,7 +51,16 @@ evalRelationalExpr (Join exprA exprB) = do
5151 Right relA2 -> case relB of
5252 Left err -> return $ Left err
5353 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+
5564evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) = do
5665 case mkRelation attributeSet tupleSet of
5766 Right rel -> return $ Right rel
ProjectM36/StaticOptimizer.hs+15
@@ -58,6 +58,21 @@ applyStaticRelationalOptimization (Join exprA exprB) = do
5858 else
5959 return $ Right (Join optExprA2 optExprB2)
6060
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+
6176applyStaticRelationalOptimization e@(Rename _ _ _) = return $ Right e
6277
6378applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) = do
TutorialD/Interpreter/RelationalExpr.hs+1
@@ -116,6 +116,7 @@ relOperators = [
116116 [Postfix ungroupP],
117117 [Infix (reservedOp "join" >> return Join) AssocLeft],
118118 [Infix (reservedOp "union" >> return Union) AssocLeft],
119+ [Infix (reservedOp "minus" >> return Difference) AssocLeft],
119120 [Infix (reservedOp "=" >> return Equals) AssocNone],
120121 [Postfix extendP]
121122 ]
test/TutorialD/Interpreter.hs+5−1
@@ -35,6 +35,8 @@ main = do
3535 simpleRelTests = [("x:=true", Right relationTrue),
3636 ("x:=false", Right relationFalse),
3737 ("x:=true union false", Right relationTrue),
38+ ("x:=true minus false", Right relationTrue),
39+ ("x:=false minus true", Right relationFalse),
3840 ("x:=true; x:=false", Right relationFalse),
3941 ("x:=relation{a Int}{}", mkRelation simpleAAttributes emptyTupleSet),
4042 ("x:=relation{c Int}{} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),
@@ -82,6 +84,7 @@ main = do
8284 ("x:=s where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),
8385 ("x:=p where color=\"Blue\" and city=\"Paris\"", mkRelationFromList (attributes productsRel) [[textAtom "P5", textAtom "Cam", textAtom "Blue", intAtom 12, textAtom "Paris"]]),
8486 ("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"]]),
8588 --atom function tests
8689 ("x:=((s : {status2 := add(10,@status)}) where status2=add(10,@status)){city,s#,sname,status}", Right suppliersRel),
8790 ("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
286289 executeTutorialD sessionId dbconn "data Hair = Color Text | Bald | UserRefusesToSpecify"
287290 executeTutorialD sessionId dbconn "x:=relation{a Hair}{tuple{a Color \"Blonde\"},tuple{a Bald},tuple{a UserRefusesToSpecify}}"
288291 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+