git.iko.soy/project-m36
on f7fc888 help sign in
project-m36/src/lib/ProjectM36/DataFrame.hs
176 lines 7.8 kB history raw
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.-}
3module ProjectM36.DataFrame where
4import ProjectM36.Base
5import ProjectM36.Attribute as A
6import ProjectM36.Error
7import qualified ProjectM36.Relation as R
8import ProjectM36.Relation.Show.Term
9import qualified ProjectM36.Relation.Show.HTML as RelHTML
10import ProjectM36.DataTypes.Sorting
11import ProjectM36.AtomType
12import ProjectM36.Atom
13import qualified Data.Vector as V
14import GHC.Generics
15import qualified Data.List as L
16import qualified Data.Set as S
17import Data.Maybe
18import qualified Data.Text as T
19import Data.Binary
20import Control.Arrow
21#if __GLASGOW_HASKELL__ < 804
22import Data.Monoid
23#endif
25data AttributeOrderExpr = AttributeOrderExpr AttributeName Order deriving (Show, Generic, Binary)
26data AttributeOrder = AttributeOrder AttributeName Order deriving (Show, Generic, Binary)
27data Order = AscendingOrder | DescendingOrder deriving (Eq, Show, Generic, Binary)
29ascending :: T.Text
30ascending = "⬆"
32descending :: T.Text
33descending = "⬇"
35arbitrary :: T.Text
36arbitrary = "↕"
38data DataFrame = DataFrame {
39 orders :: [AttributeOrder],
40 attributes :: Attributes,
41 tuples :: [DataFrameTuple]
42 } deriving (Show, Generic, Binary)
44data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom) deriving (Eq, Show, Generic, Binary)
46sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
47sortDataFrameBy attrOrders frame = do
48 attrs <- mapM (\(AttributeOrder nam _) -> A.attributeForName nam (attributes frame)) attrOrders
49 mapM_ (\attr -> if not (isSortableAtomType (atomType attr)) then
50 Left (AttributeNotSortableError attr)
51 else
52 pure ()) attrs
53 pure $ DataFrame attrOrders (attributes frame) (sortTuplesBy (compareTupleByAttributeOrders attrOrders) (tuples frame))
55sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple]
56sortTuplesBy = L.sortBy
58compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
59compareTupleByAttributeOrders attributeOrders tup1 tup2 =
60 let compare' (AttributeOrder attr order) = if order == DescendingOrder
61 then compareTupleByOneAttributeName attr tup2 tup1
62 else compareTupleByOneAttributeName attr tup1 tup2
63 res = map compare' attributeOrders in
64 fromMaybe EQ (L.find (/= EQ) res)
66compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering
67compareTupleByOneAttributeName attr tuple1 tuple2 =
68 let eAtom1 = atomForAttributeName attr tuple1
69 eAtom2 = atomForAttributeName attr tuple2 in
70 case eAtom1 of
71 Left err -> error (show err)
72 Right atom1 ->
73 case eAtom2 of
74 Left err -> error (show err)
75 Right atom2 -> compareAtoms atom1 atom2
77atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom
78atomForAttributeName attrName (DataFrameTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of
79 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
80 Just index -> case tupVec V.!? index of
81 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
82 Just atom -> Right atom
84take' :: Integer -> DataFrame -> DataFrame
85take' n df = df { tuples = take (fromInteger n) (tuples df) }
87drop' :: Integer -> DataFrame -> DataFrame
88drop' n df = df { tuples = drop (fromInteger n) (tuples df) }
90toDataFrame :: Relation -> DataFrame
91toDataFrame (Relation attrs (RelationTupleSet tuples')) = DataFrame [] attrs (map (\(RelationTuple tupAttrs tupVec) -> DataFrameTuple tupAttrs tupVec) tuples')
93fromDataFrame :: DataFrame -> Either RelationalError Relation
94fromDataFrame df = R.mkRelation (attributes df) (RelationTupleSet tuples')
95 where
96 tuples' = map (\(DataFrameTuple attrs' tupVec) -> RelationTuple attrs' tupVec) (tuples df)
98showDataFrame :: DataFrame -> T.Text
99showDataFrame = renderTable . dataFrameAsTable
101--terminal display
102dataFrameAsTable :: DataFrame -> Table
103dataFrameAsTable df = (header, body)
104 where
105 oAttrNames = orderedAttributeNames (attributes df)
106 oAttrs = orderedAttributes (attributes df)
107 header = "DF" : map dfPrettyAttribute oAttrs
108 dfPrettyAttribute attr = prettyAttribute attr <> case L.find (\(AttributeOrder nam _) -> nam == attributeName attr) (orders df) of
109 Nothing -> arbitrary
110 Just (AttributeOrder _ AscendingOrder) -> ascending
111 Just (AttributeOrder _ DescendingOrder) -> descending
112 body = snd (L.foldl' tupleFolder (1 :: Int,[]) (tuples df))
113 tupleFolder (count, acc) tuple = (count + 1,
114 acc ++ [T.pack (show count) : map (\attrName -> case atomForAttributeName attrName tuple of
115 Left _ -> "?"
116 Right atom -> showAtom 0 atom
117 ) oAttrNames])
119-- | A Relation can be converted to a DataFrame for sorting, limits, and offsets.
120data DataFrameExpr = DataFrameExpr {
121 convertExpr :: RelationalExpr,
122 orderExprs :: [AttributeOrderExpr],
123 offset :: Maybe Integer,
124 limit :: Maybe Integer
125 } deriving (Show, Binary, Generic)
127dataFrameAsHTML :: DataFrame -> T.Text
128-- web browsers don't display tables with empty cells or empty headers, so we have to insert some placeholders- it's not technically the same, but looks as expected in the browser
129dataFrameAsHTML df
130 | length (tuples df) == 1 && L.null (attributes df) = style <>
131 tablestart <>
132 "<tr><th></th></tr>" <>
133 "<tr><td></td></tr>" <>
134 tablefooter <> "</table>"
135 | L.null (tuples df) && L.null (attributes df) = style <>
136 tablestart <>
137 "<tr><th></th></tr>" <>
138 tablefooter <>
139 "</table>"
140 | otherwise = style <>
141 tablestart <>
142 attributesAsHTML (attributes df) (orders df) <>
143 tuplesAsHTML (tuples df) <>
144 tablefooter <>
145 "</table>"
146 where
147 cardinality = T.pack (show (length (tuples df)))
148 style = "<style>.pm36dataframe {empty-cells: show;} .pm36dataframe tbody td, .pm36relation th { border: 1px solid black;}</style>"
149 tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> cardinality <> " tuples</td></tr></tfoot>"
150 tablestart = "<table class=\"pm36dataframe\"\">"
152tuplesAsHTML :: [DataFrameTuple] -> T.Text
153tuplesAsHTML = foldr folder ""
154 where
155 folder tuple acc = acc <> tupleAsHTML tuple
157tupleAssocs :: DataFrameTuple -> [(AttributeName, Atom)]
158tupleAssocs (DataFrameTuple attrVec tupVec) = V.toList $ V.map (first attributeName) (V.zip attrVec tupVec)
161tupleAsHTML :: DataFrameTuple -> T.Text
162tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"
163 where
164 tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
165 atomAsHTML (RelationAtom rel) = RelHTML.relationAsHTML rel
166 atomAsHTML (TextAtom t) = "&quot;" <> t <> "&quot;"
167 atomAsHTML atom = atomToText atom
169attributesAsHTML :: Attributes -> [AttributeOrder] -> T.Text
170attributesAsHTML attrs orders' = "<tr>" <> T.concat (map oneAttrHTML (V.toList attrs)) <> "</tr>"
171 where
172 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> ordering (attributeName attr) <> "</th>"
173 ordering attrName = " " <> case L.find (\(AttributeOrder nam _) -> nam == attrName) orders' of
174 Nothing -> "(arb)"
175 Just (AttributeOrder _ AscendingOrder) -> "(asc)"
176 Just (AttributeOrder _ DescendingOrder) -> "(desc)"