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