cb53b9c · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

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

cb53b9cAgentM8 years ago

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

compare with master

unifiedsplit

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

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

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

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

44+displayOpResult (DisplayDataFrameResult dFrame) = do

45+ TIO.putStrLn (showRelation $ fromDataFrame dFrame)

45spaceConsumer :: Parser ()

47spaceConsumer :: Parser ()

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

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

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

127 DisplayResult StringType |

129 DisplayResult StringType |

128 DisplayIOResult (IO ()) |

130 DisplayIOResult (IO ()) |

129 DisplayRelationResult Relation |

131 DisplayRelationResult Relation |

132+ DisplayDataFrameResult DataFrame |

130 DisplayErrorResult StringType |

133 DisplayErrorResult StringType |

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

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

132 QuietSuccessResult

135 QuietSuccessResult

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

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

1{-# LANGUAGE GADTs #-}

2module TutorialD.Interpreter.RODatabaseContextOperator where

3import ProjectM36.Base

4+import ProjectM36.Attribute (attributeForName)

5+import ProjectM36.Relation (attributes)

4import ProjectM36.Error

6import ProjectM36.Error

5import ProjectM36.InclusionDependency

7import ProjectM36.InclusionDependency

6import qualified ProjectM36.Client as C

8import qualified ProjectM36.Client as C

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

26 ShowRelationVariables :: RODatabaseContextOperator

28 ShowRelationVariables :: RODatabaseContextOperator

27 ShowAtomFunctions :: RODatabaseContextOperator

29 ShowAtomFunctions :: RODatabaseContextOperator

28 ShowDatabaseContextFunctions :: RODatabaseContextOperator

30 ShowDatabaseContextFunctions :: RODatabaseContextOperator

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

29 Quit :: RODatabaseContextOperator

32 Quit :: RODatabaseContextOperator

30 deriving (Show)

33 deriving (Show)

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

81 <|> showTypesP

84 <|> showTypesP

82 <|> showAtomFunctionsP

85 <|> showAtomFunctionsP

83 <|> showDatabaseContextFunctionsP

86 <|> showDatabaseContextFunctionsP

87+ <|> showDataFrameP

84 <|> quitP

88 <|> quitP

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

90--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

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

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

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

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

150

154

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+

151evalRODatabaseContextOp _ _ Quit = pure QuitResult

177evalRODatabaseContextOp _ _ Quit = pure QuitResult

152

178

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

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

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

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

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

156 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

182 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

157

183

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 |

37 BoolAtom Bool |

38 RelationAtom Relation |

39 ConstructedAtom DataConstructorName AtomType [Atom]

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

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

42instance Hashable Atom where

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

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

77 TypeVariableType TypeVarName

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

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

80−

80+

81+instance Ord AtomType where

82+ compare = undefined

81type TypeVarMap = M.Map TypeVarName AtomType

83type TypeVarMap = M.Map TypeVarName AtomType

83instance Hashable TypeVarMap where

85instance Hashable TypeVarMap where

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

122

124

123instance NFData RelationTupleSet where rnf = genericRnf

125instance NFData RelationTupleSet where rnf = genericRnf

124

126

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+

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

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

126instance Hashable RelationTuple where

141instance Hashable RelationTuple where

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

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

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

145instance Eq RelationTuple where

160instance Eq RelationTuple where

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

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

147 where

162 where

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

149− Nothing -> Nothing

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

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

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

152

164

165+atomForAttribute attr (RelationTuple attrs tupVec) =

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

167+ Nothing -> Nothing

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

169+

153instance NFData RelationTuple where rnf = genericRnf

170instance NFData RelationTuple where rnf = genericRnf

154

171

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+

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

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

156

194

195+instance Ord Relation where

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

197+ (<) = undefined

198+ (<=) = undefined

199+ (>=) = undefined

200+ (>) = undefined

201+

157instance Eq Relation where

202instance Eq Relation where

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

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

159

204

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

167 sortedAttrs = map snd (sortedAttributesIndices attrs)

212 sortedAttrs = map snd (sortedAttributesIndices attrs)

168

213

169instance Binary Relation

214instance 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+

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

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

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

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

173

232