diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,330 @@ + + +# dataframe-viz + +Plotting for the [`dataframe`](https://hackage.haskell.org/package/dataframe) ecosystem. Two +backends share one API shape: + +- **Terminal** (`DataFrame.Display.Terminal.Plot`) draws straight to the console (built on + [`granite`](https://hackage.haskell.org/package/granite)). +- **Web** emits an interactive **Vega-Lite v5** spec rendered in the browser via `vega-embed` — + a composable grammar of graphics (facet, layer, regression, density, colour/size encodings) + driven by **expressions**, untyped or typed. + +> **This README is a runnable [scripths](https://github.com/DataHaskell/scripths) notebook.** +> Every Haskell block runs top-to-bottom in one shared session. Reproduce every output below with +> `scripths docs/base_scripts/base_readme.md -o README.md` run from `dataframe-viz/`. + +## Setup + +Charts emit a Vega-Lite spec; in the REPL `showInDefaultBrowser` / `showChart` write it to a temp +file and open it. To keep the output here small we print the spec *without* its inlined data via a +tiny `grammar` helper, against this in-memory frame. The `packages:` directive builds against the +local `dataframe-core` / `dataframe-operations` / `dataframe-viz` working trees: + +```haskell +-- cabal: build-depends: text, aeson +-- cabal: packages: ../../../dataframe-core, ../../../dataframe-parsing +-- cabal: packages: ../../../dataframe-operations, ../../../dataframe-viz +-- cabal: default-extensions: OverloadedStrings, TypeApplications, OverloadedLabels +-- cabal: default-extensions: DataKinds, TypeOperators, FlexibleContexts +import DataFrame.Internal.DataFrame (DataFrame, fromNamedColumns) +import DataFrame.Internal.Column (fromList) +import DataFrame.Operators ((|>)) +import qualified DataFrame.Functions as F +import DataFrame.Typed.Types (Column, TypedDataFrame) +import DataFrame.Typed.Freeze (freeze) +import qualified DataFrame.Typed.Expr as TE +import Data.Text (Text) + +import qualified DataFrame.Display.Web.Plot as Plot +import qualified DataFrame.Display.Web.Chart as Chart +import qualified DataFrame.Display.Web.Chart.Typed as TPlot + +import Data.Aeson (Value (Object)) +import Data.Aeson.Text (encodeToLazyText) +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Text.Lazy as TL + +df = fromNamedColumns + [ ("income", fromList [1.5, 2.0, 3.1, 4.2, 5.0, 2.2, 3.3, 1.1 :: Double]) + , ("value", fromList [100, 150, 200, 250, 300, 180, 220, 90 :: Double]) + , ("region", fromList (["INLAND","NEAR BAY","INLAND","NEAR OCEAN","ISLAND","INLAND","NEAR BAY","INLAND"] :: [Text])) + ] + +income = F.col @Double "income" +value = F.col @Double "value" +region = F.col @Text "region" + +-- show a Vega-Lite spec without its (verbose) inlined data. +-- Returns String so scripths prints it raw rather than show-escaped. +grammar v = case v of + Object o -> TL.unpack (encodeToLazyText (Object (KM.delete "data" o))) + _ -> TL.unpack (encodeToLazyText v) +``` + +> + +## Terminal plots + +Terminal plots render to stdout, so they're shown here rather than run: + +```text +import qualified DataFrame.Display.Terminal.Plot as T +T.scatter (T.mkScatter "income" "value") df +T.histogram (T.mkHistogram "income") df +``` + +## Web plots + +Three tiers, all compiling to the same Vega-Lite spec: + +| Module | Keyed by | Use | +|--------|----------|-----| +| `DataFrame.Display.Web.Plot` | string column names | quick one-liners; returns an HTML `String` | +| `DataFrame.Display.Web.Chart` | untyped `Expr` | composable grammar | +| `DataFrame.Display.Web.Chart.Typed` | typed `TExpr` / `TypedDataFrame` | same grammar, `#column` checked against the schema at compile time | + +Vocabulary (re-exported from all three): + +- **Marks** — `Bar Line Point Area Boxplot Arc Rule Tick`. +- **Channels** — `X Y Color Size Shape Opacity Theta Column Row Tooltip Order`. +- **Field types** — `Quantitative Nominal Ordinal Temporal`, inferred from the expression's element type: + +| Haskell type | field type | +|--------------|-----------| +| `Int`, `Double`, `Float`, `Word`, … | `Quantitative` | +| `Text`, `String`, `Bool`, `Char` | `Nominal` | +| `Day`, `UTCTime`, `LocalTime`, … | `Temporal` | +| `Maybe a` | as `a` | + +Override the inferred type with `encAs`. Aggregations (`aggregateOn`): `Count Sum Mean Median Min Max`. + +In the REPL or a notebook you render straight to the browser (these aren't run here): + +```text +Plot.scatter (Plot.mkScatter "income" "value") df >>= Plot.showInDefaultBrowser +Chart.showChart (Chart.chart df |> Chart.mark Chart.Point + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y value) +``` + +### Untyped grammar (`Expr`) + +Build a chart by piping combinators onto `chart df`. A scatter with a categorical colour encoding — +`income :: Expr Double` becomes `quantitative`, `region :: Expr Text` becomes `nominal`: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Point + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y value + |> Chart.enc Chart.Color region)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"color":{"field":"region","type":"nominal"},"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"point"},"width":600} + +Map more columns onto `Size` / `Opacity` / `Shape` / `Tooltip`: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Point + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y value + |> Chart.enc Chart.Size value + |> Chart.enc Chart.Opacity income)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"opacity":{"field":"income","type":"quantitative"},"size":{"field":"value","type":"quantitative"},"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"point"},"width":600} + +`aggregateOn` applies a Vega-Lite aggregate to a channel. Sum `value` by `region`, coloured by region: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Bar + |> Chart.enc Chart.X region + |> Chart.enc Chart.Y value + |> Chart.aggregateOn Chart.Y Chart.Sum + |> Chart.enc Chart.Color region)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"color":{"field":"region","type":"nominal"},"x":{"field":"region","type":"nominal"},"y":{"aggregate":"sum","field":"value","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"bar"},"width":600} + +A histogram is a binned `X` with a counted `Y` — binning and counting are Vega-Lite transforms: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Bar + |> Chart.enc Chart.X income + |> Chart.binX + |> Chart.aggregateOn Chart.Y Chart.Count)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"bin":true,"field":"income","type":"quantitative"},"y":{"aggregate":"count","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"bar"},"width":600} + +A line: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Line + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y value)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"line"},"width":600} + +`encAs` forces a field type; `logScale` puts a channel on a log scale: + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Point + |> Chart.encAs Chart.X income Chart.Ordinal + |> Chart.enc Chart.Y value + |> Chart.logScale Chart.Y)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"field":"income","type":"ordinal"},"y":{"field":"value","scale":{"type":"log"},"type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"point"},"width":600} + +The medium is expressions, not just column names. A non-column expression is evaluated and inlined +under the channel's name (here `y`): + +```haskell +grammar (Chart.toVegaSpec + (Chart.chart df + |> Chart.mark Chart.Point + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y (value + income))) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"field":"income","type":"quantitative"},"y":{"field":"y","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"point"},"width":600} + +`regression` overlays a least-squares line (a second layer) and `facet` splits into small multiples: + +```haskell +grammar (Chart.toVegaSpec + (Chart.regression income value + (Chart.chart df + |> Chart.mark Chart.Point + |> Chart.enc Chart.X income + |> Chart.enc Chart.Y value + |> Chart.facet region))) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","height":400,"layer":[{"encoding":{"column":{"field":"region","type":"nominal"},"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"mark":{"tooltip":true,"type":"point"}},{"encoding":{"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"mark":{"tooltip":true,"type":"line"},"transform":[{"on":"income","regression":"value"}]}],"width":600} + +`density` draws a kernel-density estimate as an area: + +```haskell +grammar (Chart.toVegaSpec + (Chart.density income (Chart.chart df |> Chart.mark Chart.Area))) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"field":"value","type":"quantitative"},"y":{"field":"density","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"area"},"transform":[{"density":"income"}],"width":600} + +`layer` overlays charts that share data: + +```haskell +grammar (Chart.toVegaSpec + (Chart.layer + [ Chart.chart df |> Chart.mark Chart.Point |> Chart.enc Chart.X income |> Chart.enc Chart.Y value + , Chart.chart df |> Chart.mark Chart.Line |> Chart.enc Chart.X income |> Chart.enc Chart.Y value + ])) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","height":400,"layer":[{"encoding":{"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"mark":{"tooltip":true,"type":"point"}},{"encoding":{"x":{"field":"income","type":"quantitative"},"y":{"field":"value","type":"quantitative"}},"mark":{"tooltip":true,"type":"line"}}],"width":600} + +`title` and `size` set the chart title and pixel dimensions. + +### Typed grammar (`TExpr`) + +`DataFrame.Display.Web.Chart.Typed` mirrors every combinator above, over a `TypedDataFrame`, so +`#region` / `#value` are checked against the schema at compile time. `box` draws a +box-and-whisker (quartiles, 1.5×IQR whiskers, outliers): + +```haskell +type Cols = '[ Column "income" Double, Column "value" Double, Column "region" Text ] + +case freeze @Cols df of + Nothing -> "schema mismatch" + Just tdf -> grammar (TPlot.toVegaSpec + (TPlot.chart tdf + |> TPlot.mark TPlot.Boxplot + |> TPlot.enc TPlot.X #region + |> TPlot.enc TPlot.Y #value)) +``` + +> +> {"$schema":"https://vega.github.io/schema/vega-lite/v5.json","encoding":{"x":{"field":"region","type":"nominal"},"y":{"field":"value","type":"quantitative"}},"height":400,"mark":{"tooltip":true,"type":"boxplot"},"width":600} + +A typed one-liner mirrors the string tier, but the labels must exist in the schema (not run here): + +```text +TPlot.scatter #income #value tdf +``` + +### Rendering + +Every tier produces the same outputs: + +- `toVegaSpec :: Chart -> Value` — the Vega-Lite spec as an aeson `Value`. Escape hatch for advanced + use, or hand-off to [`hvega`](https://hackage.haskell.org/package/hvega), which speaks the same spec. +- `toHtml :: Chart -> String` — a self-contained HTML snippet (CDN `vega-embed`, data inlined, so it + renders from a `file://` URL). +- `showChart :: Chart -> IO ()` — write the HTML to a temp file and open the browser. +- `showInDefaultBrowser :: String -> IO ()` — open an HTML `String` (the string tier returns these). + +Frames over ~5,000 rows print a stderr warning, since the data is inlined into the spec. + +### String tier (one-shots) + +`DataFrame.Display.Web.Plot` is the quick path; each call returns an HTML `String` (not run here): + +```text +Plot.bar (Plot.mkBar "region") df -- count rows per region +Plot.histogram (Plot.mkHistogram "income") df +Plot.scatter (Plot.mkScatter "income" "value") df +Plot.line (Plot.mkLine "income" ["value"]) df +Plot.pie (Plot.mkPie "region") df +Plot.box (Plot.mkBox ["income", "value"]) df +``` + +Override defaults with record syntax on the spec: `Bar` has `y`, `agg`, `topN`, `title`, `size`; +`Histogram` has `bins`; `Scatter` has `color`; `Pie` has `names`, `agg`, `topN`; `Box` / `Line` take +a list of columns. E.g. `bar (mkBar "region") { y = Just "value", agg = Sum, topN = Just 5 } df`. + +## Install + +``` +build-depends: dataframe-viz +``` + +The plotting modules are also re-exported from the umbrella `dataframe` package +(`DataFrame.Display.Web.Plot`, `DataFrame.Display.Web.Chart`, `DataFrame.Display.Web.Chart.Typed`). diff --git a/dataframe-viz.cabal b/dataframe-viz.cabal --- a/dataframe-viz.cabal +++ b/dataframe-viz.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: dataframe-viz -version: 1.0.1.1 +version: 1.0.2.0 synopsis: Visualisation/plotting helpers for the dataframe ecosystem. description: @@ -12,8 +12,9 @@ license-file: LICENSE author: Michael Chavinda maintainer: mschavinda@gmail.com -copyright: (c) 2024-2025 Michael Chavinda +copyright: (c) 2024-2026 Michael Chavinda category: Data +extra-doc-files: README.md tested-with: GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 common warnings @@ -30,8 +31,12 @@ DataFrame.Display DataFrame.Display.Terminal.Plot DataFrame.Display.Web.Plot + DataFrame.Display.Web.Chart + DataFrame.Display.Web.Chart.Typed other-modules: DataFrame.Display.Internal.Common + DataFrame.Display.Internal.VegaLite build-depends: base >= 4 && < 5, + aeson >= 0.11.0.0 && < 3, containers >= 0.6.7 && < 0.9, dataframe-core ^>= 1.0, directory >= 1.3.0.0 && < 2, diff --git a/src/DataFrame/Display/Internal/Common.hs b/src/DataFrame/Display/Internal/Common.hs --- a/src/DataFrame/Display/Internal/Common.hs +++ b/src/DataFrame/Display/Internal/Common.hs @@ -20,6 +20,8 @@ -- * Column extraction extractStringColumn, extractNumericColumn, + columnToStrings, + columnToDoubles, -- * Type guards isNumericColumn, @@ -145,25 +147,29 @@ extractStringColumn colName df = case M.lookup colName (columnIndices df) of Nothing -> error $ "Column " ++ T.unpack colName ++ " not found" - Just idx -> - let col = columns df V.! idx - in case col of - BoxedColumn _ (vec :: V.Vector a) -> - case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> V.toList vec - Nothing -> V.toList $ V.map (T.pack . show) vec - UnboxedColumn _ vec -> - V.toList $ VG.map (T.pack . show) (VG.convert vec) + Just idx -> columnToStrings (columns df V.! idx) extractNumericColumn :: (HasCallStack) => T.Text -> DataFrame -> [Double] extractNumericColumn colName df = case M.lookup colName (columnIndices df) of Nothing -> error $ "Column " ++ T.unpack colName ++ " not found" - Just idx -> - let col = columns df V.! idx - in case col of - BoxedColumn _ vec -> vectorToDoubles vec - UnboxedColumn _ vec -> unboxedVectorToDoubles vec + Just idx -> columnToDoubles (columns df V.! idx) + +-- | Render a column's values as strings (identity for @Text@, @show@ otherwise). +columnToStrings :: (HasCallStack) => Column -> [T.Text] +columnToStrings col = case col of + BoxedColumn _ (vec :: V.Vector a) -> + case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> V.toList vec + Nothing -> V.toList $ V.map (T.pack . show) vec + UnboxedColumn _ vec -> + V.toList $ VG.map (T.pack . show) (VG.convert vec) + +-- | Coerce a numeric column to @[Double]@; errors if the element type is not numeric. +columnToDoubles :: (HasCallStack) => Column -> [Double] +columnToDoubles col = case col of + BoxedColumn _ vec -> vectorToDoubles vec + UnboxedColumn _ vec -> unboxedVectorToDoubles vec vectorToDoubles :: forall a. (Columnable a, Show a) => V.Vector a -> [Double] vectorToDoubles vec = diff --git a/src/DataFrame/Display/Internal/VegaLite.hs b/src/DataFrame/Display/Internal/VegaLite.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Internal/VegaLite.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- | +Internal Vega-Lite spec model plus aeson encoding, shared by the web plot +backends. Not part of the public API. + +The encoding medium is the untyped 'Expr'. A channel encoding resolves to a +'ResolvedField' carrying the field name, the Vega-Lite field type (derived from +the expression's Haskell element type) and the column values to inline. +-} +module DataFrame.Display.Internal.VegaLite ( + -- * Spec model + Mark (..), + Channel (..), + FieldType (..), + ChannelEnc (..), + Transform (..), + VLSpec (..), + emptySpec, + chanEnc, + channelName, + + -- * Resolving expressions to fields + ResolvedField (..), + fieldTypeOf, + resolveField, + textField, + numField, + + -- * Encoding to JSON / HTML + specToValue, + inlineRows, + specHtml, + rowCountWarning, +) where + +import qualified Control.Monad +import Data.Aeson (ToJSON (toJSON), Value (Null), object, (.=)) +import qualified Data.Aeson.Key as K +import Data.Aeson.Text (encodeToLazyText) +import qualified Data.List as L +import Data.Maybe (catMaybes, fromMaybe) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Vector as V +import System.IO (hPutStrLn, stderr) +import Type.Reflection (TypeRep, tyConName, typeRep, typeRepTyCon, pattern App) + +import DataFrame.Internal.Column (Column, Columnable, unwrapTypedColumn) +import DataFrame.Internal.DataFrame (DataFrame, getColumn) +import DataFrame.Internal.Expression (Expr (Col)) +import DataFrame.Internal.Interpreter (interpret) + +import DataFrame.Display.Internal.Common (columnToDoubles, columnToStrings) + +-- --------------------------------------------------------------------------- +-- Spec model +-- --------------------------------------------------------------------------- + +data Mark = Bar | Line | Point | Area | Boxplot | Arc | Rule | Tick + deriving (Eq, Show) + +markName :: Mark -> T.Text +markName m = case m of + Bar -> "bar" + Line -> "line" + Point -> "point" + Area -> "area" + Boxplot -> "boxplot" + Arc -> "arc" + Rule -> "rule" + Tick -> "tick" + +data Channel + = X + | Y + | Color + | Size + | Shape + | Column + | Row + | Opacity + | Theta + | Tooltip + | Order + deriving (Eq, Show) + +channelName :: Channel -> T.Text +channelName c = case c of + X -> "x" + Y -> "y" + Color -> "color" + Size -> "size" + Shape -> "shape" + Column -> "column" + Row -> "row" + Opacity -> "opacity" + Theta -> "theta" + Tooltip -> "tooltip" + Order -> "order" + +data FieldType = Quantitative | Nominal | Ordinal | Temporal + deriving (Eq, Show) + +fieldTypeName :: FieldType -> T.Text +fieldTypeName t = case t of + Quantitative -> "quantitative" + Nominal -> "nominal" + Ordinal -> "ordinal" + Temporal -> "temporal" + +{- | A single channel encoding. An empty 'ceField' with a 'ceAggregate' of +@count@ produces a fieldless count aggregation, as Vega-Lite expects. +-} +data ChannelEnc = ChannelEnc + { ceChannel :: Channel + , ceField :: T.Text + , ceType :: FieldType + , ceAggregate :: Maybe T.Text + , ceBin :: Bool + , ceLogScale :: Bool + } + +-- | A bare channel encoding with no aggregation, binning, or log scale. +chanEnc :: Channel -> T.Text -> FieldType -> ChannelEnc +chanEnc ch fld ft = ChannelEnc ch fld ft Nothing False False + +data Transform + = -- | Fit @regression(yField) on xField@ (used inside a layer). + RegressionT T.Text T.Text + | -- | Kernel-density estimate of a field. + DensityT T.Text + deriving (Eq, Show) + +{- | A Vega-Lite spec. When 'vlLayers' is non-empty the spec is a layered +container: the top level carries the shared data and each layer carries its own +mark/encoding/transform. +-} +data VLSpec = VLSpec + { vlMark :: Mark + , vlEncodings :: [ChannelEnc] + , vlTransforms :: [Transform] + , vlTitle :: Maybe T.Text + , vlWidth :: Int + , vlHeight :: Int + , vlLayers :: [VLSpec] + } + +emptySpec :: Mark -> VLSpec +emptySpec m = VLSpec m [] [] Nothing 600 400 [] + +-- --------------------------------------------------------------------------- +-- Field-type inference from the expression's element type +-- --------------------------------------------------------------------------- + +{- | Derive the Vega-Lite field type from a Haskell type: numeric → +'Quantitative', date/time → 'Temporal', everything else → 'Nominal'. @Maybe a@ +classifies as its inner type. +-} +fieldTypeOf :: forall a. (Columnable a) => FieldType +fieldTypeOf = classify (typeRep @a) + +classify :: forall k (x :: k). TypeRep x -> FieldType +classify tr + | nm `elem` quantNames = Quantitative + | nm `elem` temporalNames = Temporal + | nm == "Maybe" = case tr of + App _ arg -> classify arg + _ -> Nominal + | otherwise = Nominal + where + nm = tyConName (typeRepTyCon tr) + quantNames = + [ "Int" + , "Int8" + , "Int16" + , "Int32" + , "Int64" + , "Word" + , "Word8" + , "Word16" + , "Word32" + , "Word64" + , "Integer" + , "Natural" + , "Double" + , "Float" + , "Scientific" + ] + temporalNames = + ["Day", "UTCTime", "LocalTime", "ZonedTime", "TimeOfDay"] + +-- --------------------------------------------------------------------------- +-- Resolving an expression to a field + values +-- --------------------------------------------------------------------------- + +data ResolvedField = ResolvedField + { rfName :: T.Text + , rfType :: FieldType + , rfValues :: [Value] + } + +{- | Resolve an expression against a frame. A bare @Col name@ reuses the named +column; any other expression is materialised with the core interpreter and +stored under the given fallback name. +-} +resolveField :: + forall a. (Columnable a) => DataFrame -> T.Text -> Expr a -> ResolvedField +resolveField df fallbackName expr = + let ft = fieldTypeOf @a + (name, col) = case expr of + Col cname -> (cname, lookupCol cname) + _ -> (fallbackName, materialiseExpr df expr) + in ResolvedField name ft (columnToValues ft col) + where + lookupCol cname = case getColumn cname df of + Just c -> c + Nothing -> + error $ "DataFrame.Display.Web: column not found: " <> T.unpack cname + +materialiseExpr :: (Columnable a) => DataFrame -> Expr a -> Column +materialiseExpr df expr = case interpret df expr of + Right tc -> unwrapTypedColumn tc + Left err -> + error $ "DataFrame.Display.Web: could not evaluate expression: " <> show err + +columnToValues :: FieldType -> Column -> [Value] +columnToValues Quantitative col = map toJSON (columnToDoubles col) +columnToValues _ col = map (toJSON :: T.Text -> Value) (columnToStrings col) + +-- | A nominal field built directly from text values (for pre-computed data). +textField :: T.Text -> [T.Text] -> ResolvedField +textField name vals = ResolvedField name Nominal (map (toJSON :: T.Text -> Value) vals) + +-- | A quantitative field built directly from numeric values (for pre-computed data). +numField :: T.Text -> [Double] -> ResolvedField +numField name vals = ResolvedField name Quantitative (map toJSON vals) + +-- --------------------------------------------------------------------------- +-- Encoding to JSON +-- --------------------------------------------------------------------------- + +schemaUrl :: T.Text +schemaUrl = "https://vega.github.io/schema/vega-lite/v5.json" + +specToValue :: [ResolvedField] -> VLSpec -> Value +specToValue fields spec + | null (vlLayers spec) = + object $ + commonPairs ++ unitPairs spec + | otherwise = + object $ + commonPairs ++ [("layer", toJSON (map (object . unitPairs) (vlLayers spec)))] + where + commonPairs = + catMaybes + [ Just ("$schema" .= schemaUrl) + , fmap ("title" .=) (vlTitle spec) + , Just ("width" .= vlWidth spec) + , Just ("height" .= vlHeight spec) + , Just ("data" .= object ["values" .= inlineRows fields]) + ] + +-- | The mark/encoding/transform pairs of a unit spec (no data — that is shared). +unitPairs :: VLSpec -> [(K.Key, Value)] +unitPairs spec = + catMaybes + [ if null (vlTransforms spec) + then Nothing + else Just ("transform" .= map transformValue (vlTransforms spec)) + , Just ("mark" .= markValue (vlMark spec)) + , Just ("encoding" .= encodingValue (vlEncodings spec)) + ] + +markValue :: Mark -> Value +markValue m = object ["type" .= markName m, "tooltip" .= True] + +encodingValue :: [ChannelEnc] -> Value +encodingValue encs = + object [K.fromText (channelName (ceChannel e)) .= channelValue e | e <- encs] + +channelValue :: ChannelEnc -> Value +channelValue e = + object $ + catMaybes + [ if T.null (ceField e) then Nothing else Just ("field" .= ceField e) + , Just ("type" .= fieldTypeName (ceType e)) + , fmap ("aggregate" .=) (ceAggregate e) + , if ceBin e then Just ("bin" .= True) else Nothing + , if ceLogScale e + then Just ("scale" .= object ["type" .= ("log" :: T.Text)]) + else Nothing + ] + +transformValue :: Transform -> Value +transformValue (RegressionT yField xField) = + object ["regression" .= yField, "on" .= xField] +transformValue (DensityT field) = + object ["density" .= field] + +-- | Build the @data.values@ array of row objects, deduplicating fields by name. +inlineRows :: [ResolvedField] -> Value +inlineRows fields = + let uniq = L.nubBy (\a b -> rfName a == rfName b) fields + vecs = [(rfName f, V.fromList (rfValues f)) | f <- uniq] + n = maximum (0 : map (V.length . snd) vecs) + row i = object [K.fromText nm .= fromMaybe Null (vs V.!? i) | (nm, vs) <- vecs] + in toJSON [row i | i <- [0 .. n - 1]] + +-- --------------------------------------------------------------------------- +-- HTML embedding (vega-embed via CDN) +-- --------------------------------------------------------------------------- + +{- | Render a spec to a self-contained HTML snippet that loads vega/vega-lite/ +vega-embed from a CDN and embeds the chart. Data is inlined, so the snippet +renders correctly even from a @file://@ URL. +-} +specHtml :: T.Text -> [ResolvedField] -> VLSpec -> T.Text +specHtml chartId fields spec = + let specJson = TL.toStrict (encodeToLazyText (specToValue fields spec)) + in T.concat + [ "
\n" + , "\n" + , "\n" + , "\n" + , "\n" + ] + +{- | Warn on stderr when a large number of rows is being inlined, which bloats +the spec and can slow the browser. +-} +rowCountWarning :: [ResolvedField] -> IO () +rowCountWarning fields = do + let n = maximum (0 : map (length . rfValues) fields) + Control.Monad.when (n > 5000) $ + hPutStrLn stderr $ + "DataFrame.Display.Web: inlining " + ++ show n + ++ " rows into the plot spec; consider filtering or aggregating first." diff --git a/src/DataFrame/Display/Web/Chart.hs b/src/DataFrame/Display/Web/Chart.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Web/Chart.hs @@ -0,0 +1,319 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +{- | +A composable, expression-based grammar of graphics over the untyped 'Expr'. +Charts are built by piping combinators and rendered to interactive Vega-Lite. + +@ +import qualified DataFrame.Display.Web.Chart as Plt +import DataFrame.Functions (col) + +Plt.showChart + ( Plt.chart df + |> Plt.mark Plt.Point + |> Plt.enc Plt.X (col \@Double "age") + |> Plt.enc Plt.Y (col \@Double "fare") + |> Plt.enc Plt.Color (col \@Text "class") + ) +@ + +The element type of each encoded expression determines the Vega-Lite field +type (numeric → quantitative, date/time → temporal, otherwise nominal). A bare +column expression encodes that column; any other expression is materialised +with the core interpreter and inlined under the channel's name. + +For the schema-checked typed variant see "DataFrame.Display.Web.Chart.Typed". +-} +module DataFrame.Display.Web.Chart ( + -- * Chart + Chart, + chart, + + -- * Re-exported spec vocabulary + Mark (..), + Channel (..), + FieldType (..), + Agg (..), + + -- * Building blocks + mark, + enc, + encAs, + aggregateOn, + binX, + binY, + facet, + row, + column, + layer, + regression, + density, + logScale, + title, + size, + + -- * Rendering + toVegaSpec, + toHtml, + showChart, + + -- * One-shot convenience plots + scatter, + bar, + histogram, + line, + pie, + box, +) where + +import Data.Aeson (Value) +import Data.Function ((&)) +import qualified Data.Text as T + +import DataFrame.Display.Internal.Common (Agg (..)) +import DataFrame.Display.Internal.VegaLite ( + Channel (..), + ChannelEnc (..), + FieldType (..), + Mark (..), + ResolvedField (..), + Transform (DensityT, RegressionT), + VLSpec (..), + chanEnc, + channelName, + emptySpec, + resolveField, + rowCountWarning, + specHtml, + specToValue, + ) +import DataFrame.Display.Web.Plot (showInDefaultBrowser) +import DataFrame.Internal.Column (Columnable) +import DataFrame.Internal.DataFrame (DataFrame) +import DataFrame.Internal.Expression (Expr) + +-- --------------------------------------------------------------------------- +-- Chart builder +-- --------------------------------------------------------------------------- + +{- | An in-progress chart: the source frame, a mark, channel encodings, the +data fields to inline, transforms, and (for layered charts) sub-layers. +-} +data Chart = Chart + { chDf :: DataFrame + , chMark :: Mark + , chEncs :: [ChannelEnc] + , chFields :: [ResolvedField] + , chTransforms :: [Transform] + , chTitle :: Maybe T.Text + , chW :: Int + , chH :: Int + , chLayers :: [Chart] + } + +-- | Start a chart from a frame. Defaults to a point mark at 600x400. +chart :: DataFrame -> Chart +chart df = Chart df Point [] [] [] Nothing 600 400 [] + +-- | Set the mark type. +mark :: Mark -> Chart -> Chart +mark m c = c{chMark = m} + +{- | Encode an expression on a channel. The field type is inferred from the +expression's element type; use 'encAs' to override. +-} +enc :: (Columnable a) => Channel -> Expr a -> Chart -> Chart +enc ch e c = + let rf = resolveField (chDf c) (channelName ch) e + ce = chanEnc ch (rfName rf) (rfType rf) + in c{chEncs = setChannel ce (chEncs c), chFields = chFields c ++ [rf]} + +-- | Like 'enc' but force the Vega-Lite field type (e.g. 'Temporal', 'Ordinal'). +encAs :: (Columnable a) => Channel -> Expr a -> FieldType -> Chart -> Chart +encAs ch e ft c = + let rf = resolveField (chDf c) (channelName ch) e + ce = chanEnc ch (rfName rf) ft + in c{chEncs = setChannel ce (chEncs c), chFields = chFields c ++ [rf]} + +{- | Apply a declarative aggregation to a channel (computed by Vega-Lite). For +'Count' the field is dropped, matching Vega-Lite's fieldless count. +-} +aggregateOn :: Channel -> Agg -> Chart -> Chart +aggregateOn ch a = + withChannel + ch + ( \e -> + e + { ceAggregate = Just (aggVegaName a) + , ceField = if a == Count then "" else ceField e + } + ) + +-- | Bin the X (resp. Y) channel (Vega-Lite @bin@ transform). +binX, binY :: Chart -> Chart +binX = withChannel X (\e -> e{ceBin = True}) +binY = withChannel Y (\e -> e{ceBin = True}) + +-- | Put a channel on a log scale. +logScale :: Channel -> Chart -> Chart +logScale ch = withChannel ch (\e -> e{ceLogScale = True}) + +-- | Facet into small multiples by a column (alias for 'column'). +facet :: (Columnable a) => Expr a -> Chart -> Chart +facet = column + +-- | Facet across columns / down rows. +column, row :: (Columnable a) => Expr a -> Chart -> Chart +column = enc Column +row = enc Row + +-- | Set the chart title. +title :: T.Text -> Chart -> Chart +title t c = c{chTitle = Just t} + +-- | Set the chart size in pixels. +size :: Int -> Int -> Chart -> Chart +size w h c = c{chW = w, chH = h} + +{- | Overlay several charts that share data into a single layered chart. The +title and size of the first layer are used for the container. +-} +layer :: [Chart] -> Chart +layer [] = error "DataFrame.Display.Web.Chart.layer: empty layer list" +layer cs@(c0 : _) = + c0 + { chLayers = map (\c -> c{chLayers = []}) cs + , chFields = concatMap chFields cs + } + +{- | Add a regression (least-squares) line over the chart, fitting @y@ on @x@. +Produces a layered chart: the original marks plus a fitted line. +-} +regression :: (Columnable a, Columnable b) => Expr a -> Expr b -> Chart -> Chart +regression xE yE c = + let rfx = resolveField (chDf c) "x" xE + rfy = resolveField (chDf c) "y" yE + withData = c{chFields = chFields c ++ [rfx, rfy]} + points = withData{chLayers = []} + lineLayer = + withData + { chMark = Line + , chEncs = + [ chanEnc X (rfName rfx) Quantitative + , chanEnc Y (rfName rfy) Quantitative + ] + , chTransforms = [RegressionT (rfName rfy) (rfName rfx)] + , chLayers = [] + } + in withData{chLayers = [points, lineLayer]} + +{- | Kernel-density estimate of an expression, drawn as an area. Replaces the +chart's mark and encodings with the density curve (Vega-Lite @density@). +-} +density :: (Columnable a) => Expr a -> Chart -> Chart +density e c = + let rf = resolveField (chDf c) "value" e + in c + { chFields = chFields c ++ [rf] + , chMark = Area + , chTransforms = chTransforms c ++ [DensityT (rfName rf)] + , chEncs = + [ chanEnc X "value" Quantitative + , chanEnc Y "density" Quantitative + ] + } + +-- --------------------------------------------------------------------------- +-- Rendering +-- --------------------------------------------------------------------------- + +-- | The Vega-Lite spec as an aeson 'Value' (escape hatch for advanced use / hvega). +toVegaSpec :: Chart -> Value +toVegaSpec c = specToValue (allFields c) (toVLSpec c) + +-- | A self-contained HTML snippet embedding the chart. +toHtml :: Chart -> String +toHtml c = T.unpack (specHtml "vis" (allFields c) (toVLSpec c)) + +-- | Render the chart to a temp file and open it in the default browser. +showChart :: Chart -> IO () +showChart c = do + rowCountWarning (allFields c) + showInDefaultBrowser (toHtml c) + +-- --------------------------------------------------------------------------- +-- One-shot convenience plots (the simple single-line path) +-- --------------------------------------------------------------------------- + +-- | Scatter plot of two expressions. +scatter :: + (Columnable a, Columnable b) => Expr a -> Expr b -> DataFrame -> IO () +scatter xE yE df = showChart (chart df & mark Point & enc X xE & enc Y yE) + +-- | Count of rows per category, as bars. +bar :: (Columnable a) => Expr a -> DataFrame -> IO () +bar xE df = showChart (chart df & mark Bar & enc X xE & aggregateOn Y Count) + +-- | Histogram of a numeric expression (Vega-Lite binning + count). +histogram :: (Columnable a) => Expr a -> DataFrame -> IO () +histogram xE df = + showChart (chart df & mark Bar & enc X xE & binX & aggregateOn Y Count) + +-- | Line chart of @y@ over @x@. +line :: (Columnable a, Columnable b) => Expr a -> Expr b -> DataFrame -> IO () +line xE yE df = showChart (chart df & mark Line & enc X xE & enc Y yE) + +-- | Pie chart counting rows per category. +pie :: (Columnable a) => Expr a -> DataFrame -> IO () +pie cE df = showChart (chart df & mark Arc & enc Color cE & aggregateOn Theta Count) + +-- | Box-and-whisker plot of a numeric expression. +box :: (Columnable a) => Expr a -> DataFrame -> IO () +box yE df = showChart (chart df & mark Boxplot & enc Y yE) + +-- --------------------------------------------------------------------------- +-- Internals +-- --------------------------------------------------------------------------- + +-- | Replace any existing encoding on the same channel (last write wins). +setChannel :: ChannelEnc -> [ChannelEnc] -> [ChannelEnc] +setChannel ce encs = filter ((/= ceChannel ce) . ceChannel) encs ++ [ce] + +-- | Modify the encoding on a channel, creating a fieldless one if absent. +withChannel :: Channel -> (ChannelEnc -> ChannelEnc) -> Chart -> Chart +withChannel ch f c = + let encs = chEncs c + in if any ((== ch) . ceChannel) encs + then c{chEncs = map (\e -> if ceChannel e == ch then f e else e) encs} + else c{chEncs = encs ++ [f (chanEnc ch "" Quantitative)]} + +aggVegaName :: Agg -> T.Text +aggVegaName a = case a of + Count -> "count" + Sum -> "sum" + Mean -> "mean" + Median -> "median" + Min -> "min" + Max -> "max" + +allFields :: Chart -> [ResolvedField] +allFields c = chFields c ++ concatMap allFields (chLayers c) + +toVLSpec :: Chart -> VLSpec +toVLSpec c + | null (chLayers c) = + (emptySpec (chMark c)) + { vlEncodings = chEncs c + , vlTransforms = chTransforms c + , vlTitle = chTitle c + , vlWidth = chW c + , vlHeight = chH c + } + | otherwise = + (emptySpec (chMark c)) + { vlLayers = map toVLSpec (chLayers c) + , vlTitle = chTitle c + , vlWidth = chW c + , vlHeight = chH c + } diff --git a/src/DataFrame/Display/Web/Chart/Typed.hs b/src/DataFrame/Display/Web/Chart/Typed.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Display/Web/Chart/Typed.hs @@ -0,0 +1,196 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} + +{- | +The schema-checked, typed-expression analogue of "DataFrame.Display.Web.Chart". +Charts are built over a 'TypedDataFrame' using typed expressions ('TExpr', +@#col@), so column references are checked against the schema at compile time +and the field type follows from the column's Haskell type. + +@ +{\-\# LANGUAGE OverloadedLabels \#-\} +import qualified DataFrame.Display.Web.Chart.Typed as Plt + +-- one-liner +Plt.scatter #age #fare tdf + +-- composable grammar +Plt.showChart + ( Plt.chart tdf + |> Plt.mark Plt.Boxplot + |> Plt.enc Plt.X #region + |> Plt.enc Plt.Y #value + |> Plt.enc Plt.Color #grp + |> Plt.facet #grp + ) +@ + +Every combinator delegates to "DataFrame.Display.Web.Chart" by unwrapping the +typed expression ('unTExpr') and frame ('unTDF'); the @cols@ phantom is erased +at the boundary. +-} +module DataFrame.Display.Web.Chart.Typed ( + -- * Chart + Chart, + chart, + + -- * Re-exported spec vocabulary + Mark (..), + Channel (..), + FieldType (..), + Agg (..), + + -- * Building blocks + mark, + enc, + encAs, + aggregateOn, + binX, + binY, + facet, + row, + column, + layer, + regression, + density, + logScale, + title, + size, + + -- * Rendering + toVegaSpec, + toHtml, + showChart, + + -- * One-shot convenience plots + scatter, + bar, + histogram, + line, + pie, + box, +) where + +import Data.Aeson (Value) +import Data.Kind (Type) +import qualified Data.Text as T + +import DataFrame.Display.Internal.Common (Agg (..)) +import DataFrame.Display.Internal.VegaLite ( + Channel (..), + FieldType (..), + Mark (..), + ) +import qualified DataFrame.Display.Web.Chart as C +import DataFrame.Internal.Column (Columnable) +import DataFrame.Typed.Types (TExpr (..), TypedDataFrame (..)) + +-- | A typed chart: a phantom-@cols@ wrapper over the untyped builder. +newtype Chart (cols :: [Type]) = Chart C.Chart + +-- | Start a typed chart from a typed frame. +chart :: TypedDataFrame cols -> Chart cols +chart tdf = Chart (C.chart (unTDF tdf)) + +-- | Set the mark type. +mark :: Mark -> Chart cols -> Chart cols +mark m (Chart c) = Chart (C.mark m c) + +-- | Encode a typed expression on a channel (field type inferred from its type). +enc :: (Columnable a) => Channel -> TExpr cols a -> Chart cols -> Chart cols +enc ch te (Chart c) = Chart (C.enc ch (unTExpr te) c) + +-- | Like 'enc' but force the Vega-Lite field type. +encAs :: + (Columnable a) => + Channel -> TExpr cols a -> FieldType -> Chart cols -> Chart cols +encAs ch te ft (Chart c) = Chart (C.encAs ch (unTExpr te) ft c) + +-- | Apply a declarative aggregation to a channel. +aggregateOn :: Channel -> Agg -> Chart cols -> Chart cols +aggregateOn ch a (Chart c) = Chart (C.aggregateOn ch a c) + +-- | Bin the X (resp. Y) channel. +binX, binY :: Chart cols -> Chart cols +binX (Chart c) = Chart (C.binX c) +binY (Chart c) = Chart (C.binY c) + +-- | Put a channel on a log scale. +logScale :: Channel -> Chart cols -> Chart cols +logScale ch (Chart c) = Chart (C.logScale ch c) + +-- | Facet into small multiples by a column (alias for 'column'). +facet :: (Columnable a) => TExpr cols a -> Chart cols -> Chart cols +facet = column + +-- | Facet across columns / down rows. +column, row :: (Columnable a) => TExpr cols a -> Chart cols -> Chart cols +column te (Chart c) = Chart (C.column (unTExpr te) c) +row te (Chart c) = Chart (C.row (unTExpr te) c) + +-- | Set the chart title. +title :: T.Text -> Chart cols -> Chart cols +title t (Chart c) = Chart (C.title t c) + +-- | Set the chart size in pixels. +size :: Int -> Int -> Chart cols -> Chart cols +size w h (Chart c) = Chart (C.size w h c) + +-- | Overlay several charts sharing data into a single layered chart. +layer :: [Chart cols] -> Chart cols +layer cs = Chart (C.layer [c | Chart c <- cs]) + +-- | Add a least-squares regression line fitting @y@ on @x@. +regression :: + (Columnable a, Columnable b) => + TExpr cols a -> TExpr cols b -> Chart cols -> Chart cols +regression xE yE (Chart c) = Chart (C.regression (unTExpr xE) (unTExpr yE) c) + +-- | Kernel-density estimate of an expression, drawn as an area. +density :: (Columnable a) => TExpr cols a -> Chart cols -> Chart cols +density e (Chart c) = Chart (C.density (unTExpr e) c) + +-- | The Vega-Lite spec as an aeson 'Value' (escape hatch for advanced use / hvega). +toVegaSpec :: Chart cols -> Value +toVegaSpec (Chart c) = C.toVegaSpec c + +-- | A self-contained HTML snippet embedding the chart. +toHtml :: Chart cols -> String +toHtml (Chart c) = C.toHtml c + +-- | Render the chart to a temp file and open it in the default browser. +showChart :: Chart cols -> IO () +showChart (Chart c) = C.showChart c + +-- --------------------------------------------------------------------------- +-- One-shot convenience plots +-- --------------------------------------------------------------------------- + +-- | Scatter plot of two typed expressions. +scatter :: + (Columnable a, Columnable b) => + TExpr cols a -> TExpr cols b -> TypedDataFrame cols -> IO () +scatter xE yE tdf = C.scatter (unTExpr xE) (unTExpr yE) (unTDF tdf) + +-- | Count of rows per category, as bars. +bar :: (Columnable a) => TExpr cols a -> TypedDataFrame cols -> IO () +bar xE tdf = C.bar (unTExpr xE) (unTDF tdf) + +-- | Histogram of a numeric expression. +histogram :: (Columnable a) => TExpr cols a -> TypedDataFrame cols -> IO () +histogram xE tdf = C.histogram (unTExpr xE) (unTDF tdf) + +-- | Line chart of @y@ over @x@. +line :: + (Columnable a, Columnable b) => + TExpr cols a -> TExpr cols b -> TypedDataFrame cols -> IO () +line xE yE tdf = C.line (unTExpr xE) (unTExpr yE) (unTDF tdf) + +-- | Pie chart counting rows per category. +pie :: (Columnable a) => TExpr cols a -> TypedDataFrame cols -> IO () +pie cE tdf = C.pie (unTExpr cE) (unTDF tdf) + +-- | Box-and-whisker plot of a numeric expression. +box :: (Columnable a) => TExpr cols a -> TypedDataFrame cols -> IO () +box yE tdf = C.box (unTExpr yE) (unTDF tdf) diff --git a/src/DataFrame/Display/Web/Plot.hs b/src/DataFrame/Display/Web/Plot.hs --- a/src/DataFrame/Display/Web/Plot.hs +++ b/src/DataFrame/Display/Web/Plot.hs @@ -5,14 +5,18 @@ {- | A plotly-express-style one-shot plotting API for HTML output. Mirrors -'DataFrame.Display.Terminal.Plot' but emits embeddable Chart.js HTML. +'DataFrame.Display.Terminal.Plot' but emits embeddable, interactive Vega-Lite +charts (rendered in the browser via vega-embed loaded from a CDN). + +This module is the string-keyed convenience tier. For an expression-based, +composable grammar of graphics see "DataFrame.Display.Web.Chart" (untyped +'Expr') and "DataFrame.Display.Web.Chart.Typed" (typed 'TExpr'). -} module DataFrame.Display.Web.Plot ( -- * Aggregation Agg (..), -- * Output - HtmlPlot (..), showInDefaultBrowser, -- * Layout @@ -64,6 +68,7 @@ import Control.Monad (forM, void) import Data.Char (chr) import qualified Data.List as L +import qualified Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T import GHC.Stack (HasCallStack) @@ -91,16 +96,25 @@ groupWithOtherForPie, isNumericColumn, ) +import DataFrame.Display.Internal.VegaLite ( + Channel (Color, Theta, X, Y), + FieldType (..), + ResolvedField, + VLSpec (..), + chanEnc, + emptySpec, + numField, + specHtml, + textField, + ) +import qualified DataFrame.Display.Internal.VegaLite as VL import DataFrame.Internal.DataFrame (DataFrame, columnNames) -- --------------------------------------------------------------------------- --- Output container + layout +-- Layout -- --------------------------------------------------------------------------- --- | A snippet of HTML containing a Chart.js plot. -newtype HtmlPlot = HtmlPlot T.Text deriving (Show) - --- | Display dimensions for the HTML canvas, in pixels. +-- | Display dimensions for the chart, in pixels. data Size = Size {width :: Int, height :: Int} defaultSize :: Size @@ -115,35 +129,12 @@ (take 64 (randomRs (49, 126) gen :: [Int])) return $ "chart_" <> T.pack (map chr randomWords) -wrapInHTML :: T.Text -> T.Text -> Size -> T.Text -wrapInHTML chartId content sz = - T.concat - [ "\n" - , "\n" - , "\n" - ] - -palette :: [T.Text] -palette = - [ "rgb(255, 99, 132)" - , "rgb(54, 162, 235)" - , "rgb(255, 206, 86)" - , "rgb(75, 192, 192)" - , "rgb(153, 102, 255)" - , "rgb(255, 159, 64)" - , "rgb(201, 203, 207)" - , "rgb(255, 99, 71)" - , "rgb(60, 179, 113)" - , "rgb(238, 130, 238)" - ] +-- | Assemble a chart HTML snippet from resolved data fields and a spec. +renderSpec :: Size -> [ResolvedField] -> VLSpec -> IO String +renderSpec sz fields spec = do + chartId <- generateChartId + let spec' = spec{vlWidth = sz.width, vlHeight = sz.height} + return $ T.unpack $ specHtml chartId fields spec' -- --------------------------------------------------------------------------- -- Bar @@ -161,9 +152,8 @@ mkBar :: T.Text -> Bar mkBar c = Bar c Nothing Sum Nothing Nothing defaultSize -bar :: (HasCallStack) => Bar -> DataFrame -> IO HtmlPlot +bar :: (HasCallStack) => Bar -> DataFrame -> IO String bar spec df = do - chartId <- generateChartId let effectiveAgg = case spec.y of Nothing -> Count Just _ -> spec.agg @@ -172,27 +162,23 @@ chartTitle = case spec.title of Just s -> s Nothing -> autoTitle effectiveAgg spec.y spec.x - labels = T.intercalate "," ["\"" <> label <> "\"" | (label, _) <- rows'] - dataPoints = T.intercalate "," [T.pack (show v) | (_, v) <- rows'] legendLabel = case spec.y of Nothing -> "count" Just yCol -> aggLabel effectiveAgg <> "(" <> yCol <> ")" - jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"bar\",\n data: {\n labels: [" - , labels - , "],\n datasets: [{\n label: \"" - , legendLabel - , "\",\n data: [" - , dataPoints - , "],\n backgroundColor: \"rgba(54, 162, 235, 0.6)\",\n borderColor: \"rgba(54, 162, 235, 1)\",\n borderWidth: 1\n }]\n },\n" - , " options: {\n title: { display: true, text: \"" - , chartTitle - , "\" },\n scales: { yAxes: [{ ticks: { beginAtZero: true } }] }\n }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size + (labels, values) = unzip rows' + fields = + [ textField spec.x labels + , numField legendLabel values + ] + vlSpec = + (emptySpec VL.Bar) + { vlEncodings = + [ chanEnc X spec.x Nominal + , chanEnc Y legendLabel Quantitative + ] + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Histogram @@ -208,42 +194,33 @@ mkHistogram :: T.Text -> Histogram mkHistogram c = Histogram c 30 Nothing defaultSize -histogram :: (HasCallStack) => Histogram -> DataFrame -> IO HtmlPlot +histogram :: (HasCallStack) => Histogram -> DataFrame -> IO String histogram spec df = do - chartId <- generateChartId let values = extractNumericColumn spec.x df (lo, hi) = if null values then (0, 1) else (minimum values, maximum values) binWidth = (hi - lo) / fromIntegral spec.bins binStarts = [lo + fromIntegral i * binWidth | i <- [0 .. spec.bins - 1]] countBin b = length [v | v <- values, v >= b && v < b + binWidth] - counts = map countBin binStarts + counts = map (fromIntegral . countBin) binStarts precision = max 0 $ ceiling (negate $ logBase 10 (max 1e-12 binWidth)) - labels = - T.intercalate - "," - [ "\"" <> T.pack (showFFloat (Just precision) b "") <> "\"" - | b <- binStarts - ] - dataPoints = T.intercalate "," [T.pack (show c) | c <- counts] + binLabels = + [T.pack (showFFloat (Just precision) b "") | b <- binStarts] chartTitle = case spec.title of Just s -> s Nothing -> "histogram of " <> spec.x - jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"bar\",\n data: {\n labels: [" - , labels - , "],\n datasets: [{\n label: \"" - , spec.x - , "\",\n data: [" - , dataPoints - , "],\n backgroundColor: \"rgba(75, 192, 192, 0.6)\",\n borderColor: \"rgba(75, 192, 192, 1)\",\n borderWidth: 1\n }]\n },\n" - , " options: {\n title: { display: true, text: \"" - , chartTitle - , "\" },\n scales: { yAxes: [{ ticks: { beginAtZero: true } }] }\n }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size + fields = + [ textField spec.x binLabels + , numField "count" counts + ] + vlSpec = + (emptySpec VL.Bar) + { vlEncodings = + [ chanEnc X spec.x Ordinal + , chanEnc Y "count" Quantitative + ] + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Scatter @@ -260,62 +237,27 @@ mkScatter :: T.Text -> T.Text -> Scatter mkScatter xc yc = Scatter xc yc Nothing Nothing defaultSize -scatter :: (HasCallStack) => Scatter -> DataFrame -> IO HtmlPlot +scatter :: (HasCallStack) => Scatter -> DataFrame -> IO String scatter spec df = do - chartId <- generateChartId let chartTitle = case spec.title of Just s -> s Nothing -> spec.x <> " vs " <> spec.y xVals = extractNumericColumn spec.x df yVals = extractNumericColumn spec.y df - datasets <- case spec.color of - Nothing -> - return $ - T.singleton '\n' - <> renderSeries chartTitle (head palette) (zip xVals yVals) - Just grp -> do - let groupVals = extractStringColumn grp df - triples = zip3 groupVals xVals yVals - uniq = L.nub groupVals - ds = - [ renderSeries g col [(xv, yv) | (gv, xv, yv) <- triples, gv == g] - | (g, col) <- zip uniq (cycle palette) - ] - return $ T.intercalate ",\n" ds - let jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"scatter\",\n data: {\n datasets: [" - , datasets - , "\n ]\n },\n options: {\n" - , " title: { display: true, text: \"" - , chartTitle - , "\" },\n" - , " scales: {\n" - , " xAxes: [{ scaleLabel: { display: true, labelString: \"" - , spec.x - , "\" } }],\n yAxes: [{ scaleLabel: { display: true, labelString: \"" - , spec.y - , "\" } }]\n }\n }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size - where - renderSeries label col pts = - let body = - T.intercalate - "," - [ "{x:" <> T.pack (show xv) <> ", y:" <> T.pack (show yv) <> "}" | (xv, yv) <- pts - ] - in T.concat - [ " {\n label: \"" - , label - , "\",\n data: [" - , body - , "],\n pointRadius: 4,\n pointBackgroundColor: \"" - , col - , "\"\n }" - ] + baseFields = [numField spec.x xVals, numField spec.y yVals] + baseEncs = [chanEnc X spec.x Quantitative, chanEnc Y spec.y Quantitative] + (fields, encs) = case spec.color of + Nothing -> (baseFields, baseEncs) + Just grp -> + ( baseFields ++ [textField grp (extractStringColumn grp df)] + , baseEncs ++ [chanEnc Color grp Nominal] + ) + vlSpec = + (emptySpec VL.Point) + { vlEncodings = encs + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Line @@ -331,47 +273,37 @@ mkLine :: T.Text -> [T.Text] -> Line mkLine xc ys = Line xc ys Nothing defaultSize -line :: (HasCallStack) => Line -> DataFrame -> IO HtmlPlot +line :: (HasCallStack) => Line -> DataFrame -> IO String line spec df = do - chartId <- generateChartId let chartTitle = case spec.title of Just s -> s Nothing -> case spec.y of [single] -> single <> " over " <> spec.x _ -> T.intercalate ", " spec.y <> " over " <> spec.x - xValues = extractNumericColumn spec.x df - xLabels = T.intercalate "," [T.pack (show v) | v <- xValues] - datasets <- forM (zip spec.y (cycle palette)) $ \(col, c) -> do - let values = extractNumericColumn col df - body = T.intercalate "," [T.pack (show v) | v <- values] - return $ - T.concat - [ " {\n label: \"" - , col - , "\",\n data: [" - , body - , "],\n fill: false,\n borderColor: \"" - , c - , "\",\n tension: 0.1\n }" - ] - let datasetsStr = T.intercalate ",\n" datasets - jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"line\",\n data: {\n labels: [" - , xLabels - , "],\n datasets: [\n" - , datasetsStr - , "\n ]\n },\n options: {\n" - , " title: { display: true, text: \"" - , chartTitle - , "\" },\n" - , " scales: { xAxes: [{ scaleLabel: { display: true, labelString: \"" - , spec.x - , "\" } }] }\n }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size + xVals = extractNumericColumn spec.x df + -- Long-form melt: (x, value, series) so each y column becomes a line. + perSeries = + [ (col, zip xVals (extractNumericColumn col df)) + | col <- spec.y + ] + xsLong = concat [[xv | (xv, _) <- pts] | (_, pts) <- perSeries] + valsLong = concat [[v | (_, v) <- pts] | (_, pts) <- perSeries] + seriesLong = concat [replicate (length pts) col | (col, pts) <- perSeries] + fields = + [ numField spec.x xsLong + , numField "value" valsLong + , textField "series" seriesLong + ] + vlSpec = + (emptySpec VL.Line) + { vlEncodings = + [ chanEnc X spec.x Quantitative + , chanEnc Y "value" Quantitative + , chanEnc Color "series" Nominal + ] + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Pie @@ -389,9 +321,8 @@ mkPie :: T.Text -> Pie mkPie c = Pie c Nothing Count (Just 8) Nothing defaultSize -pie :: (HasCallStack) => Pie -> DataFrame -> IO HtmlPlot +pie :: (HasCallStack) => Pie -> DataFrame -> IO String pie spec df = do - chartId <- generateChartId let vCol = spec.values mNames = spec.names a = spec.agg @@ -408,27 +339,21 @@ in zip [T.pack ("Item " ++ show i) | i <- [1 .. length xs :: Int]] xs (_, Just n) -> aggregateByGroup a n (Just vCol) df rows' = maybe rows (`groupWithOtherForPie` rows) spec.topN - labels = T.intercalate "," ["\"" <> label <> "\"" | (label, _) <- rows'] - dataPoints = T.intercalate "," [T.pack (show v) | (_, v) <- rows'] - colors = - T.intercalate - "," - ["\"" <> c <> "\"" | c <- take (length rows') palette] - jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"pie\",\n data: {\n labels: [" - , labels - , "],\n datasets: [{\n data: [" - , dataPoints - , "],\n backgroundColor: [" - , colors - , "]\n }]\n },\n options: { title: { display: true, text: \"" - , chartTitle - , "\" } }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size + (labels, values) = unzip rows' + catName = Data.Maybe.fromMaybe "category" mNames + fields = + [ textField catName labels + , numField "value" values + ] + vlSpec = + (emptySpec VL.Arc) + { vlEncodings = + [ chanEnc Theta "value" Quantitative + , chanEnc Color catName Nominal + ] + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Box @@ -443,34 +368,27 @@ mkBox :: [T.Text] -> Box mkBox ys = Box ys Nothing defaultSize -box :: (HasCallStack) => Box -> DataFrame -> IO HtmlPlot +box :: (HasCallStack) => Box -> DataFrame -> IO String box spec df = do - chartId <- generateChartId - boxData <- forM spec.y $ \col -> do - let vs = extractNumericColumn col df - sorted = L.sort vs - n = max 1 (length vs) - median = sorted !! (n `div` 2) - return (col, median) - let labels = T.intercalate "," ["\"" <> col <> "\"" | (col, _) <- boxData] - medians = T.intercalate "," [T.pack (show med) | (_, med) <- boxData] + let series = [(col, extractNumericColumn col df) | col <- spec.y] + variableVals = concat [replicate (length vs) col | (col, vs) <- series] + valueVals = concat [vs | (_, vs) <- series] chartTitle = case spec.title of Just s -> s Nothing -> "box plot of " <> T.intercalate ", " spec.y - jsCode = - T.concat - [ "setTimeout(function() { new Chart(\"" - , chartId - , "\", {\n type: \"bar\",\n data: {\n labels: [" - , labels - , "],\n datasets: [{\n label: \"Median\",\n data: [" - , medians - , "],\n backgroundColor: \"rgba(75, 192, 192, 0.6)\",\n borderColor: \"rgba(75, 192, 192, 1)\",\n borderWidth: 1\n }]\n },\n" - , " options: { title: { display: true, text: \"" - , chartTitle - , " (showing medians)\" }, scales: { yAxes: [{ ticks: { beginAtZero: true } }] } }\n})}, 100);" - ] - return $ HtmlPlot $ wrapInHTML chartId jsCode spec.size + fields = + [ textField "variable" variableVals + , numField "value" valueVals + ] + vlSpec = + (emptySpec VL.Boxplot) + { vlEncodings = + [ chanEnc X "variable" Nominal + , chanEnc Y "value" Quantitative + ] + , vlTitle = Just chartTitle + } + renderSpec spec.size fields vlSpec -- --------------------------------------------------------------------------- -- Whole-frame helpers @@ -479,12 +397,11 @@ {- | Concatenate a histogram for every numeric column in the frame. Useful as a one-shot exploratory summary. -} -allHistograms :: (HasCallStack) => DataFrame -> IO HtmlPlot +allHistograms :: (HasCallStack) => DataFrame -> IO String allHistograms df = do let cols = filter (isNumericColumn df) (columnNames df) xs <- forM cols $ \c -> histogram (mkHistogram c) df - let allPlots = L.foldl' (\acc (HtmlPlot contents) -> acc <> "\n" <> contents) "" xs - return (HtmlPlot allPlots) + return $ L.intercalate "\n" xs -- --------------------------------------------------------------------------- -- Title helper @@ -499,29 +416,29 @@ -- Deprecated legacy entry points -- --------------------------------------------------------------------------- -plotHistogram :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot +plotHistogram :: (HasCallStack) => T.Text -> DataFrame -> IO String plotHistogram c = histogram (mkHistogram c) {-# DEPRECATED plotHistogram "use 'histogram (mkHistogram col)' instead" #-} -plotScatter :: (HasCallStack) => T.Text -> T.Text -> DataFrame -> IO HtmlPlot +plotScatter :: (HasCallStack) => T.Text -> T.Text -> DataFrame -> IO String plotScatter xc yc = scatter (mkScatter xc yc) {-# DEPRECATED plotScatter "use 'scatter (mkScatter xCol yCol)' instead" #-} -plotBars :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot +plotBars :: (HasCallStack) => T.Text -> DataFrame -> IO String plotBars c = bar (mkBar c) {-# DEPRECATED plotBars "use 'bar (mkBar col)' instead" #-} -plotLines :: (HasCallStack) => T.Text -> [T.Text] -> DataFrame -> IO HtmlPlot +plotLines :: (HasCallStack) => T.Text -> [T.Text] -> DataFrame -> IO String plotLines xc ys = line (mkLine xc ys) {-# DEPRECATED plotLines "use 'line (mkLine xCol yCols)' instead" #-} -plotPie :: (HasCallStack) => T.Text -> Maybe T.Text -> DataFrame -> IO HtmlPlot +plotPie :: (HasCallStack) => T.Text -> Maybe T.Text -> DataFrame -> IO String plotPie c mLabel = let s = mkPie c in pie s{names = mLabel} {-# DEPRECATED plotPie "use 'pie (mkPie col)' instead" #-} -plotBoxPlots :: (HasCallStack) => [T.Text] -> DataFrame -> IO HtmlPlot +plotBoxPlots :: (HasCallStack) => [T.Text] -> DataFrame -> IO String plotBoxPlots ys = box (mkBox ys) {-# DEPRECATED plotBoxPlots "use 'box (mkBox cols)' instead" #-} @@ -529,8 +446,8 @@ -- Browser launcher -- --------------------------------------------------------------------------- -showInDefaultBrowser :: HtmlPlot -> IO () -showInDefaultBrowser (HtmlPlot p) = do +showInDefaultBrowser :: String -> IO () +showInDefaultBrowser p = do plotId <- generateChartId home <- getHomeDirectory let path = "plot-" <> T.unpack plotId <> ".html" @@ -540,7 +457,7 @@ else home <> "/" <> path putStr "Saving plot to: " putStrLn fullPath - T.writeFile fullPath p + T.writeFile fullPath (T.pack p) case os of "mingw32" -> openFileSilently "start" fullPath "darwin" -> openFileSilently "open" fullPath