git.iko.soy/project-m36
on f843252 help sign in
project-m36/src/lib/ProjectM36/DataFrame.hs
183 lines 7.8 kB history raw
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass, DerivingVia #-}
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 Control.Arrow
20#if __GLASGOW_HASKELL__ < 804
21import Data.Monoid
22#endif
24data AttributeOrderExpr = AttributeOrderExpr AttributeName Order
25 deriving (Show, Generic)
27data AttributeOrder = AttributeOrder AttributeName Order
28 deriving (Show, Generic)
30data Order = AscendingOrder | DescendingOrder
31 deriving (Eq, Show, Generic)
33ascending :: T.Text
34ascending = "⬆"
36descending :: T.Text
37descending = "⬇"
39arbitrary :: T.Text
40arbitrary = "↕"
42data DataFrame = DataFrame {
43 orders :: [AttributeOrder],
44 attributes :: Attributes,
45 tuples :: [DataFrameTuple]
46 }
47 deriving (Show, Generic)
49data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom)
50 deriving (Eq, Show, Generic)
52sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame
53sortDataFrameBy attrOrders frame = do
54 attrs <- mapM (\(AttributeOrder nam _) -> A.attributeForName nam (attributes frame)) attrOrders
55 mapM_ (\attr -> if not (isSortableAtomType (atomType attr)) then
56 Left (AttributeNotSortableError attr)
57 else
58 pure ()) attrs
59 pure $ DataFrame attrOrders (attributes frame) (sortTuplesBy (compareTupleByAttributeOrders attrOrders) (tuples frame))
61sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple]
62sortTuplesBy = L.sortBy
64compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering
65compareTupleByAttributeOrders attributeOrders tup1 tup2 =
66 let compare' (AttributeOrder attr order) = if order == DescendingOrder
67 then compareTupleByOneAttributeName attr tup2 tup1
68 else compareTupleByOneAttributeName attr tup1 tup2
69 res = map compare' attributeOrders in
70 fromMaybe EQ (L.find (/= EQ) res)
72compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering
73compareTupleByOneAttributeName attr tuple1 tuple2 =
74 let eAtom1 = atomForAttributeName attr tuple1
75 eAtom2 = atomForAttributeName attr tuple2 in
76 case eAtom1 of
77 Left err -> error (show err)
78 Right atom1 ->
79 case eAtom2 of
80 Left err -> error (show err)
81 Right atom2 -> compareAtoms atom1 atom2
83atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom
84atomForAttributeName attrName (DataFrameTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of
85 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
86 Just index -> case tupVec V.!? index of
87 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
88 Just atom -> Right atom
90take' :: Integer -> DataFrame -> DataFrame
91take' n df = df { tuples = take (fromInteger n) (tuples df) }
93drop' :: Integer -> DataFrame -> DataFrame
94drop' n df = df { tuples = drop (fromInteger n) (tuples df) }
96toDataFrame :: Relation -> DataFrame
97toDataFrame (Relation attrs (RelationTupleSet tuples')) = DataFrame [] attrs (map (\(RelationTuple tupAttrs tupVec) -> DataFrameTuple tupAttrs tupVec) tuples')
99fromDataFrame :: DataFrame -> Either RelationalError Relation
100fromDataFrame df = R.mkRelation (attributes df) (RelationTupleSet tuples')
101 where
102 tuples' = map (\(DataFrameTuple attrs' tupVec) -> RelationTuple attrs' tupVec) (tuples df)
104showDataFrame :: DataFrame -> T.Text
105showDataFrame = renderTable . dataFrameAsTable
107--terminal display
108dataFrameAsTable :: DataFrame -> Table
109dataFrameAsTable df = (header, body)
110 where
111 oAttrNames = orderedAttributeNames (attributes df)
112 oAttrs = orderedAttributes (attributes df)
113 header = "DF" : map dfPrettyAttribute oAttrs
114 dfPrettyAttribute attr = prettyAttribute attr <> case L.find (\(AttributeOrder nam _) -> nam == attributeName attr) (orders df) of
115 Nothing -> arbitrary
116 Just (AttributeOrder _ AscendingOrder) -> ascending
117 Just (AttributeOrder _ DescendingOrder) -> descending
118 body = snd (L.foldl' tupleFolder (1 :: Int,[]) (tuples df))
119 tupleFolder (count, acc) tuple = (count + 1,
120 acc ++ [T.pack (show count) : map (\attrName -> case atomForAttributeName attrName tuple of
121 Left _ -> "?"
122 Right atom -> showAtom 0 atom
123 ) oAttrNames])
125-- | A Relation can be converted to a DataFrame for sorting, limits, and offsets.
126data DataFrameExpr = DataFrameExpr {
127 convertExpr :: RelationalExpr,
128 orderExprs :: [AttributeOrderExpr],
129 offset :: Maybe Integer,
130 limit :: Maybe Integer
131 }
132 deriving (Show, Generic)
134dataFrameAsHTML :: DataFrame -> T.Text
135-- 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
136dataFrameAsHTML df
137 | length (tuples df) == 1 && L.null (attributes df) = style <>
138 tablestart <>
139 "<tr><th></th></tr>" <>
140 "<tr><td></td></tr>" <>
141 tablefooter <> "</table>"
142 | L.null (tuples df) && L.null (attributes df) = style <>
143 tablestart <>
144 "<tr><th></th></tr>" <>
145 tablefooter <>
146 "</table>"
147 | otherwise = style <>
148 tablestart <>
149 attributesAsHTML (attributes df) (orders df) <>
150 tuplesAsHTML (tuples df) <>
151 tablefooter <>
152 "</table>"
153 where
154 cardinality = T.pack (show (length (tuples df)))
155 style = "<style>.pm36dataframe {empty-cells: show;} .pm36dataframe tbody td, .pm36relation th { border: 1px solid black;}</style>"
156 tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> cardinality <> " tuples</td></tr></tfoot>"
157 tablestart = "<table class=\"pm36dataframe\"\">"
159tuplesAsHTML :: [DataFrameTuple] -> T.Text
160tuplesAsHTML = foldr folder ""
161 where
162 folder tuple acc = acc <> tupleAsHTML tuple
164tupleAssocs :: DataFrameTuple -> [(AttributeName, Atom)]
165tupleAssocs (DataFrameTuple attrVec tupVec) = V.toList $ V.map (first attributeName) (V.zip attrVec tupVec)
168tupleAsHTML :: DataFrameTuple -> T.Text
169tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"
170 where
171 tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
172 atomAsHTML (RelationAtom rel) = RelHTML.relationAsHTML rel
173 atomAsHTML (TextAtom t) = "&quot;" <> t <> "&quot;"
174 atomAsHTML atom = atomToText atom
176attributesAsHTML :: Attributes -> [AttributeOrder] -> T.Text
177attributesAsHTML attrs orders' = "<tr>" <> T.concat (map oneAttrHTML (V.toList attrs)) <> "</tr>"
178 where
179 oneAttrHTML attr = "<th>" <> prettyAttribute attr <> ordering (attributeName attr) <> "</th>"
180 ordering attrName = " " <> case L.find (\(AttributeOrder nam _) -> nam == attrName) orders' of
181 Nothing -> "(arb)"
182 Just (AttributeOrder _ AscendingOrder) -> "(asc)"
183 Just (AttributeOrder _ DescendingOrder) -> "(desc)"