cb53b9c · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'feature/dataframe' of https://github.com/YuMingLiao/project-m36 into YuMingLiao-feature/dataframe

commitcb53b9ca1eb995f9ed18f3e8c1f159ff3100af9c authorAgentM <agentm@themactionfaction.com> dateFri 3 Aug 2018, 15:44 (8 years ago) parent4b4c0d9 ad6ea6b

3 files changed+123−7

compare with master

unifiedsplit

src/bin/TutorialD/Interpreter/Base.hs+3 src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+55−1 src/lib/ProjectM36/Base.hs+65−6

src/bin/TutorialD/Interpreter/Base.hs+3

@@ -41,6 +41,8 @@ displayOpResult (DisplayParseErrorResult mPromptLength err) = do

4141 pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"

4242 maybe (pure ()) (TIO.putStrLn . pointyString) mPromptLength

4343 TIO.putStr ("ERR:" <> errString)

44+displayOpResult (DisplayDataFrameResult dFrame) = do

45+ TIO.putStrLn (showRelation $ fromDataFrame dFrame)

4446

4547spaceConsumer :: Parser ()

4648spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

@@ -127,6 +129,7 @@ data TutorialDOperatorResult = QuitResult |

127129 DisplayResult StringType |

128130 DisplayIOResult (IO ()) |

129131 DisplayRelationResult Relation |

132+ DisplayDataFrameResult DataFrame |

130133 DisplayErrorResult StringType |

131134 DisplayParseErrorResult (Maybe PromptLength) (ParseError Char Dec) | -- Int refers to length of prompt text

132135 QuietSuccessResult

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+55−1

@@ -1,6 +1,8 @@

11{-# LANGUAGE GADTs #-}

22module TutorialD.Interpreter.RODatabaseContextOperator where

33import ProjectM36.Base

4+import ProjectM36.Attribute (attributeForName)

5+import ProjectM36.Relation (attributes)

46import ProjectM36.Error

57import ProjectM36.InclusionDependency

68import qualified ProjectM36.Client as C

@@ -26,6 +28,7 @@ data RODatabaseContextOperator where

2628 ShowRelationVariables :: RODatabaseContextOperator

2729 ShowAtomFunctions :: RODatabaseContextOperator

2830 ShowDatabaseContextFunctions :: RODatabaseContextOperator

31+ ShowDataFrame :: RelationalExpr -> [AttributeOrderExpr] -> Maybe Integer -> Maybe Integer -> RODatabaseContextOperator

2932 Quit :: RODatabaseContextOperator

3033 deriving (Show)

3134

@@ -81,6 +84,7 @@ roDatabaseContextOperatorP = typeP

8184 <|> showTypesP

8285 <|> showAtomFunctionsP

8386 <|> showDatabaseContextFunctionsP

87+ <|> showDataFrameP

8488 <|> quitP

8589

8690--logically, these read-only operations could happen purely, but not if a remote call is required

@@ -148,6 +152,28 @@ evalRODatabaseContextOp sessionId conn ShowDatabaseContextFunctions = do

148152 Left err -> pure $ DisplayErrorResult (T.pack (show err))

149153 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

150154

155+evalRODatabaseContextOp sessionId conn (ShowDataFrame expr attrOrdersExpr mbOffset mbLimit) = do

156+ res <- C.executeRelationalExpr sessionId conn expr

157+ case res of

158+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)

159+ Right rel -> do

160+ let relAttrs = attributes rel

161+ attrName (AttributeOrderExpr name _) = name

162+ order (AttributeOrderExpr _ ord) = ord

163+ orders = map order attrOrdersExpr

164+ attributeForName' = flip attributeForName relAttrs

165+ attrNames = map attrName attrOrdersExpr

166+ verified = forM attrNames attributeForName'

167+ case verified of

168+ Left err -> pure $ DisplayErrorResult $ T.pack (show err)

169+ Right attrs -> do

170+ let attrOrders = map (\(attr',order')->AttributeOrder attr' order') (zip attrs orders)

171+ let dFrame = sortDataFrameBy attrOrders . toDataFrame $ rel

172+ let dFrame' = maybe dFrame (`drop'` dFrame) mbOffset

173+ let dFrame'' = maybe dFrame' (`take'` dFrame') mbLimit

174+ pure $ DisplayDataFrameResult $ dFrame''

175+

176+

151177evalRODatabaseContextOp _ _ Quit = pure QuitResult

152178

153179interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult

@@ -155,4 +181,32 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo

155181 Left err -> pure $ DisplayErrorResult (T.pack (show err))

156182 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

157183

158−

184+showDataFrameP :: Parser RODatabaseContextOperator

185+showDataFrameP = do

186+ reservedOp ":showdataframe"

187+ relExpr <- relExprP

188+ reservedOp "orderby"

189+ attrOrdersExpr <- attrOrdersExprP

190+ mbOffset <- optional offsetP

191+ mbLimit <- optional limitP

192+ pure $ ShowDataFrame relExpr attrOrdersExpr mbOffset mbLimit

193+

194+

195+offsetP :: Parser Integer

196+offsetP = do

197+ reservedOp "offset"

198+ integer

199+

200+limitP :: Parser Integer

201+limitP = do

202+ reservedOp "limit"

203+ integer

204+

205+attrOrdersExprP :: Parser [AttributeOrderExpr]

206+attrOrdersExprP = braces (sepBy attrOrderExprP comma)

207+

208+attrOrderExprP :: Parser AttributeOrderExpr

209+attrOrderExprP = AttributeOrderExpr <$> identifier <*> orderP

210+

211+orderP :: Parser Order

212+orderP = (try $ reservedOp "ASC" >> pure ASC) <|> (try $ reservedOp "DESC" >> pure DESC) <|> pure ASC

src/lib/ProjectM36/Base.hs+65−6

@@ -37,7 +37,7 @@ data Atom = IntegerAtom Integer |

3737 BoolAtom Bool |

3838 RelationAtom Relation |

3939 ConstructedAtom DataConstructorName AtomType [Atom]

40− deriving (Eq, Show, Binary, Typeable, NFData, Generic)

40+ deriving (Eq, Ord, Show, Binary, Typeable, NFData, Generic)

4141

4242instance Hashable Atom where

4343 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms

@@ -77,7 +77,9 @@ data AtomType = IntAtomType |

7777 TypeVariableType TypeVarName

7878 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor

7979 deriving (Eq, NFData, Generic, Binary, Show)

80−

80+

81+instance Ord AtomType where

82+ compare = undefined

8183type TypeVarMap = M.Map TypeVarName AtomType

8284

8385instance Hashable TypeVarMap where

@@ -122,6 +124,19 @@ instance Eq RelationTupleSet where

122124

123125instance NFData RelationTupleSet where rnf = genericRnf

124126

127+

128+data AttributeOrderExpr = AttributeOrderExpr AttributeName Order deriving(Show)

129+data AttributeOrder = AttributeOrder Attribute Order deriving (Show)

130+data Order = ASC | DESC deriving (Eq,Show)

131+

132+sortDataFrameBy :: [AttributeOrder] -> DataFrame -> DataFrame

133+sortDataFrameBy attrOrders (DataFrame attrs tuples) =

134+ DataFrame attrs $ sortTuplesBy (compareRelationTupleByAttributeOrders attrOrders) tuples

135+

136+sortTuplesBy :: (RelationTuple -> RelationTuple -> Ordering) -> [RelationTuple] -> [RelationTuple]

137+sortTuplesBy compare' tuples =

138+ L.sortBy compare' tuples

139+

125140--the same hash must be generated for equal tuples so that the hashset equality works

126141instance Hashable RelationTuple where

127142 --sanity check the tuple for attribute and tuple counts

@@ -145,15 +160,45 @@ instance Binary RelationTuple

145160instance Eq RelationTuple where

146161 (==) tuple1@(RelationTuple attrs1 _) tuple2@(RelationTuple attrs2 _) = attributesEqual attrs1 attrs2 && atomsEqual

147162 where

148− atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) attrs of

149− Nothing -> Nothing

150− Just index -> tupVec V.!? index

151163 atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) attrs1

152164

165+atomForAttribute attr (RelationTuple attrs tupVec) =

166+ case V.findIndex (== attr) attrs of

167+ Nothing -> Nothing

168+ Just index -> tupVec V.!? index

169+

153170instance NFData RelationTuple where rnf = genericRnf

154171

172+data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom) deriving (Eq, Show, Generic)

173+

174+compareRelationTupleByAttributeOrders :: [AttributeOrder] -> RelationTuple -> RelationTuple -> Ordering

175+compareRelationTupleByAttributeOrders attributeOrders tup1 tup2 =

176+ let order_ (AttributeOrder _ ord) = ord

177+ attr_ (AttributeOrder attr _) = attr

178+ compare' (AttributeOrder attr order) = if order == DESC

179+ then compareRelationTupleByOneAttribute attr tup2 tup1

180+ else compareRelationTupleByOneAttribute attr tup1 tup2

181+ res = map compare' attributeOrders in

182+ case L.find (/=EQ) res of

183+ Nothing -> EQ

184+ Just order -> order

185+

186+

187+compareRelationTupleByOneAttribute :: Attribute -> RelationTuple -> RelationTuple -> Ordering

188+compareRelationTupleByOneAttribute attr tuple1@(RelationTuple attrs1 tupVec1) tuple2@(RelationTuple attrs2 tupVec2) =

189+ case attr `elem` attrs1 && attr `elem` attrs2 of

190+ True -> compare (atomForAttribute attr tuple1) (atomForAttribute attr tuple2)

191+ False -> error "Comparing two RelationTuples by an non-existent common attribute."

192+

155193data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

156194

195+instance Ord Relation where

196+ compare (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = undefined

197+ (<) = undefined

198+ (<=) = undefined

199+ (>=) = undefined

200+ (>) = undefined

201+

157202instance Eq Relation where

158203 Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2

159204

@@ -167,7 +212,21 @@ instance Hashable Relation where

167212 sortedAttrs = map snd (sortedAttributesIndices attrs)

168213

169214instance Binary Relation

170−

215+

216+data DataFrame = DataFrame Attributes [RelationTuple] deriving (Show, Generic, Typeable)

217+

218+take' :: Integer -> DataFrame -> DataFrame

219+take' n (DataFrame attrs tuples) = DataFrame attrs (take (fromInteger n) tuples)

220+

221+drop' :: Integer -> DataFrame -> DataFrame

222+drop' n (DataFrame attrs tuples) = DataFrame attrs (drop (fromInteger n) tuples)

223+

224+toDataFrame :: Relation -> DataFrame

225+toDataFrame (Relation attrs (RelationTupleSet tuples)) = DataFrame attrs tuples

226+

227+fromDataFrame :: DataFrame -> Relation

228+fromDataFrame (DataFrame attrs tuples) = Relation attrs (RelationTupleSet tuples)

229+

171230-- | Used to represent the number of tuples in a relation.

172231data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)

173232