@@ -0,0 +1,108 @@
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2+{- A dataframe is a strongly-typed, ordered list of named tuples. A dataframe differs from a relation in that its tuples are ordered.-}
3+module ProjectM36.DataFrame where
4+import ProjectM36.Base
5+import ProjectM36.Attribute as A
6+import ProjectM36.Error
7+import qualified ProjectM36.Relation as R
8+import ProjectM36.Relation.Show.Term
9+import ProjectM36.DataTypes.Sorting
10+import ProjectM36.AtomType
11+import qualified Data.Vector as V
12+import GHC.Generics
13+import qualified Data.List as L
14+import qualified Data.Set as S
15+import Data.Maybe
16+import qualified Data.Text as T
17+import Data.Binary
18+
19+data AttributeOrderExpr = AttributeOrderExpr AttributeName Order deriving (Show, Generic, Binary)
20+data AttributeOrder = AttributeOrder AttributeName Order deriving (Show, Generic, Binary)
21+data Order = AscendingOrder | DescendingOrder deriving (Eq, Show, Generic, Binary)
22+
23+data DataFrame = DataFrame Attributes [DataFrameTuple] deriving (Show, Generic, Binary)
24+
25+data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom) deriving (Eq, Show, Generic, Binary)
26+
27+attributes :: DataFrame -> Attributes
28+attributes (DataFrame attrs _) = attrs
29+
30+tuples :: DataFrame -> [DataFrameTuple]
31+tuples (DataFrame _ tups) = tups
32+
33+sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
34+sortDataFrameBy attrOrders frame = do
35+ attrs <- mapM (\(AttributeOrder nam _) -> A.attributeForName nam (attributes frame)) attrOrders
36+ mapM_ (\attr -> if not (isSortableAtomType (atomType attr)) then
37+ Left (AttributeNotSortableError attr)
38+ else
39+ pure ()) attrs
40+ pure $ DataFrame (attributes frame) (sortTuplesBy (compareTupleByAttributeOrders attrOrders) (tuples frame))
41+
42+sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple]
43+sortTuplesBy = L.sortBy
44+
45+compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
46+compareTupleByAttributeOrders attributeOrders tup1 tup2 =
47+ let compare' (AttributeOrder attr order) = if order == DescendingOrder
48+ then compareTupleByOneAttributeName attr tup2 tup1
49+ else compareTupleByOneAttributeName attr tup1 tup2
50+ res = map compare' attributeOrders in
51+ fromMaybe EQ (L.find (/= EQ) res)
52+
53+compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering
54+compareTupleByOneAttributeName attr tuple1 tuple2 =
55+ let eAtom1 = atomForAttributeName attr tuple1
56+ eAtom2 = atomForAttributeName attr tuple2 in
57+ case eAtom1 of
58+ Left err -> error (show err)
59+ Right atom1 ->
60+ case eAtom2 of
61+ Left err -> error (show err)
62+ Right atom2 -> compareAtoms atom1 atom2
63+
64+atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom
65+atomForAttributeName attrName (DataFrameTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of
66+ Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
67+ Just index -> case tupVec V.!? index of
68+ Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
69+ Just atom -> Right atom
70+
71+take' :: Integer -> DataFrame -> DataFrame
72+take' n (DataFrame attrs tuples') = DataFrame attrs (take (fromInteger n) tuples')
73+
74+drop' :: Integer -> DataFrame -> DataFrame
75+drop' n (DataFrame attrs tuples') = DataFrame attrs (drop (fromInteger n) tuples')
76+
77+toDataFrame :: Relation -> DataFrame
78+toDataFrame (Relation attrs (RelationTupleSet tuples')) = DataFrame attrs (map (\(RelationTuple tupAttrs tupVec) -> DataFrameTuple tupAttrs tupVec) tuples')
79+
80+fromDataFrame :: DataFrame -> Either RelationalError Relation
81+fromDataFrame (DataFrame attrs dftuples) = R.mkRelation attrs (RelationTupleSet tuples')
82+ where
83+ tuples' = map (\(DataFrameTuple attrs' tupVec) -> RelationTuple attrs' tupVec) dftuples
84+
85+--terminal display
86+dataFrameAsTable :: DataFrame -> Table
87+dataFrameAsTable (DataFrame attrs tups) = (header, body)
88+ where
89+ oAttrNames = orderedAttributeNames attrs
90+ oAttrs = orderedAttributes attrs
91+ header = "DF" : map prettyAttribute oAttrs
92+ body = snd (L.foldl' tupleFolder (1 :: Int,[]) tups)
93+ tupleFolder (count, acc) tuple = (count + 1,
94+ acc ++ [T.pack (show count) : map (\attrName -> case atomForAttributeName attrName tuple of
95+ Left _ -> "?"
96+ Right atom -> showAtom 0 atom
97+ ) oAttrNames])
98+
99+showDataFrame :: DataFrame -> StringType
100+showDataFrame = renderTable . dataFrameAsTable
101+
102+-- | A Relation can be converted to a DataFrame for sorting, limits, and offsets.
103+data DataFrameExpr = DataFrameExpr {
104+ convertExpr :: RelationalExpr,
105+ orderExprs :: [AttributeOrderExpr],
106+ offset :: Maybe Integer,
107+ limit :: Maybe Integer
108+ } deriving (Show, Binary, Generic)