dataframe-viz 1.0.1.1 → 1.0.2.0

raw patch · 7 files changed

+1367/−242 lines, 7 filesdep +aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson

API changes (from Hackage documentation)

Files

• README.md +330/−0
• dataframe-viz.cabal +7/−2
• src/DataFrame/Display/Internal/Common.hs +20/−14
• src/DataFrame/Display/Internal/VegaLite.hs +352/−0
• src/DataFrame/Display/Web/Chart.hs +319/−0
• src/DataFrame/Display/Web/Chart/Typed.hs +196/−0
• src/DataFrame/Display/Web/Plot.hs +143/−226

@@ -0,0 +1,330 @@+<!--+  This file is the runnable scripths source for dataframe-viz's README.+  Every ```haskell block executes in order in one shared session against a+  small in-memory DataFrame. Regenerate the rendered README with:++      scripths docs/base_scripts/base_readme.md -o README.md++  Run it from THIS directory (dataframe-viz/). The `-- cabal: packages:`+  directive in the first block points at the sibling packages in this monorepo+  so the notebook builds against the local working tree (not Hackage). Blocks+  tagged ```text are illustrative (browser-opening or terminal output) and are+  NOT run.+-->++# 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)+```++> <!-- scripths:mime text/plain -->++## 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))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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)))+```++> <!-- scripths:mime text/plain -->+> {"$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)))+```++> <!-- scripths:mime text/plain -->+> {"$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)))+```++> <!-- scripths:mime text/plain -->+> {"$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+        ]))+```++> <!-- scripths:mime text/plain -->+> {"$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))+```++> <!-- scripths:mime text/plain -->+> {"$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`).

@@ -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,

@@ -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 =

@@ -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+            [ "<div id=\""+            , chartId+            , "\"></div>\n"+            , "<script src=\"https://cdn.jsdelivr.net/npm/vega@5\"></script>\n"+            , "<script src=\"https://cdn.jsdelivr.net/npm/vega-lite@5\"></script>\n"+            , "<script src=\"https://cdn.jsdelivr.net/npm/vega-embed@6\"></script>\n"+            , "<script>vegaEmbed('#"+            , chartId+            , "', "+            , specJson+            , ");</script>\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."

@@ -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+            }

@@ -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)

@@ -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-        [ "<canvas id=\""-        , chartId-        , "\" style=\"width:100%;max-width:"-        , T.pack (show sz.width)-        , "px;height:"-        , T.pack (show sz.height)-        , "px\"></canvas>\n"-        , "<script src=\"https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.9.4/Chart.min.js\"></script>\n"-        , "<script>\n"-        , content-        , "\n</script>\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