78bc7c6 · project-m36 · git.iko.soy

git.iko.soy/project-m36

add “all but” convenience syntax

it turns out that there are some logical projection use cases (such as group) where inverting the attribute names is handy as well

commit78bc7c6465963195bc5fab4d1154a4d71c358533 authorAgentM <agentm@Ian-McAuleys-MacBook-Pro.local> dateThu 4 Jun 2015, 23:37 (11 years ago) parentdb6f80d

10 files changed+41−33

compare with master

unifiedsplit

ProjectM36/Attribute.hs+1 ProjectM36/Base.hs+6−2 ProjectM36/Relation.hs+14−21 ProjectM36/RelationalExpression.hs+2−2 ProjectM36/StaticOptimizer.hs+2−1 TutorialD/Interpreter/Base.hs+4 TutorialD/Interpreter/RelationalExpr.hs+7−5 project-m36.cabal+1 test/Relation/StaticOptimizer.hs+1−1 test/TutorialD/Interpreter.hs+3−1

ProjectM36/Attribute.hs+1

@@ -116,3 +116,4 @@ verifyAttributes attrs = if collapsedAttrs /= attrs then

116116

117117attributesEqual :: Attributes -> Attributes -> Bool

118118attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)

119+

ProjectM36/Base.hs+6−2

@@ -104,11 +104,11 @@ data RelationalExpr where

104104 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

105105 --relational variables should also be able to be explicitly-typed like in Haskell

106106 RelationVariable :: RelVarName -> RelationalExpr

107− Project :: S.Set AttributeName -> RelationalExpr -> RelationalExpr

107+ Project :: AttributeNames -> RelationalExpr -> RelationalExpr

108108 Union :: RelationalExpr -> RelationalExpr -> RelationalExpr

109109 Join :: RelationalExpr -> RelationalExpr -> RelationalExpr

110110 Rename :: AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr

111− Group :: S.Set AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr

111+ Group :: AttributeNames -> AttributeName -> RelationalExpr -> RelationalExpr

112112 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

113113 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

114114 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

@@ -227,3 +227,7 @@ instance Show AtomFunction where

227227 show aFunc = T.unpack (atomFuncName aFunc) ++ "::" ++ showArgTypes

228228 where

229229 showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

230+

231+data AttributeNames = AttributeNames (S.Set AttributeName) |

232+ InvertedAttributeNames (S.Set AttributeName)

233+ deriving (Eq, Show)

ProjectM36/Relation.hs+14−21

@@ -9,6 +9,7 @@ import qualified Data.Vector as V

99import ProjectM36.Base

1010import ProjectM36.Tuple

1111import qualified ProjectM36.Attribute as A

12+import qualified ProjectM36.AttributeNames as AS

1213import ProjectM36.TupleSet

1314import ProjectM36.Error

1415import Prelude hiding (join)

@@ -79,18 +80,19 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

7980 where

8081 newtuples = HS.union tupSet1 tupSet2

8182

82−project :: S.Set AttributeName -> Relation -> Either RelationalError Relation

83+project :: AttributeNames -> Relation -> Either RelationalError Relation

8384project projectionAttrNames rel =

84− if not $ A.attributeNamesContained projectionAttrNames (attributeNames rel)

85+ if not $ A.attributeNamesContained selectedAttrNames (attributeNames rel)

8586 then Left $ AttributeNameMismatchError ""

8687 else

8788 relFold folder (Right $ Relation newAttrs HS.empty) rel

8889 where

89− newAttrs = attributesForNames projectionAttrNames rel

90+ selectedAttrNames = A.attributeNameSet newAttrs

91+ newAttrs = AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames

9092 folder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

9193 folder tupleToProject acc = case acc of

9294 Left err -> Left err

93− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject projectionAttrNames tupleToProject)))

95+ Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleProject selectedAttrNames tupleToProject)))

9496

9597rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

9698rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet) =

@@ -127,9 +129,8 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

127129 relFold folder (Right (Relation newAttrs emptyTupleSet)) nonGroupProjection

128130 where

129131 newAttrs = M.union (attributesForNames nonGroupAttrNames rel) groupAttr

130− groupAttr = Attribute newAttrName RelationAtomType (attributesForNames nonGroupAttrNames rel)

131− newAttrNameSet = S.insert newAttrName nonGroupAttrNames

132− nonGroupAttrNames = S.difference groupAttrNames (attributeNames rel)

132+ groupAttr = Attribute newAttrName RelationAtomType (invertedAttributeNames groupAttrNames (attributes rel))

133+ nonGroupAttrNames = invertAttributeNames (attributes rel) groupAttrNames

133134 --map the projection to add the additional new attribute

134135 --create the new attribute (a new relation) by filtering and projecting the tupleSet

135136 folder tupleFromProjection acc = case acc of

@@ -138,26 +139,18 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

138139-}

139140

140141--algorithm: self-join with image relation

141−group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

142+group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation

142143group groupAttrNames newAttrName rel = do

143144 nonGroupProjection <- project nonGroupAttrNames rel

144145 relMogrify mogrifier newAttrs nonGroupProjection

145146 where

146− newAttrs = A.addAttribute groupAttr (attributesForNames nonGroupAttrNames rel)

147− groupAttr = Attribute newAttrName (RelationAtomType (attributesForNames groupAttrNames rel))

148− nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (attributeNames rel)

147+ newAttrs = A.addAttribute groupAttr (AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames)

148+ groupAttr = Attribute newAttrName (RelationAtomType (AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames))

149+ nonGroupAttrNames = AS.invertAttributeNames groupAttrNames

149150 mogrifier tupIn = tupleExtend tupIn (matchingRelTuple tupIn)

150151 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

151152 Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

152153 Left _ -> undefined

153−{-

154− folder tupleIn acc = case acc of

155− Left err -> Left err

156− Right acc2 -> union acc2 (Relation newAttrs (HS.singleton (tupleExtend tupleIn (matchingRelTuple tupleIn))))

157− matchingRelTuple groupTuple = case imageRelationFor groupTuple rel of

158− Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

159− Left _ -> undefined

160−-}

161154

162155--help restriction function

163156--returns a subrelation of

@@ -245,8 +238,8 @@ relFold folder acc (Relation _ tupleSet) = HS.foldr folder acc tupleSet

245238imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

246239imageRelationFor matchTuple rel = do

247240 restricted <- restrictEq matchTuple rel --restrict across matching tuples

248− project (A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)) restricted --project across attributes not in rel

249−

241+ let projectionAttrNames = AttributeNames $ A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)

242+ project projectionAttrNames restricted --project across attributes not in rel

250243

251244--returns a relation-valued attribute image relation for each tuple in rel1

252245--algorithm:

ProjectM36/RelationalExpression.hs+2−2

@@ -22,10 +22,10 @@ evalRelationalExpr (RelationVariable name) = do

2222 Just res -> Right res

2323 Nothing -> Left $ RelVarNotDefinedError name

2424

25−evalRelationalExpr (Project attrNameSet expr) = do

25+evalRelationalExpr (Project attrNames expr) = do

2626 rel <- evalRelationalExpr expr

2727 case rel of

28− Right rel2 -> return $ project attrNameSet rel2

28+ Right rel2 -> return $ project attrNames rel2

2929 Left err -> return $ Left err

3030

3131evalRelationalExpr (Union exprA exprB) = do

ProjectM36/StaticOptimizer.hs+2−1

@@ -3,6 +3,7 @@ import ProjectM36.Base

33import ProjectM36.RelationalExpression

44import ProjectM36.Relation

55import ProjectM36.Error

6+import qualified ProjectM36.AttributeNames as AS

67import ProjectM36.TupleSet

78import Control.Monad.State hiding (join)

89import Data.Either (rights, lefts)

@@ -23,7 +24,7 @@ applyStaticRelationalOptimization (Project attrNameSet expr) = do

2324 relType <- typeForRelationalExpr expr

2425 case relType of

2526 Left err -> return $ Left err

26− Right relType2 -> if attributeNames relType2 == attrNameSet then

27+ Right relType2 -> if attributeNames relType2 == AS.attributeNameSet attrNameSet then

2728 applyStaticRelationalOptimization expr

2829 else do

2930 optimizedSubExpression <- applyStaticRelationalOptimization expr

TutorialD/Interpreter/Base.hs+4

@@ -39,6 +39,9 @@ comma = Token.comma lexer

3939semi :: Parser String

4040semi = Token.semi lexer

4141

42+whiteSpace :: Parser ()

43+whiteSpace = Token.whiteSpace lexer

44+

4245--convert Tutorial D type to AtomType

4346tutDTypeToAtomType :: String -> Maybe AtomType

4447tutDTypeToAtomType tutDType = case tutDType of

@@ -65,3 +68,4 @@ data TutorialDOperatorResult = QuitResult |

6568 DisplayResult StringType |

6669 DisplayErrorResult StringType |

6770 QuietSuccessResult

71+

TutorialD/Interpreter/RelationalExpr.hs+7−5

@@ -16,10 +16,12 @@ import Control.Applicative (liftA, (<*), (*>), (<$>))

1616import Data.Functor.Identity (Identity)

1717

1818--used in projection

19−attributeListP :: Parser [AttributeName]

19+attributeListP :: Parser AttributeNames

2020attributeListP = do

21+ but <- try (string "all but " <* whiteSpace) <|> string ""

22+ let constructor = if but == "" then AttributeNames else InvertedAttributeNames

2123 attrs <- sepBy identifier comma

22− return $ map T.pack attrs

24+ return $ constructor (S.fromList (map T.pack attrs))

2325

2426makeRelationP :: Parser RelationalExpr

2527makeRelationP = do

@@ -69,7 +71,7 @@ tupleAtomP = do

6971projectP :: Parser (RelationalExpr -> RelationalExpr)

7072projectP = do

7173 attrs <- braces attributeListP

72− return $ Project (S.fromList attrs)

74+ return $ Project attrs

7375

7476renameClauseP :: Parser (String, String)

7577renameClauseP = do

@@ -90,7 +92,7 @@ whereClauseP = do

9092 boolExpr <- restrictionPredicateP

9193 return $ Restrict boolExpr

9294

93−groupClauseP :: Parser ([AttributeName], String)

95+groupClauseP :: Parser (AttributeNames, String)

9496groupClauseP = do

9597 attrs <- braces attributeListP

9698 reservedOp "as"

@@ -101,7 +103,7 @@ groupP :: Parser (RelationalExpr -> RelationalExpr)

101103groupP = do

102104 reservedOp "group"

103105 (groupAttrList, groupAttrName) <- parens groupClauseP

104− return $ Group (S.fromList groupAttrList) (T.pack groupAttrName)

106+ return $ Group groupAttrList (T.pack groupAttrName)

105107

106108--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.

107109ungroupP :: Parser (RelationalExpr -> RelationalExpr)

project-m36.cabal+1

@@ -13,6 +13,7 @@ Library

1313 ProjectM36.Transaction.Show,

1414 ProjectM36.Base,

1515 ProjectM36.Attribute,

16+ ProjectM36.AttributeNames,

1617 ProjectM36.Tuple,

1718 ProjectM36.TupleSet,

1819 ProjectM36.Atom,

test/Relation/StaticOptimizer.hs+1−1

@@ -16,7 +16,7 @@ main = do

1616 tests = relationOptTests ++ databaseOptTests

1717 optTest optfunc testparams = map (\(name, expr, unopt) -> TestCase $ assertEqual name expr (evalState (optfunc unopt) dateExamples)) $ testparams

1818 relationOptTests = optTest applyStaticRelationalOptimization [

19− ("StaticProject", Right $ RelationVariable "S", Project (attributeNames suppliersRel) (RelationVariable "S")),

19+ ("StaticProject", Right $ RelationVariable "S", Project (AttributeNames (attributeNames suppliersRel)) (RelationVariable "S")),

2020 ("StaticUnion", Right $ RelationVariable "S", Union (RelationVariable "S") (RelationVariable "S")),

2121 ("StaticJoin", Right $ RelationVariable "S", Join (RelationVariable "S") (RelationVariable "S")),

2222 ("StaticRestrictTrue", Right $ RelationVariable "S", Restrict TruePredicate (RelationVariable "S")),

test/TutorialD/Interpreter.hs+3−1

@@ -80,7 +80,9 @@ main = do

8080 ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

8181 [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

8282 ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

83− ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]])

83+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

84+ --test "all but" attribute inversion syntax

85+ ("x:=S{all but S#} = S{CITY,SNAME,STATUS}",Right $ relationTrue)

8486 ]

8587

8688