granite 0.4.0.1 → 0.5.0.0
raw patch · 31 files changed
+6860/−725 lines, 31 filesdep +directorydep +filepathdep ~basedep ~granitenew-component:exe:granite-tutorial
Dependencies added: directory, filepath
Dependency ranges changed: base, granite
Files
- CHANGELOG.md +55/−0
- README.md +2/−1
- app/GenerateTutorial.hs +796/−0
- app/Main.hs +159/−46
- granite.cabal +39/−3
- src/Granite.hs +81/−392
- src/Granite/Chart.hs +85/−0
- src/Granite/Color.hs +122/−0
- src/Granite/Data/Frame.hs +104/−0
- src/Granite/Format.hs +100/−0
- src/Granite/Internal/LegacyChart.hs +277/−0
- src/Granite/Internal/Util.hs +163/−0
- src/Granite/Position.hs +169/−0
- src/Granite/Render/Chrome.hs +339/−0
- src/Granite/Render/Pipeline.hs +896/−0
- src/Granite/Render/Scene.hs +97/−0
- src/Granite/Render/Svg.hs +230/−0
- src/Granite/Render/Terminal.hs +450/−0
- src/Granite/Scale.hs +223/−0
- src/Granite/Spec.hs +364/−0
- src/Granite/Stat.hs +390/−0
- src/Granite/Svg.hs +82/−283
- test/Golden.hs +79/−0
- test/GoldenSpec.hs +365/−0
- test/PipelineSpec.hs +125/−0
- test/PlotlySpec.hs +467/−0
- test/PositionSpec.hs +133/−0
- test/RenderSpec.hs +81/−0
- test/ScaleSpec.hs +190/−0
- test/SpecPropSpec.hs +108/−0
- test/StatSpec.hs +89/−0
CHANGELOG.md view
@@ -1,5 +1,60 @@ # Revision history for granite +## 0.5.0.0 -- 2026-05-13++A major refactor introducing a declarative, Grammar-of-Graphics-style+IR shared between the terminal and SVG backends. Legacy chart+functions (`scatter`, `bars`, `pie`, …) remain unchanged and continue+to work; the new IR is additive.++* New module `Granite.Spec` exposing the chart IR: `Chart`, `Layer`,+ `Mapping`, `Geom`, `Stat`, `Position`, `Scale`, `Coord`, `Facet`,+ `Theme`, `Size`, `ColorSpec`, `Formatter`. All types are plain ADTs+ of basic Haskell types so a downstream user can derive `ToJSON` /+ `FromJSON` instances with the JSON library of their choice. Granite+ itself ships no JSON instances; the dependency footprint remains+ `base + text`.+* New module `Granite.Data.Frame` providing a column-oriented+ `DataFrame` (`ColNum`, `ColCat`, `ColTime`, `ColBool`).+* New module `Granite.Format` with a declarative `Formatter` enum+ (`FormatPrecision`, `FormatScientific`, `FormatPercent`,+ `FormatComma`, `FormatSI`, …). Replaces the function-typed+ `LabelFormatter` for IR users; legacy `Plot { xFormatter, yFormatter }`+ remains in place.+* New module `Granite.Scale` with linear, log (base 2/e/10), sqrt,+ reverse, and identity scales, plus Heckbert-style "nice" tick+ selection. (Talbot–Lin–Hanrahan "Extended" tick scoring is a future+ upgrade — see the source for the TODO.)+* New module `Granite.Render.Scene` with backend-agnostic primitive+ marks: `MCircle`, `MRect`, `MPolyline`, `MPath`, `MText`, `MArc`,+ `MGroup`. Both backends consume the same `Scene`.+* New module `Granite.Render.Terminal` with the unified terminal+ backend. The Braille canvas and AVL-backed `Array2D` were extracted+ from `Granite` and now power both the legacy chart functions and+ the new IR pipeline.+* New module `Granite.Render.Svg` with the unified SVG backend.+ `renderSceneResponsive` produces SVG using `viewBox` ++ `preserveAspectRatio` + `width="100%"` so charts embed responsively.+* New module `Granite.Render.Chrome` with axes, ticks, gridlines,+ title, and legend as primitive marks — chrome code is no longer+ duplicated between backends.+* New module `Granite.Render.Pipeline` exposing `chartToScene`,+ `renderChartTerminal`, and `renderChartSvg`. Phase 3 supports the+ cartesian path with identity stat and identity position. Polar+ coord, facets, stats, positions, ribbons / errorbars, and multi-+ chart figures are scheduled for later releases.+* New module `Granite.Chart` with thin builders (`scatterChart`,+ `lineChart`) that construct an IR `Chart` from the same input shapes+ the legacy chart functions accept.+* New module `Granite.Color` extracted from `Granite`; exports the+ ANSI palette, ANSI escape helpers, and hex mapping.+* New module `Granite.Internal.Util` with the shared numeric, list,+ text, and tick helpers that used to live (duplicated) in both+ `Granite` and `Granite.Svg`.+* `ColorSpec` adds `RGB` and `Hex` constructors for cross-renderer+ color fidelity, with terminal backends quantising to the nearest+ ANSI color.+ ## 0.4.0.0 -- 2026-02-27 * Add Svg support.
README.md view
@@ -1,5 +1,6 @@ # Granite-A library for producing terminal plots. It depends only on Haskell's base and text (only for efficiency but it could use `String`. In fact, we expose an API that uses `String` for easier use in GHCi) packages so it should be easy to use and install.+A library for producing terminal and SVG plots. It depends only on Haskell's+`base` and `text` packages so it stays easy to install in any environment. # Supported graph types
+ app/GenerateTutorial.hs view
@@ -0,0 +1,796 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Regenerate @docs/tutorial.md@ from @docs/base/tutorial.md@ by+rendering each @\<!-- chart: SLUG -->@ marker to an SVG under+@docs/images/@ and inserting the image link after the code block.+-}+module Main where++import Control.Monad (forM_)+import Data.List qualified as List+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))++import Granite.Color (Color (..))+import Granite.Data.Frame+import Granite.Render.Pipeline (renderChartSvg)+import Granite.Spec++baseFile, outputFile, imagesDir :: FilePath+baseFile = "docs/base/tutorial.md"+outputFile = "docs/tutorial.md"+imagesDir = "docs/images"++main :: IO ()+main = do+ createDirectoryIfMissing True imagesDir+ src <- Text.IO.readFile baseFile+ let rendered = renderTutorial src+ Text.IO.writeFile outputFile rendered+ forM_ fixtures $ \(slug, chart) -> do+ let svgPath = imagesDir </> Text.unpack slug <> ".svg"+ Text.IO.writeFile svgPath (renderChartSvg chart)+ putStrLn $ "Wrote " <> outputFile+ putStrLn $ "Wrote " <> show (length fixtures) <> " SVGs under " <> imagesDir++renderTutorial :: Text -> Text+renderTutorial src = Text.unlines (go (Text.lines src))+ where+ go :: [Text] -> [Text]+ go [] = []+ go (line : rest) = case chartSlug line of+ Just slug ->+ let (block, afterBlock) = takeCodeBlock rest+ output = renderChartOutput slug+ in line : block <> output <> go afterBlock+ Nothing -> line : go rest++chartSlug :: Text -> Maybe Text+chartSlug ln =+ let stripped = Text.strip ln+ in case Text.stripPrefix "<!-- chart:" stripped of+ Just rest -> case Text.stripSuffix "-->" (Text.strip rest) of+ Just slug -> Just (Text.strip slug)+ Nothing -> Nothing+ Nothing -> Nothing++takeCodeBlock :: [Text] -> ([Text], [Text])+takeCodeBlock = goOpen []+ where+ goOpen acc [] = (reverse acc, [])+ goOpen acc (ln : rest)+ | Text.isPrefixOf "```" (Text.stripStart ln) =+ goClose (ln : acc) rest+ | otherwise = goOpen (ln : acc) rest++ goClose acc [] = (reverse acc, [])+ goClose acc (ln : rest)+ | Text.isPrefixOf "```" (Text.stripStart ln) =+ (reverse (ln : acc), rest)+ | otherwise = goClose (ln : acc) rest++renderChartOutput :: Text -> [Text]+renderChartOutput slug = case lookup slug fixtures of+ Nothing ->+ [ ""+ , "> _(no fixture for chart slug `" <> slug <> "` — skipped)_"+ ]+ Just _chart ->+ let imgRel = "images/" <> slug <> ".svg"+ in [ ""+ , "![" <> slug <> "](" <> imgRel <> ")"+ ]++fixtures :: [(Text, Chart)]+fixtures =+ [ ("scatter", scatterChart)+ , ("line", lineChart)+ , ("bar", barChart)+ , ("bar-horizontal", barHorizontal)+ , ("bar-stacked", barStacked)+ , ("bar-grouped", barGrouped)+ , ("pie", pieChart)+ , ("area", areaChart)+ , ("histogram", histChart)+ , ("boxplot", boxChart)+ , ("errorbar", errorbarChart)+ , ("density", densityChart)+ , ("distplot", distplotChart)+ , ("heatmap", heatmapChart)+ , ("heatmap-annotated", heatmapAnnotated)+ , ("funnel", funnelChart)+ , ("waterfall", waterfallChart)+ , ("polar", polarChart)+ , ("facet", facetChart)+ , ("log-y", logYChart)+ , ("layer-bar-line", barLineChart)+ , ("layer-scatter-radius", scatterRadiusChart)+ , ("layer-scatter-fit", scatterFitChart)+ , ("layer-line-ribbon", lineRibbonChart)+ ]++scatterChart :: Chart+scatterChart =+ let xs = [0, 1, 2, 3, 4] :: [Double]+ ys = [0, 1, 4, 9, 16] :: [Double]+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ layer =+ (defLayer GeomPoint)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "y = x^2"+ , chartSize = SizeChars 40 14+ }++lineChart :: Chart+lineChart =+ let xs = [0, 0.5 .. 6.0] :: [Double]+ ys = map sin xs+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ layer =+ (defLayer GeomLine)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "sin(x)"+ , chartSize = SizeChars 50 14+ }++barChart :: Chart+barChart =+ let xs = ["A", "B", "C", "D"]+ ys = [12, 7, 18, 9] :: [Double]+ df = fromColumns [("x", ColCat xs), ("y", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Bars"+ , chartSize = SizeChars 40 14+ }++barHorizontal :: Chart+barHorizontal =+ let xs = ["Alpha", "Bravo", "Charlie", "Delta", "Echo"]+ ys = [82, 67, 45, 33, 21] :: [Double]+ df = fromColumns [("item", ColCat xs), ("value", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "item")+ , aesY = Just (ColumnRef "value")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordFlip+ , chartTitle = Just "Top 5 (horizontal)"+ , chartSize = SizeChars 60 16+ }++barStackedFrame :: DataFrame+barStackedFrame =+ let quarters = concat [replicate 3 q | q <- ["Q1", "Q2", "Q3", "Q4"]]+ products = take 12 (cycle ["Widgets", "Gadgets", "Gizmos"])+ sales = [12, 8, 4, 15, 10, 6, 18, 12, 8, 22, 14, 10] :: [Double]+ in fromColumns+ [ ("quarter", ColCat quarters)+ , ("product", ColCat products)+ , ("sales", ColNum sales)+ ]++barStacked :: Chart+barStacked =+ let layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "quarter")+ , aesY = Just (ColumnRef "sales")+ , aesGroup = Just (ColumnRef "product")+ , aesFill = Just (ColumnRef "product")+ }+ , layerStat = StatIdentity+ , layerPosition = PosStack+ }+ in emptyChart+ { chartData = barStackedFrame+ , chartLayers = [layer]+ , chartTitle = Just "Sales by quarter (stacked)"+ , chartSize = SizeChars 60 16+ }++barGrouped :: Chart+barGrouped =+ barStacked+ { chartLayers =+ [ (List.head (chartLayers barStacked))+ { layerPosition = PosDodge 0.25+ }+ ]+ , chartTitle = Just "Sales by quarter (grouped)"+ }++pieChart :: Chart+pieChart =+ let df =+ fromColumns+ [ ("slice", ColCat ["A", "B", "C", "D"])+ , ("value", ColNum [40, 25, 20, 15])+ ]+ layer =+ (defLayer GeomArc)+ { layerMapping = emptyMapping{aesY = Just (ColumnRef "value")}+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Pie"+ , chartSize = SizeChars 30 16+ }++areaChart :: Chart+areaChart =+ let xs = [0 .. 12] :: [Double]+ ymax = [sin (x / 2) + 2 | x <- xs]+ zeros = replicate (length xs) 0 :: [Double]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("ymin", ColNum zeros)+ , ("ymax", ColNum ymax)+ ]+ layer =+ (defLayer GeomRibbon)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesYmin = Just (ColumnRef "ymin")+ , aesYmax = Just (ColumnRef "ymax")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Filled area"+ , chartSize = SizeChars 56 14+ }++histChart :: Chart+histChart =+ let raw = take 50 (cycle [1.0, 1.2, 1.8, 2.0, 2.3, 2.7, 3.1, 3.4, 3.8, 4.2])+ df = fromColumns [("x", ColNum raw)]+ layer =+ (defLayer GeomHistogram)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatBin (BinByCount 8)+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Histogram"+ , chartSize = SizeChars 44 14+ }++boxChart :: Chart+boxChart =+ let pts =+ [("A", v) | v <- [1, 2, 3, 4, 5, 6, 7, 8, 9 :: Double]]+ <> [("B", v) | v <- [3, 4, 5, 6, 7, 8, 9, 10, 11]]+ <> [("C", v) | v <- [5, 6, 7, 8, 9, 10, 11, 12, 13]]+ df =+ fromColumns+ [ ("g", ColCat [g | (g, _) <- pts])+ , ("y", ColNum [v | (_, v) <- pts])+ ]+ layer =+ (defLayer GeomBoxplot)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "g")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatBoxplot+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Boxplot"+ , chartSize = SizeChars 40 16+ }++errorbarChart :: Chart+errorbarChart =+ let xs = [1 .. 5] :: [Double]+ ys = [2.1, 3.5, 5.2, 4.7, 6.1] :: [Double]+ los = [1.5, 2.8, 4.6, 4.0, 5.3] :: [Double]+ his = [2.7, 4.2, 5.8, 5.4, 6.9] :: [Double]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("lo", ColNum los)+ , ("hi", ColNum his)+ ]+ m =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesYmin = Just (ColumnRef "lo")+ , aesYmax = Just (ColumnRef "hi")+ }+ bars = (defLayer GeomErrorbar){layerMapping = m, layerStat = StatIdentity}+ pts = (defLayer GeomPoint){layerMapping = m, layerStat = StatIdentity}+ in emptyChart+ { chartData = df+ , chartLayers = [bars, pts]+ , chartTitle = Just "Measurements +/- CI"+ , chartSize = SizeChars 56 14+ }++densitySample :: [Double]+densitySample =+ [ 1.0+ , 1.2+ , 1.3+ , 1.5+ , 1.7+ , 2.0+ , 2.1+ , 2.3+ , 2.5+ , 2.8+ , 3.0+ , 3.1+ , 3.3+ , 3.7+ , 3.9+ , 4.0+ ]++densityChart :: Chart+densityChart =+ let df = fromColumns [("x", ColNum densitySample)]+ layer =+ (defLayer GeomDensity)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ }+ , layerStat = StatDensity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Density (KDE)"+ , chartSize = SizeChars 56 14+ }++distplotChart :: Chart+distplotChart =+ let df = fromColumns [("x", ColNum densitySample)]+ hist =+ (defLayer GeomHistogram)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatBin (BinByCount 8)+ }+ kde =+ (defLayer GeomDensity)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ }+ , layerStat = StatDensity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [hist, kde]+ , chartTitle = Just "Distribution"+ , chartSize = SizeChars 56 16+ }++heatmapCoords :: [(Double, Double, Double)]+heatmapCoords =+ [ ( fromIntegral x+ , fromIntegral y+ , sin (fromIntegral x / 2) + cos (fromIntegral y / 2)+ )+ | x <- [0 .. 4 :: Int]+ , y <- [0 .. 4 :: Int]+ ]++heatmapChart :: Chart+heatmapChart =+ let df =+ fromColumns+ [ ("x", ColNum [x | (x, _, _) <- heatmapCoords])+ , ("y", ColNum [y | (_, y, _) <- heatmapCoords])+ , ("z", ColNum [z | (_, _, z) <- heatmapCoords])+ ]+ layer =+ (defLayer GeomTile)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesFill = Just (ColumnRef "z")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Heatmap"+ , chartSize = SizeChars 48 16+ }++heatmapAnnotated :: Chart+heatmapAnnotated =+ let labels = [Text.pack (show (round (z * 10) :: Int)) | (_, _, z) <- heatmapCoords]+ df =+ fromColumns+ [ ("x", ColNum [x | (x, _, _) <- heatmapCoords])+ , ("y", ColNum [y | (_, y, _) <- heatmapCoords])+ , ("z", ColNum [z | (_, _, z) <- heatmapCoords])+ , ("label", ColCat labels)+ ]+ tile =+ (defLayer GeomTile)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesFill = Just (ColumnRef "z")+ }+ , layerStat = StatIdentity+ }+ label =+ (defLayer GeomText)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesLabel = Just (ColumnRef "label")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [tile, label]+ , chartTitle = Just "Annotated heatmap"+ , chartSize = SizeChars 48 16+ }++funnelChart :: Chart+funnelChart =+ let xs = ["Visited", "Signed up", "Confirmed", "Active", "Paid"]+ ys = [1000, 720, 480, 220, 120] :: [Double]+ df = fromColumns [("stage", ColCat xs), ("count", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "stage")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordFlip+ , chartTitle = Just "Sales funnel"+ , chartSize = SizeChars 60 14+ }++waterfallChart :: Chart+waterfallChart =+ let xs = ["Start", "Q1", "Q2", "Q3", "Refund", "Net"]+ ystart = [0, 100, 130, 180, 175, 0] :: [Double]+ yend = [100, 130, 180, 175, 195, 195] :: [Double]+ df =+ fromColumns+ [ ("x", ColCat xs)+ , ("y", ColNum yend)+ , ("__ybase", ColNum ystart)+ ]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Waterfall"+ , chartSize = SizeChars 60 14+ }++polarChart :: Chart+polarChart =+ let nSteps = 32 :: Int+ pts =+ [ (theta, abs (sin (2 * theta)))+ | i <- [0 .. nSteps]+ , let theta = (fromIntegral i / fromIntegral nSteps) * 2 * pi+ ]+ df =+ fromColumns+ [ ("theta", ColNum [t | (t, _) <- pts])+ , ("r", ColNum [r | (_, r) <- pts])+ ]+ layer =+ (defLayer GeomLine)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "theta")+ , aesY = Just (ColumnRef "r")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordPolar ThetaX 0 PolarCCW+ , chartTitle = Just "r = |sin(2 theta)|"+ , chartSize = SizeChars 40 20+ }++facetChart :: Chart+facetChart =+ let df =+ fromColumns+ [ ("x", ColNum [0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3])+ , ("y", ColNum [1, 4, 9, 16, 0, 2, 4, 6, 5, 4, 3, 2])+ , ("series", ColCat (replicate 4 "A" <> replicate 4 "B" <> replicate 4 "C"))+ ]+ layer =+ (defLayer GeomPoint)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartFacet = FacetWrap (ColumnRef "series") (Just 3) Nothing ScalesFixed+ , chartTitle = Just "Faceted by series"+ , chartSize = SizeChars 70 18+ }++logYChart :: Chart+logYChart =+ let xs = [1 .. 6] :: [Double]+ ys = [3, 30, 80, 200, 700, 2100] :: [Double]+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ layer =+ (defLayer GeomPoint)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartScales = defScales{scaleY = SLog Base10 defScaleOpts}+ , chartTitle = Just "Log Y"+ , chartSize = SizeChars 50 14+ }++barLineChart :: Chart+barLineChart =+ let months = ["Jan", "Feb", "Mar", "Apr", "May", "Jun"]+ sales = [12, 18, 15, 24, 20, 28] :: [Double]+ movavg = [12, 15, 16.5, 19.5, 22, 24] :: [Double]+ df =+ fromColumns+ [ ("month", ColCat months)+ , ("sales", ColNum sales)+ , ("avg", ColNum movavg)+ ]+ bars =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "month")+ , aesY = Just (ColumnRef "sales")+ }+ , layerStat = StatIdentity+ }+ trend =+ (defLayer GeomLine)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "month")+ , aesY = Just (ColumnRef "avg")+ }+ , layerAesDef =+ emptyAesDefaults+ { defColor = Just (NamedColor BrightRed)+ , defLineWidth = Just 2.5+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [bars, trend]+ , chartTitle = Just "Monthly sales + trend"+ , chartSize = SizeChars 60 14+ }++scatterRadiusChart :: Chart+scatterRadiusChart =+ let pts =+ [ (0.2, 0.5)+ , (0.8, 1.2)+ , (-0.5, 0.3)+ , (1.1, -0.2)+ , (1.8, 0.7)+ , (-0.3, -0.6)+ , (2.2, 1.5)+ , (1.5, -1.1)+ , (0.1, 2.1)+ , (2.5, 0.3)+ , (-1.0, 1.0)+ , (0.7, -0.4)+ ] ::+ [(Double, Double)]+ points =+ fromColumns+ [ ("lon", ColNum [x | (x, _) <- pts])+ , ("lat", ColNum [y | (_, y) <- pts])+ ]+ poi =+ fromColumns+ [ ("lon", ColNum [0.5])+ , ("lat", ColNum [0.5])+ ]+ radius =+ (defLayer GeomPoint)+ { layerData = Just poi+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "lon")+ , aesY = Just (ColumnRef "lat")+ }+ , layerAesDef =+ emptyAesDefaults+ { defColor = Just (NamedColor BrightCyan)+ , defSize = Just 60+ , defAlpha = Just 0.25+ }+ }+ scatter =+ (defLayer GeomPoint)+ { layerData = Just points+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "lon")+ , aesY = Just (ColumnRef "lat")+ }+ }+ in emptyChart+ { chartLayers = [radius, scatter]+ , chartTitle = Just "Points near POI"+ , chartSize = SizeChars 50 18+ }++scatterFitChart :: Chart+scatterFitChart =+ let xs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ noise = [0.3, -0.5, 0.7, -0.2, 0.4, -0.6, 0.1, 0.3, -0.4, 0.5]+ ys = [2 * x + 1 + n | (x, n) <- zip xs noise]+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ m =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ points = (defLayer GeomPoint){layerMapping = m}+ fit =+ (defLayer GeomLine)+ { layerMapping = m+ , layerStat = StatSmooth SmoothLm+ , layerAesDef =+ emptyAesDefaults+ { defColor = Just (NamedColor BrightRed)+ , defLineWidth = Just 2+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [points, fit]+ , chartTitle = Just "Scatter + OLS fit"+ , chartSize = SizeChars 50 14+ }++lineRibbonChart :: Chart+lineRibbonChart =+ let xs = [0, 0.5 .. 6.0] :: [Double]+ ys = map sin xs+ los = map (\x -> sin x - 0.3) xs+ his = map (\x -> sin x + 0.3) xs+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("lo", ColNum los)+ , ("hi", ColNum his)+ ]+ ribbon =+ (defLayer GeomRibbon)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesYmin = Just (ColumnRef "lo")+ , aesYmax = Just (ColumnRef "hi")+ }+ , layerAesDef =+ emptyAesDefaults+ { defColor = Just (NamedColor BrightCyan)+ , defAlpha = Just 0.3+ }+ }+ line =+ (defLayer GeomLine)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerAesDef =+ emptyAesDefaults+ { defColor = Just (NamedColor BrightBlue)+ , defLineWidth = Just 2+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [ribbon, line]+ , chartTitle = Just "sin(x) +/- 0.3 band"+ , chartSize = SizeChars 56 14+ }
app/Main.hs view
@@ -2,27 +2,50 @@ module Main where -import Control.Monad+import Data.Text (Text) import Data.Text qualified as Text-import Data.Text.IO qualified as Text+import Data.Text.IO qualified as Text.IO import Granite main :: IO () main = do- -- scatter- let ptsA_x = [0 .. 599]- let ptsA_y = [0 .. 599]- let ptsB_x = [0 .. 599]- let ptsB_y = [599, 598 .. 0]- Text.putStrLn $- scatter- [series "A" (zip ptsA_x ptsA_y), series "B" (zip ptsB_x ptsB_y)]- defPlot{widthChars = 68, heightChars = 22, plotTitle = "Random points"}+ section "Scatter — two series, 600 points each"+ Text.IO.putStrLn $+ let ptsA = [(x, x) | x <- [0 .. 599]]+ ptsB = [(x, 599 - x) | x <- [0 .. 599]]+ in scatter+ [series "A" ptsA, series "B" ptsB]+ defPlot{widthChars = 68, heightChars = 22, plotTitle = "Random points"} - -- histogram+ section "Line graph — three product trends"+ Text.IO.putStrLn $+ lineGraph+ [ ("Product A", [(1, 100), (2, 120), (3, 115), (4, 140), (5, 155), (6, 148)])+ , ("Product B", [(1, 80), (2, 85), (3, 95), (4, 92), (5, 110), (6, 125)])+ , ("Product C", [(1, 60), (2, 62), (3, 70), (4, 85), (5, 82), (6, 90)])+ ]+ defPlot{plotTitle = "Monthly Sales Trends"}++ section "Bar chart — quarterly sales"+ Text.IO.putStrLn $+ bars+ [("Q1", 12), ("Q2", 18), ("Q3", 9), ("Q4", 15)]+ defPlot{plotTitle = "Sales", xNumTicks = 4}++ section "Stacked bar chart — revenue by product type"+ Text.IO.putStrLn $+ stackedBars+ [ ("Q1", [("Hardware", 120), ("Software", 200), ("Services", 80)])+ , ("Q2", [("Hardware", 135), ("Software", 220), ("Services", 95)])+ , ("Q3", [("Hardware", 110), ("Software", 240), ("Services", 110)])+ , ("Q4", [("Hardware", 145), ("Software", 260), ("Services", 125)])+ ]+ defPlot{plotTitle = "Quarterly Revenue Breakdown"}++ section "Histogram — sample heights" let heights = concat $ zipWith replicate [0 .. 40] [160 .. 200]- Text.putStrLn $+ Text.IO.putStrLn $ histogram (bins 40 155 195) heights@@ -36,14 +59,8 @@ , plotTitle = "Heights (cm)" } - -- bars- Text.putStrLn $- bars- [("Q1", 12), ("Q2", 18), ("Q3", 9), ("Q4", 15)]- defPlot{plotTitle = "Sales", xNumTicks = 4}-- -- pie- Text.putStrLn $+ section "Pie chart — market share"+ Text.IO.putStrLn $ pie [("Alpha", 0.35), ("Beta", 0.25), ("Gamma", 0.20), ("Delta", 0.20)] defPlot@@ -53,17 +70,18 @@ , plotTitle = "Share" } - -- line graph- Text.putStrLn $- lineGraph- [ ("Product A", [(1, 100), (2, 120), (3, 115), (4, 140), (5, 155), (6, 148)])- , ("Product B", [(1, 80), (2, 85), (3, 95), (4, 92), (5, 110), (6, 125)])- , ("Product C", [(1, 60), (2, 62), (3, 70), (4, 85), (5, 82), (6, 90)])+ section "Heatmap — correlation matrix"+ let matrix =+ [ [1.0, 0.8, 0.3, -0.2, 0.1]+ , [0.8, 1.0, 0.5, -0.1, 0.2]+ , [0.3, 0.5, 1.0, 0.6, 0.4]+ , [-0.2, -0.1, 0.6, 1.0, 0.7]+ , [0.1, 0.2, 0.4, 0.7, 1.0] ]- defPlot{plotTitle = "Monthly Sales Trends"}+ Text.IO.putStrLn $ heatmap matrix defPlot{plotTitle = "Correlation Matrix"} - -- box plot- Text.putStrLn $+ section "Box plot — test score distribution by class"+ Text.IO.putStrLn $ boxPlot [ ("Class A", [78, 82, 85, 88, 90, 92, 85, 87, 89, 91, 76, 94, 88]) , ("Class B", [70, 75, 72, 80, 85, 78, 82, 77, 79, 81, 74, 83])@@ -72,22 +90,117 @@ ] defPlot{plotTitle = "Test Score Distribution by Class"} - -- stacked bar chart- Text.putStrLn $- stackedBars- [ ("Q1", [("Hardware", 120), ("Software", 200), ("Services", 80)])- , ("Q2", [("Hardware", 135), ("Software", 220), ("Services", 95)])- , ("Q3", [("Hardware", 110), ("Software", 240), ("Services", 110)])- , ("Q4", [("Hardware", 145), ("Software", 260), ("Services", 125)])+ section "Area — filled curve from y=0"+ Text.IO.putStrLn $+ area+ [ ("revenue", [(x, sin (x / 2) * 50 + 200) | x <- [0 .. 12 :: Double]]) ]- defPlot{plotTitle = "Quarterly Revenue Breakdown"}+ defPlot{widthChars = 60, heightChars = 18, plotTitle = "Daily revenue"} - -- heatmap- let matrix =- [ [1.0, 0.8, 0.3, -0.2, 0.1]- , [0.8, 1.0, 0.5, -0.1, 0.2]- , [0.3, 0.5, 1.0, 0.6, 0.4]- , [-0.2, -0.1, 0.6, 1.0, 0.7]- , [0.1, 0.2, 0.4, 0.7, 1.0]+ section "Ribbon — confidence band"+ Text.IO.putStrLn $+ ribbon+ [ ("CI 90%", [(x, sin x - 0.4, sin x + 0.4) | x <- [0, 0.5 .. 6.0 :: Double]]) ]- Text.putStrLn $ heatmap matrix defPlot{plotTitle = "Correlation Matrix"}+ defPlot{widthChars = 60, heightChars = 16, plotTitle = "sin(x) +/- 0.4 band"}++ section "Density — KDE over a sample"+ Text.IO.putStrLn $+ density+ [+ ( "class A"+ , concat [replicate 5 v | v <- [1.0, 1.4, 1.6, 2.0, 2.3, 2.6, 3.0, 3.2, 3.5]]+ )+ ,+ ( "class B"+ , concat [replicate 5 v | v <- [2.5, 2.7, 3.0, 3.4, 3.8, 4.1, 4.4, 4.7, 5.0]]+ )+ ]+ defPlot{widthChars = 60, heightChars = 16, plotTitle = "Distribution of scores"}++ section "Error bars — points with vertical CIs"+ Text.IO.putStrLn $+ errorBars+ [+ ( "treatment"+ ,+ [ (1, 2.1, 1.5, 2.7)+ , (2, 3.5, 2.8, 4.2)+ , (3, 5.2, 4.6, 5.8)+ , (4, 4.7, 4.0, 5.4)+ , (5, 6.1, 5.3, 6.9)+ ]+ )+ ]+ defPlot{widthChars = 60, heightChars = 16, plotTitle = "Measurements +/- CI"}++ section "Funnel — sales pipeline"+ Text.IO.putStrLn $+ funnel+ [ ("Visited", 1000)+ , ("Signed up", 720)+ , ("Confirmed", 480)+ , ("Active", 220)+ , ("Paid", 120)+ ]+ defPlot{widthChars = 60, heightChars = 16, plotTitle = "Sales funnel"}++ section "Polar line — four-petal rose r = |sin(2θ)|"+ let nSteps = 32 :: Int+ roseTheta i = fromIntegral i / fromIntegral nSteps * 2 * pi+ rosePts = [(roseTheta i, abs (sin (2 * roseTheta i))) | i <- [0 .. nSteps]]+ Text.IO.putStrLn $+ polarLine+ [("r = |sin(2theta)|", rosePts)]+ defPlot{widthChars = 40, heightChars = 22, plotTitle = "Polar rose"}++ section "Waterfall — running revenue total"+ Text.IO.putStrLn $+ waterfall+ [ ("Start", 0, 100)+ , ("Q1", 100, 130)+ , ("Q2", 130, 180)+ , ("Q3", 180, 175) -- a small dip+ , ("Refund", 175, 195)+ , ("Net", 0, 195)+ ]+ defPlot{widthChars = 60, heightChars = 16, plotTitle = "Revenue waterfall"}++ section "Distplot — histogram + density overlay"+ Text.IO.putStrLn $+ distPlot+ [+ ( "sample"+ , concat+ [ replicate 5 v+ | v <-+ [ 1.0+ , 1.2+ , 1.3+ , 1.5+ , 1.7+ , 2.0+ , 2.1+ , 2.3+ , 2.5+ , 2.8+ , 3.0+ , 3.1+ , 3.3+ , 3.7+ , 3.9+ , 4.0+ , 4.2+ ]+ ]+ )+ ]+ defPlot{widthChars = 60, heightChars = 18, plotTitle = "Distribution"}++section :: Text -> IO ()+section name = do+ Text.IO.putStrLn ""+ Text.IO.putStrLn (Text.replicate 72 "=")+ Text.IO.putStrLn name+ Text.IO.putStrLn (Text.replicate 72 "-")+ Text.IO.putStrLn ""
granite.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: granite-version: 0.4.0.1+version: 0.5.0.0 synopsis: Easy terminal plotting. description: A terminal plotting library for quick and easy visualisation. license: MIT@@ -42,8 +42,23 @@ library import: ghc-options exposed-modules: Granite,+ Granite.Chart,+ Granite.Color,+ Granite.Data.Frame,+ Granite.Format,+ Granite.Position,+ Granite.Render.Chrome,+ Granite.Render.Pipeline,+ Granite.Render.Scene,+ Granite.Render.Svg,+ Granite.Render.Terminal,+ Granite.Scale,+ Granite.Spec,+ Granite.Stat, Granite.String, Granite.Svg+ other-modules: Granite.Internal.LegacyChart,+ Granite.Internal.Util build-depends: base >=4 && <5, text >= 1 && < 3@@ -54,11 +69,23 @@ main-is: Main.hs build-depends: base >=4 && <5,- granite ^>= 0.4,+ granite ^>= 0.5, text >= 1 && < 3 hs-source-dirs: app default-language: GHC2021 +executable granite-tutorial+ import: ghc-options+ main-is: GenerateTutorial.hs+ build-depends:+ base >=4 && <5,+ directory >= 1.3 && < 1.4,+ filepath >= 1.4 && < 1.6,+ granite ^>= 0.5,+ text >= 1 && < 3+ hs-source-dirs: app+ default-language: GHC2021+ test-suite granite-test import: ghc-options type: exitcode-stdio-1.0@@ -66,11 +93,20 @@ main-is: Spec.hs other-modules:+ Golden+ GoldenSpec GraniteSpec+ PipelineSpec+ PlotlySpec+ PositionSpec+ RenderSpec+ ScaleSpec+ SpecPropSpec+ StatSpec build-depends: base >= 4.14 && < 5- , granite ^>= 0.4+ , granite ^>= 0.5 , text >= 1.2 && < 3 , hspec >= 2.7 && < 2.12 , QuickCheck >= 2.14 && < 3
src/Granite.hs view
@@ -75,11 +75,19 @@ heatmap, lineGraph, boxPlot,++ -- * Plotly-Express-style helpers+ area,+ ribbon,+ density,+ errorBars,+ funnel,+ polarLine,+ waterfall,+ distPlot, ) where -import Data.Bits (xor, (.&.), (.|.))-import Data.Char (chr)-import Data.Function (on)+import Data.Bits (xor, (.&.)) import Data.List qualified as List import Data.Maybe import Data.Text (Text)@@ -87,6 +95,36 @@ import Numeric (showEFloat, showFFloat) import Text.Printf +import Granite.Color (Color (..), paint, paletteColors, pieColors)+import Granite.Internal.LegacyChart qualified as LC+import Granite.Internal.Util (+ addAt,+ angleWithin,+ clamp,+ ellipsisize,+ eps,+ gridWidth,+ justifyRight,+ maximum',+ minimum',+ mod',+ normalize,+ quartiles,+ setAt,+ ticks1D,+ updateAt,+ wcswidth,+ )+import Granite.Render.Pipeline (renderChartTerminal)+import Granite.Render.Terminal (+ Canvas (..),+ fillDotsC,+ lineDotsC,+ newCanvas,+ renderCanvas,+ setDotC,+ )+ -- | Position of the legend in the plot. data LegendPos = -- | Display legend on the right side of the plot@@ -208,27 +246,6 @@ -- ^ total number of ticks } --- | Supported ANSI colo(u)rs.-data Color- = Default- | Black- | Red- | Green- | Yellow- | Blue- | Magenta- | Cyan- | White- | BrightBlack- | BrightRed- | BrightGreen- | BrightYellow- | BrightBlue- | BrightMagenta- | BrightCyan- | BrightWhite- deriving (Eq, Show)- {- | Create a named data series for multi-series plots. @@@ -868,58 +885,6 @@ setGridChar grid x y ch col = updateAt grid y (\row -> setAt row x (ch, col)) -ansiCode :: Color -> Int-ansiCode Black = 30-ansiCode Red = 31-ansiCode Green = 32-ansiCode Yellow = 33-ansiCode Blue = 34-ansiCode Magenta = 35-ansiCode Cyan = 36-ansiCode White = 37-ansiCode BrightBlack = 90-ansiCode BrightRed = 91-ansiCode BrightGreen = 92-ansiCode BrightYellow = 93-ansiCode BrightBlue = 94-ansiCode BrightMagenta = 95-ansiCode BrightCyan = 96-ansiCode BrightWhite = 97-ansiCode Default = 39--ansiOn :: Color -> Text-ansiOn c = "\ESC[" <> Text.pack (show (ansiCode c)) <> "m"--ansiOff :: Text-ansiOff = "\ESC[0m"--paint :: Color -> Char -> Text-paint c ch = if ch == ' ' then " " else ansiOn c <> Text.singleton ch <> ansiOff--paletteColors :: [Color]-paletteColors =- [ BrightBlue- , BrightMagenta- , BrightCyan- , BrightGreen- , BrightYellow- , BrightRed- , BrightWhite- , BrightBlack- ]--pieColors :: [Color]-pieColors =- [ BrightRed- , BrightGreen- , BrightYellow- , BrightBlue- , BrightMagenta- , BrightCyan- , BrightWhite- , BrightBlack- ]- data Pat = Solid | Checker | DiagA | DiagB | Sparse deriving (Eq, Show) ink :: Pat -> Int -> Int -> Bool@@ -932,99 +897,6 @@ palette :: [Pat] palette = [Solid, Checker, DiagA, DiagB, Sparse] -data Array2D a = A2D Int Int (Arr a)--getA2D :: Array2D a -> Int -> Int -> a-getA2D (A2D w _ xs) x y = indexA xs (y * w + x)--setA2D :: Array2D a -> Int -> Int -> a -> Array2D a-setA2D (A2D w h xs) x y v =- let i = y * w + x- in A2D w h (setA xs i v)--newA2D :: Int -> Int -> a -> Array2D a-newA2D w h v = A2D w h (fromList (replicate (w * h) v))--toBit :: Int -> Int -> Int-toBit ry rx = case (ry, rx) of- (0, 0) -> 1- (1, 0) -> 2- (2, 0) -> 4- (3, 0) -> 64- (0, 1) -> 8- (1, 1) -> 16- (2, 1) -> 32- (3, 1) -> 128- _ -> 0--data Canvas = Canvas- { cW :: Int- , cH :: Int- , buffer :: Array2D Int- , cbuf :: Array2D (Maybe Color)- }--newCanvas :: Int -> Int -> Canvas-newCanvas w h = Canvas w h (newA2D w h 0) (newA2D w h Nothing)--setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas-setDotC c xDot yDot mcol- | xDot < 0 || yDot < 0 || xDot >= cW c * 2 || yDot >= cH c * 4 = c- | otherwise =- let (cx, rx) = xDot `divMod` 2- (cy, ry) = yDot `divMod` 4- b = toBit ry rx- m = getA2D (buffer c) cx cy- c' = c{buffer = setA2D (buffer c) cx cy (m .|. b)}- in case mcol of- Nothing -> c'- Just col -> c'{cbuf = setA2D (cbuf c) cx cy (Just col)}--fillDotsC ::- (Int, Int) ->- (Int, Int) ->- (Int -> Int -> Bool) ->- Maybe Color ->- Canvas ->- Canvas-fillDotsC (x0, y0) (x1, y1) p mcol c0 =- let xs = [max 0 x0 .. min (cW c0 * 2 - 1) x1]- ys = [max 0 y0 .. min (cH c0 * 4 - 1) y1]- in List.foldl'- (\c y -> List.foldl' (\c' x -> if p x y then setDotC c' x y mcol else c') c xs)- c0- ys--renderCanvas :: Canvas -> Text-renderCanvas (Canvas w h a colA) =- let glyph 0 = ' '- glyph m = chr (0x2800 + m)- rows =- fmap- ( \y -> flip fmap [0 .. w - 1] $ \x ->- let m = getA2D a x y- ch = glyph m- mc = getA2D colA x y- in maybe (Text.singleton ch) (`paint` ch) mc- )- [0 .. h - 1]- in Text.unlines (fmap Text.concat rows)--justifyRight :: Int -> Text -> Text-justifyRight n s = Text.replicate (max 0 (n - wcswidth s)) " " <> s--wcswidth :: Text -> Int-wcswidth = go 0- where- go acc xs- | Text.null xs = acc- | Text.isPrefixOf "\ESC[" xs =- let- rest' = Text.dropWhile (/= 'm') xs- in- if Text.null rest' then acc else go acc (Text.tail rest')- | otherwise = go (acc + 1) (Text.tail xs)- fmt :: AxisEnv -> Int -> Double -> Text fmt _ _ v | abs v >= 10000 || abs v < 0.01 && v /= 0 =@@ -1038,35 +910,6 @@ (not . Text.null) [plotTitle cfg, contentWithAxes, legendBlockStr] -{- | Evenly spaced tick positions in screen space paired with data values.- If invertY = True, 0 maps to ymax (top row) and 1 maps to ymin (bottom).--}-ticks1D ::- -- | screen length in chars (width for X, height for Y)- Int ->- -- | requested number of ticks (will clamp to >= 2)- Int ->- -- | (vmin, vmax) in data space- (Double, Double) ->- -- | invertY? (True for Y axis so row 0 = ymax)- Bool ->- -- | (screenPos, dataValue)- [(Int, Double)]-ticks1D screenLen want (vmin, vmax) invertY =- let n = max 2 want- lastIx = max 0 (screenLen - 1)- toVal t =- if invertY- then vmax - t * (vmax - vmin)- else vmin + t * (vmax - vmin)- mk' k =- let t = if n == 1 then 0 else fromIntegral k / fromIntegral (n - 1)- pos = round (t * fromIntegral lastIx)- in (pos, toVal t)- raw = [mk' k | k <- [0 .. n - 1]]- dedup = List.nubBy ((==) `on` fst) raw- in dedup- slotBudget :: Int -> Int -> Int slotBudget plotPixels numTicks = max 1 (plotPixels `div` max 1 numTicks)@@ -1244,12 +1087,6 @@ s = renderCanvas c in Text.dropWhileEnd (== '\n') s -clamp :: (Ord a) => a -> a -> a -> a-clamp low high x = max low (min high x)--eps :: Double-eps = 1e-12- boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double) boundsXY cfg pts = let (xs, ys) = unzip pts@@ -1265,9 +1102,6 @@ , fromMaybe (ymax + pady) (snd (yBounds cfg)) ) -mod' :: Double -> Double -> Double-mod' a m = a - fromIntegral (floor (a / m) :: Int) * m- blockChar :: Int -> Char blockChar n = case clamp 0 8 n of 0 -> ' '@@ -1311,195 +1145,50 @@ | (i, v) <- zip [0 ..] xs ] -addAt :: [Int] -> Int -> Int -> [Int]-addAt xs i v = updateAt xs i (+ v)--normalize :: [(Text, Double)] -> [(Text, Double)]-normalize xs =- let s = sum (map (abs . snd) xs) + 1e-12- in [(n, max 0 (v / s)) | (n, v) <- xs]--angleWithin :: Double -> Double -> Double -> Bool-angleWithin ang a0 a1- | a1 >= a0 = ang >= a0 && ang <= a1- | otherwise = ang >= a0 || ang <= a1--lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas-lineDotsC (x0, y0) (x1, y1) mcol c0 =- let dx = abs (x1 - x0)- sx = if x0 < x1 then 1 else -1- dy = negate (abs (y1 - y0))- sy = if y0 < y1 then 1 else -1- go x y err c- | x == x1 && y == y1 = setDotC c x y mcol- | otherwise =- let e2 = 2 * err- (x', err') = if e2 >= dy then (x + sx, err + dy) else (x, err)- (y', err'') = if e2 <= dx then (y + sy, err' + dx) else (y, err')- in go x' y' err'' (setDotC c x y mcol)- in go x0 y0 (dx + dy) c0--quartiles :: [Double] -> (Double, Double, Double, Double, Double)-quartiles [] = (0, 0, 0, 0, 0) -- Idk. Maybe throw an error here???-quartiles xs =- let sorted = List.sort xs- n = length sorted- q1Idx = n `div` 4- q2Idx = n `div` 2- q3Idx = 3 * n `div` 4- getIdx i = if i < n then sorted !! i else last sorted- in if n < 5- then let m = sum xs / fromIntegral n in (m, m, m, m, m)- else- ( fromMaybe 0 (listToMaybe sorted)- , getIdx q1Idx- , getIdx q2Idx- , getIdx q3Idx- , last sorted- )--gridWidth :: [[a]] -> Int-gridWidth [] = 0-gridWidth (x : _) = length x---- | Min and max function for axis bounds which defaults to 0 and 1 when empty.-minimum', maximum' :: [Double] -> Double-minimum' [] = 0-minimum' xs = minimum xs-maximum' [] = 1-maximum' xs = maximum xs---- AVL Tree we'll use as an array.--- This improves upon the previous implementation that relies--- on linked list for indexing and update (both O(n)) while keeping--- the dependencies very light (wouldn't want to install all of containers--- just to get an int map).-data Arr a- = E- | N Int Int (Arr a) a (Arr a)--size :: Arr a -> Int-size E = 0-size (N sz _ _ _ _) = sz--height :: Arr a -> Int-height E = 0-height (N _ h _ _ _) = h--mk :: Arr a -> a -> Arr a -> Arr a-mk l x r = N sz h l x r- where- sl = size l- sr = size r- hl = height l- hr = height r- sz = 1 + sl + sr- h = 1 + max hl hr--rotateL :: Arr a -> Arr a-rotateL (N _ _ l x (N _ _ rl y rr)) = mk (mk l x rl) y rr-rotateL _ = error "rotateL: malformed tree"--rotateR :: Arr a -> Arr a-rotateR (N _ _ (N _ _ ll y lr) x r) = mk ll y (mk lr x r)-rotateR _ = error "rotateR: malformed tree"+-- | Filled-area chart with the curve closed down to @y=0@.+area :: [(Text, [(Double, Double)])] -> Plot -> Text+area sers cfg =+ renderChartTerminal $+ LC.areaChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -balance :: Arr a -> Arr a-balance t@(N _ _ l x r)- | height l > height r + 1 =- case l of- N _ _ ll _ lr ->- if height ll >= height lr- then rotateR t- else rotateR (mk (rotateL l) x r)- _ -> t- | height r > height l + 1 =- case r of- N _ _ rl _ rr ->- if height rr >= height rl- then rotateL t- else rotateL (mk l x (rotateR r))- _ -> t- | otherwise = mk l x r-balance t = t+-- | Filled band between @(x, ymin, ymax)@ curves — e.g. CI envelopes.+ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text+ribbon sers cfg =+ renderChartTerminal $+ LC.ribbonChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -indexA :: Arr a -> Int -> a-indexA t i =- case t of- E -> error ("index out of bounds: " <> show i)- N _ _ l x r ->- let sl = size l- in if i < 0 || i >= 1 + sl + size r- then error ("index out of bounds: " <> show i)- else- if i < sl- then indexA l i- else- if i == sl- then x- else indexA r (i - sl - 1)+-- | Gaussian KDE per series (Silverman bandwidth).+density :: [(Text, [Double])] -> Plot -> Text+density sers cfg =+ renderChartTerminal $+ LC.densityChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -setA :: Arr a -> Int -> a -> Arr a-setA t i y =- case t of- E -> error ("index out of bounds when setting: " <> show i)- N _ _ l x r ->- let sl = size l- in if i < 0 || i >= 1 + sl + size r- then error ("index out of bounds: " <> show i)- else- if i < sl- then balance (mk (setA l i y) x r)- else- if i == sl- then mk l y r- else balance (mk l x (setA r (i - sl - 1) y))+-- | Points with vertical error bars: @(x, y, ymin, ymax)@ per row.+errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text+errorBars sers cfg =+ renderChartTerminal $+ LC.errorBarsChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -fromList :: [a] -> Arr a-fromList xs = fst (build (length xs) xs)- where- build :: Int -> [a] -> (Arr a, [a])- build 0 ys = (E, ys)- build n ys =- let (l, ys1) = build (n `div` 2) ys- (x, ys2) = case ys1 of- [] -> error "IMPOSSIBLE"- (v : vs) -> (v, vs)- (r, ys3) = build (n - n `div` 2 - 1) ys2- in (mk l x r, ys3)+-- | Horizontal bars sized by their values.+funnel :: [(Text, Double)] -> Plot -> Text+funnel stages cfg =+ renderChartTerminal $+ LC.funnelChart stages (widthChars cfg) (heightChars cfg) (plotTitle cfg) --- >>> setAt "abc" (-1) 'x'--- "abc"--- >>> setAt "abc" 0 'x'--- "xbc"--- >>> setAt "abc" 2 'x'--- "abx"--- >>> setAt "abc" 10 'x'--- "abc"-setAt :: [a] -> Int -> a -> [a]-setAt xs i v = updateAt xs i (const v)+-- | Polar line chart; theta in radians CCW from +x.+polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text+polarLine sers cfg =+ renderChartTerminal $+ LC.polarLineChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -updateAt :: [a] -> Int -> (a -> a) -> [a]-updateAt xs i f- | i < 0 = xs- | otherwise = go xs i- where- go [] _ = []- go (x : rest) 0 = f x : rest- go (x : rest) n = x : go rest (n - 1)+-- | Waterfall chart: rows are @(label, start, end)@.+waterfall :: [(Text, Double, Double)] -> Plot -> Text+waterfall rows cfg =+ renderChartTerminal $+ LC.waterfallChart rows (widthChars cfg) (heightChars cfg) (plotTitle cfg) -{- | Ensure the text fits within maxWidth. If it doesn't, truncate and append an ellipsis.->>> ellipsisize 5 "Hello, World!"-"Hell\8230"->>> ellipsisize 1 "Hi"-"\8230"->>> ellipsisize 0 "Hello, World!"-""->>> ellipsisize 20 "Hello, World!"-"Hello, World!"--}-ellipsisize :: Int -> Text -> Text-ellipsisize maxWidth lbl- | maxWidth <= 0 = ""- | wcswidth lbl > maxWidth = Text.take (maxWidth - 1) lbl <> "…"- | otherwise = lbl+-- | Histogram + KDE overlay per series.+distPlot :: [(Text, [Double])] -> Plot -> Text+distPlot sers cfg =+ renderChartTerminal $+ LC.distPlotChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)
+ src/Granite/Chart.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Chart+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Convenience builders that construct a 'Chart' from the same kinds of+arguments accepted by the legacy chart functions in "Granite". Use+these when you want the declarative IR while still keeping ergonomic+construction:++@+import Granite.Chart+import qualified Data.Text.IO as T+import Granite.Render.Pipeline++main = do+ let ch = scatterChart+ [("A", [(0,0),(1,1),(2,4)])+ ,("B", [(0,1),(1,3),(2,6)])+ ] (Just "Random points")+ T.putStrLn (renderChartTerminal ch)+@+-}+module Granite.Chart (+ scatterChart,+ lineChart,+) where++import Data.Text (Text)++import Granite.Data.Frame (Column (..), fromColumns)+import Granite.Spec++{- | Build an IR scatter chart from N series, each with its own (x, y)+pairs. Each series becomes a separate 'GeomPoint' layer carrying its+own data frame and a group aesthetic that drives the legend.+-}+scatterChart :: [(Text, [(Double, Double)])] -> Maybe Text -> Chart+scatterChart sers title =+ emptyChart+ { chartTitle = title+ , chartLayers = map mkLayer sers+ }+ where+ mkLayer (name, pts) =+ let xs = map fst pts+ ys = map snd pts+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ in (defLayer GeomPoint)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef name)+ }+ }++{- | Build an IR line chart from N series; analogous to 'scatterChart'+but with one 'GeomLine' layer per series.+-}+lineChart :: [(Text, [(Double, Double)])] -> Maybe Text -> Chart+lineChart sers title =+ emptyChart+ { chartTitle = title+ , chartLayers = map mkLayer sers+ }+ where+ mkLayer (name, pts) =+ let xs = map fst pts+ ys = map snd pts+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ in (defLayer GeomLine)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef name)+ }+ }
+ src/Granite/Color.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Color+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Color primitives shared by both the terminal and SVG backends:+the ANSI 16-color palette ('Color'), escape-code helpers, and the+hex mapping used by the SVG backend.+-}+module Granite.Color (+ Color (..),+ ansiCode,+ ansiOn,+ ansiOff,+ paint,+ colorHex,+ paletteColors,+ pieColors,+) where++import Data.Text (Text)+import Data.Text qualified as Text++-- | Supported ANSI colo(u)rs.+data Color+ = Default+ | Black+ | Red+ | Green+ | Yellow+ | Blue+ | Magenta+ | Cyan+ | White+ | BrightBlack+ | BrightRed+ | BrightGreen+ | BrightYellow+ | BrightBlue+ | BrightMagenta+ | BrightCyan+ | BrightWhite+ deriving (Eq, Show, Read)++ansiCode :: Color -> Int+ansiCode Black = 30+ansiCode Red = 31+ansiCode Green = 32+ansiCode Yellow = 33+ansiCode Blue = 34+ansiCode Magenta = 35+ansiCode Cyan = 36+ansiCode White = 37+ansiCode BrightBlack = 90+ansiCode BrightRed = 91+ansiCode BrightGreen = 92+ansiCode BrightYellow = 93+ansiCode BrightBlue = 94+ansiCode BrightMagenta = 95+ansiCode BrightCyan = 96+ansiCode BrightWhite = 97+ansiCode Default = 39++ansiOn :: Color -> Text+ansiOn c = "\ESC[" <> Text.pack (show (ansiCode c)) <> "m"++ansiOff :: Text+ansiOff = "\ESC[0m"++-- | Wrap a character in ANSI on/off sequences. Spaces pass through unchanged.+paint :: Color -> Char -> Text+paint c ch = if ch == ' ' then " " else ansiOn c <> Text.singleton ch <> ansiOff++-- | Hex RGB approximation of the ANSI palette, used by the SVG backend.+colorHex :: Color -> Text+colorHex Default = "#555555"+colorHex Black = "#2c3e50"+colorHex Red = "#c0392b"+colorHex Green = "#27ae60"+colorHex Yellow = "#f39c12"+colorHex Blue = "#2980b9"+colorHex Magenta = "#8e44ad"+colorHex Cyan = "#16a085"+colorHex White = "#ecf0f1"+colorHex BrightBlack = "#7f8c8d"+colorHex BrightRed = "#e74c3c"+colorHex BrightGreen = "#2ecc71"+colorHex BrightYellow = "#f1c40f"+colorHex BrightBlue = "#3498db"+colorHex BrightMagenta = "#9b59b6"+colorHex BrightCyan = "#1abc9c"+colorHex BrightWhite = "#bdc3c7"++-- | Default palette for layered charts (scatter, line, bars, …).+paletteColors :: [Color]+paletteColors =+ [ BrightBlue+ , BrightMagenta+ , BrightCyan+ , BrightGreen+ , BrightYellow+ , BrightRed+ , BrightWhite+ , BrightBlack+ ]++-- | Palette used by pie / box plots (categorical, more saturated).+pieColors :: [Color]+pieColors =+ [ BrightRed+ , BrightGreen+ , BrightYellow+ , BrightBlue+ , BrightMagenta+ , BrightCyan+ , BrightWhite+ , BrightBlack+ ]
+ src/Granite/Data/Frame.hs view
@@ -0,0 +1,104 @@++{-# LANGUAGE Strict #-}++{- |+Module : Granite.Data.Frame+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Column-oriented data frame used as input to the chart IR.+-}+module Granite.Data.Frame (+ Column (..),+ columnLength,+ columnAsNum,+ columnAsText,+ DataFrame (..),+ emptyFrame,+ addColumn,+ lookupColumn,+ columnNames,+ frameLength,+ fromColumns,+ filterByRows,+ uniqueText,+ pickRows,+) where++import Data.Int (Int64)+import Data.List qualified as List+import Data.Text (Text)+import Data.Text qualified as Text++data Column+ = ColNum ![Double]+ | ColCat ![Text]+ | ColTime ![Int64]+ | ColBool ![Bool]+ deriving (Eq, Show, Read)++columnLength :: Column -> Int+columnLength col = case col of+ ColNum xs -> length xs+ ColCat xs -> length xs+ ColTime xs -> length xs+ ColBool xs -> length xs++columnAsNum :: Column -> Maybe [Double]+columnAsNum col = case col of+ ColNum xs -> Just xs+ ColBool xs -> Just (map (\b -> if b then 1 else 0) xs)+ ColTime xs -> Just (map fromIntegral xs)+ ColCat _ -> Nothing++columnAsText :: Column -> [Text]+columnAsText col = case col of+ ColCat xs -> xs+ ColNum xs -> map showD xs+ ColTime xs -> map (Text.pack . show) xs+ ColBool xs -> map (Text.pack . show) xs+ where+ showD :: Double -> Text+ showD d = Text.pack (show d)++newtype DataFrame = DataFrame {unDataFrame :: [(Text, Column)]}+ deriving (Eq, Show, Read)++emptyFrame :: DataFrame+emptyFrame = DataFrame []++addColumn :: Text -> Column -> DataFrame -> DataFrame+addColumn name col (DataFrame xs)+ | any ((== name) . fst) xs =+ DataFrame [(n, if n == name then col else c) | (n, c) <- xs]+ | otherwise = DataFrame (xs ++ [(name, col)])++lookupColumn :: Text -> DataFrame -> Maybe Column+lookupColumn name (DataFrame xs) = lookup name xs++columnNames :: DataFrame -> [Text]+columnNames (DataFrame xs) = map fst xs++frameLength :: DataFrame -> Int+frameLength (DataFrame xs) = foldr (max . columnLength . snd) 0 xs++fromColumns :: [(Text, Column)] -> DataFrame+fromColumns = DataFrame++pickRows :: [Int] -> Column -> Column+pickRows ixs col = case col of+ ColNum xs -> ColNum (pick xs)+ ColCat xs -> ColCat (pick xs)+ ColTime xs -> ColTime (pick xs)+ ColBool xs -> ColBool (pick xs)+ where+ pick :: [a] -> [a]+ pick xs = [xs !! i | i <- ixs, i < length xs]++filterByRows :: [Int] -> DataFrame -> DataFrame+filterByRows ixs (DataFrame cols) =+ DataFrame [(n, pickRows ixs c) | (n, c) <- cols]++uniqueText :: [Text] -> [Text]+uniqueText = List.nub
+ src/Granite/Format.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Format+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Apply a declarative 'Formatter' to a 'Double'. Replaces the+function-typed @LabelFormatter@ used by the legacy 'Granite.Plot'+record, so the entire chart spec can stay JSON-shaped.+-}+module Granite.Format (+ Formatter (..),+ runFormatter,+) where++import Data.Text (Text)+import Data.Text qualified as Text+import Numeric (showEFloat, showFFloat)++{- | A declarative formatter applied to numeric tick / label values.++The /Default/ behaves like the legacy formatter: scientific for+very small or very large magnitudes, fixed-point with one decimal+otherwise. The other constructors give the caller explicit control+without needing to embed a Haskell function in the spec.+-}+data Formatter+ = FormatDefault+ | -- | fixed point with the given decimals+ FormatPrecision Int+ | -- | scientific notation with the given decimals+ FormatScientific Int+ | -- | percentage (multiplies by 100), with given decimals+ FormatPercent Int+ | -- | integer with comma grouping (1,234,567)+ FormatComma+ | {- | epoch-millisecond value formatted with the given strftime-style+ pattern; unsupported in this phase, returns the raw value.+ -}+ FormatDateTime !Text+ | {- | a printf-like template with a single \"{}" placeholder.+ This phase only supports \"{}" itself.+ -}+ FormatTemplate !Text+ | -- | SI suffixes (1.2k, 3.4M)+ FormatSI+ deriving (Eq, Show, Read)++runFormatter :: Formatter -> Double -> Text+runFormatter f v = case f of+ FormatDefault -> defaultFmt v+ FormatPrecision n -> Text.pack (showFFloat (Just n) v "")+ FormatScientific n -> Text.pack (showEFloat (Just n) v "")+ FormatPercent n -> Text.pack (showFFloat (Just n) (v * 100) "") <> "%"+ FormatComma -> commaGroup (round v :: Integer)+ FormatDateTime _ -> Text.pack (show v)+ FormatTemplate t -> Text.replace "{}" (defaultFmt v) t+ FormatSI -> siSuffix v++defaultFmt :: Double -> Text+defaultFmt v+ | abs v >= 10000 || abs v < 0.01 && v /= 0 =+ Text.pack (showEFloat (Just 1) v "")+ | otherwise = Text.pack (showFFloat (Just 1) v "")++commaGroup :: Integer -> Text+commaGroup n =+ let neg = n < 0+ digits = reverse (show (abs n))+ chunks = chunkN 3 digits+ grouped = reverse (intercalateRev "," chunks)+ in (if neg then "-" else "") <> Text.pack grouped++chunkN :: Int -> [a] -> [[a]]+chunkN _ [] = []+chunkN n xs = take n xs : chunkN n (drop n xs)++intercalateRev :: [a] -> [[a]] -> [a]+intercalateRev sep = go+ where+ go [] = []+ go [x] = x+ go (x : xs) = x ++ sep ++ go xs++siSuffix :: Double -> Text+siSuffix v+ | a >= 1e12 = fmt (v / 1e12) "T"+ | a >= 1e9 = fmt (v / 1e9) "G"+ | a >= 1e6 = fmt (v / 1e6) "M"+ | a >= 1e3 = fmt (v / 1e3) "k"+ | a >= 1 = Text.pack (showFFloat (Just 1) v "")+ | a >= 1e-3 = fmt (v * 1e3) "m"+ | a >= 1e-6 = fmt (v * 1e6) "\x00b5"+ | otherwise = Text.pack (showEFloat (Just 1) v "")+ where+ a = abs v+ fmt x suf = Text.pack (showFFloat (Just 1) x "") <> suf
+ src/Granite/Internal/LegacyChart.hs view
@@ -0,0 +1,277 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Internal.LegacyChart+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Chart builders shared between 'Granite' and 'Granite.Svg' for the+plotly-express-style helpers (area, ribbon, density, errorBars,+funnel, polarLine, waterfall, distPlot).+-}+module Granite.Internal.LegacyChart (+ Chart,+ plotChart,+ areaChart,+ ribbonChart,+ densityChart,+ errorBarsChart,+ funnelChart,+ polarLineChart,+ waterfallChart,+ distPlotChart,+) where++import Data.Text (Text)+import Data.Text qualified as Text++import Granite.Data.Frame (Column (..), fromColumns)+import Granite.Spec++plotChart :: Int -> Int -> Text -> Chart -> Chart+plotChart w h title chart =+ chart+ { chartSize = SizeChars w h+ , chartTitle = if Text.null title then Nothing else Just title+ }++areaChart :: [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart+areaChart series w h title =+ let layers = concatMap mkSeries series+ in plotChart w h title $ emptyChart{chartLayers = layers}+ where+ mkSeries (name, pts) =+ let xs = map fst pts+ ys = map snd pts+ zeros = replicate (length pts) 0 :: [Double]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("ymin", ColNum zeros)+ ]+ ribbonL =+ (defLayer GeomRibbon)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesYmin = Just (ColumnRef "ymin")+ , aesYmax = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef name)+ }+ , layerAesDef = emptyAesDefaults{defAlpha = Just 0.35}+ }+ lineL =+ (defLayer GeomLine)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef name)+ }+ }+ in [ribbonL, lineL]++ribbonChart ::+ [(Text, [(Double, Double, Double)])] ->+ Int ->+ Int ->+ Text ->+ Chart+ribbonChart series w h title =+ let layers = map mkLayer series+ in plotChart w h title $ emptyChart{chartLayers = layers}+ where+ mkLayer (name, pts) =+ let xs = [x | (x, _, _) <- pts]+ los = [l | (_, l, _) <- pts]+ his = [hi | (_, _, hi) <- pts]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("ymin", ColNum los)+ , ("ymax", ColNum his)+ ]+ in (defLayer GeomRibbon)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesYmin = Just (ColumnRef "ymin")+ , aesYmax = Just (ColumnRef "ymax")+ , aesGroup = Just (ColumnRef name)+ }+ , layerAesDef = emptyAesDefaults{defAlpha = Just 0.4}+ }++densityChart :: [(Text, [Double])] -> Int -> Int -> Text -> Chart+densityChart series w h title =+ let layers = map mkLayer series+ in plotChart w h title $ emptyChart{chartLayers = layers}+ where+ mkLayer (name, sample) =+ let df = fromColumns [("x", ColNum sample)]+ in (defLayer GeomDensity)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ , aesGroup = Just (ColumnRef name)+ }+ , layerStat = StatDensity+ }++errorBarsChart ::+ [(Text, [(Double, Double, Double, Double)])] ->+ Int ->+ Int ->+ Text ->+ Chart+errorBarsChart series w h title =+ let layers = concatMap mkSeries series+ in plotChart w h title $ emptyChart{chartLayers = layers}+ where+ mkSeries (name, rows) =+ let xs = [x | (x, _, _, _) <- rows]+ ys = [y | (_, y, _, _) <- rows]+ los = [l | (_, _, l, _) <- rows]+ his = [hi | (_, _, _, hi) <- rows]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("lo", ColNum los)+ , ("hi", ColNum his)+ ]+ m =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesYmin = Just (ColumnRef "lo")+ , aesYmax = Just (ColumnRef "hi")+ , aesGroup = Just (ColumnRef name)+ }+ bars =+ (defLayer GeomErrorbar)+ { layerData = Just df+ , layerMapping = m+ , layerStat = StatIdentity+ }+ pts =+ (defLayer GeomPoint)+ { layerData = Just df+ , layerMapping = m+ , layerStat = StatIdentity+ }+ in [bars, pts]++funnelChart :: [(Text, Double)] -> Int -> Int -> Text -> Chart+funnelChart stages w h title =+ let names = [n | (n, _) <- stages]+ values = [v | (_, v) <- stages]+ df =+ fromColumns+ [ ("stage", ColCat names)+ , ("value", ColNum values)+ ]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "stage")+ , aesY = Just (ColumnRef "value")+ }+ , layerStat = StatIdentity+ }+ in plotChart w h title $+ emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordFlip+ }++polarLineChart :: [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart+polarLineChart series w h title =+ let layers = map mkLayer series+ in plotChart w h title $+ emptyChart+ { chartLayers = layers+ , chartCoord = CoordPolar ThetaX 0 PolarCCW+ }+ where+ mkLayer (name, pts) =+ let thetas = [t | (t, _) <- pts]+ rs = [r | (_, r) <- pts]+ df = fromColumns [("theta", ColNum thetas), ("r", ColNum rs)]+ in (defLayer GeomLine)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "theta")+ , aesY = Just (ColumnRef "r")+ , aesGroup = Just (ColumnRef name)+ }+ }++waterfallChart :: [(Text, Double, Double)] -> Int -> Int -> Text -> Chart+waterfallChart rows w h title =+ let labels = [n | (n, _, _) <- rows]+ starts = [s | (_, s, _) <- rows]+ ends = [e | (_, _, e) <- rows]+ df =+ fromColumns+ [ ("x", ColCat labels)+ , ("y", ColNum ends)+ , ("__ybase", ColNum starts)+ ]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatIdentity+ }+ in plotChart w h title $+ emptyChart+ { chartData = df+ , chartLayers = [layer]+ }++distPlotChart :: [(Text, [Double])] -> Int -> Int -> Text -> Chart+distPlotChart series w h title =+ let layers = concatMap mkSeries series+ in plotChart w h title $ emptyChart{chartLayers = layers}+ where+ mkSeries (name, sample) =+ let df = fromColumns [("x", ColNum sample)]+ hist =+ (defLayer GeomHistogram)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "count")+ , aesGroup = Just (ColumnRef name)+ }+ , layerStat = StatBin (BinByCount 20)+ , layerAesDef = emptyAesDefaults{defAlpha = Just 0.6}+ }+ kde =+ (defLayer GeomDensity)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ , aesGroup = Just (ColumnRef name)+ }+ , layerStat = StatDensity+ }+ in [hist, kde]
+ src/Granite/Internal/Util.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Internal.Util+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Internal helpers shared across backends.+-}+module Granite.Internal.Util (+ clamp,+ eps,+ minimum',+ maximum',+ mod',+ angleWithin,+ quartiles,+ normalize,+ setAt,+ updateAt,+ addAt,+ gridWidth,+ wcswidth,+ ellipsisize,+ justifyRight,+ showD,+ escXml,+ ticks1D,+) where++import Data.List qualified as List+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Numeric (showFFloat)++clamp :: (Ord a) => a -> a -> a -> a+clamp low high x = max low (min high x)++eps :: Double+eps = 1e-12++minimum', maximum' :: [Double] -> Double+minimum' [] = 0+minimum' xs = minimum xs+maximum' [] = 1+maximum' xs = maximum xs++mod' :: Double -> Double -> Double+mod' a m = a - fromIntegral (floor (a / m) :: Int) * m++angleWithin :: Double -> Double -> Double -> Bool+angleWithin ang a0 a1+ | a1 >= a0 = ang >= a0 && ang <= a1+ | otherwise = ang >= a0 || ang <= a1++{- | Five-number summary: @(min, Q1, median, Q3, max)@. For @n < 5@,+all five values collapse to the mean.+-}+quartiles :: [Double] -> (Double, Double, Double, Double, Double)+quartiles [] = (0, 0, 0, 0, 0)+quartiles xs =+ let sorted = List.sort xs+ n = length sorted+ q1Idx = n `div` 4+ q2Idx = n `div` 2+ q3Idx = 3 * n `div` 4+ getIdx i = if i < n then sorted !! i else last sorted+ in if n < 5+ then let m = sum xs / fromIntegral n in (m, m, m, m, m)+ else+ ( fromMaybe 0 (listToMaybe sorted)+ , getIdx q1Idx+ , getIdx q2Idx+ , getIdx q3Idx+ , last sorted+ )++normalize :: [(Text, Double)] -> [(Text, Double)]+normalize xs =+ let s = sum (map (abs . snd) xs) + 1e-12+ in [(n, max 0 (v / s)) | (n, v) <- xs]++setAt :: [a] -> Int -> a -> [a]+setAt xs i v = updateAt xs i (const v)++updateAt :: [a] -> Int -> (a -> a) -> [a]+updateAt xs i f+ | i < 0 = xs+ | otherwise = go xs i+ where+ go [] _ = []+ go (x : rest) 0 = f x : rest+ go (x : rest) n = x : go rest (n - 1)++addAt :: [Int] -> Int -> Int -> [Int]+addAt xs i v = updateAt xs i (+ v)++gridWidth :: [[a]] -> Int+gridWidth [] = 0+gridWidth (x : _) = length x++-- | Visible width of text, skipping ANSI escape sequences.+wcswidth :: Text -> Int+wcswidth = go 0+ where+ go acc xs+ | Text.null xs = acc+ | Text.isPrefixOf "\ESC[" xs =+ let rest' = Text.dropWhile (/= 'm') xs+ in if Text.null rest' then acc else go acc (Text.tail rest')+ | otherwise = go (acc + 1) (Text.tail xs)++{- | Ensure the text fits within maxWidth. If it doesn't, truncate and append an ellipsis.+>>> ellipsisize 5 "Hello, World!"+"Hell\8230"+>>> ellipsisize 1 "Hi"+"\8230"+>>> ellipsisize 0 "Hello, World!"+""+>>> ellipsisize 20 "Hello, World!"+"Hello, World!"+-}+ellipsisize :: Int -> Text -> Text+ellipsisize maxWidth lbl+ | maxWidth <= 0 = ""+ | wcswidth lbl > maxWidth = Text.take (maxWidth - 1) lbl <> "…"+ | otherwise = lbl++justifyRight :: Int -> Text -> Text+justifyRight n s = Text.replicate (max 0 (n - wcswidth s)) " " <> s++showD :: Double -> Text+showD d+ | d == fromIntegral (round d :: Int) = Text.pack (show (round d :: Int))+ | otherwise = Text.pack (showFFloat (Just 2) d "")++escXml :: Text -> Text+escXml =+ Text.replace "&" "&"+ . Text.replace "<" "<"+ . Text.replace ">" ">"+ . Text.replace "\"" """++{- | Evenly spaced tick positions in screen space paired with data values.+With @invertY = True@, position 0 maps to @vmax@ (top row).+-}+ticks1D :: Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]+ticks1D screenLen want (vmin, vmax) invertY =+ let n = max 2 want+ lastIx = max 0 (screenLen - 1)+ toVal t =+ if invertY+ then vmax - t * (vmax - vmin)+ else vmin + t * (vmax - vmin)+ mk' k =+ let t = if n == 1 then 0 else fromIntegral k / fromIntegral (n - 1)+ pos = round (t * fromIntegral lastIx)+ in (pos, toVal t)+ raw = [mk' k | k <- [0 .. n - 1]]+ in List.nubBy (\a b -> fst a == fst b) raw
+ src/Granite/Position.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Position+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Position adjustments — 'PosStack', 'PosFill', 'PosDodge', 'PosJitter'.+Operates on long-format frames; @stack@ and @fill@ additionally write+a @__ybase@ column for the bar bottom.+-}+module Granite.Position (+ applyPosition,+) where++import Data.List qualified as List+import Data.Text (Text)++import Granite.Data.Frame (+ Column (..),+ DataFrame (..),+ columnAsNum,+ columnAsText,+ fromColumns,+ lookupColumn,+ )+import Granite.Spec (+ ColumnRef (..),+ Mapping (..),+ Position (..),+ )++applyPosition :: Position -> Mapping -> DataFrame -> DataFrame+applyPosition pos m df = case pos of+ PosIdentity -> df+ PosStack -> stackPos False m df+ PosFill -> stackPos True m df+ PosDodge gap -> dodgePos gap m df+ PosJitter dx dy -> jitterPos dx dy m df++stackPos :: Bool -> Mapping -> DataFrame -> DataFrame+stackPos fill m df =+ case ( numColAt (aesX m) df+ , numColAt (aesY m) df+ ) of+ (Just xs, Just ys) ->+ let gs = groupKeys m df (length xs)+ rows = zip3 xs ys gs+ uniqXs = List.nub xs+ stackedPerX =+ concatMap+ ( \x ->+ let here = [(x', y', g') | (x', y', g') <- rows, x' == x]+ ordered = List.sortOn (\(_, _, g) -> seriesIx gs g) here+ running = scanl (+) 0 [y | (_, y, _) <- ordered]+ tops = drop 1 running+ bots = init running+ segs = zip3 ordered tops bots+ total = last running+ norm = if fill && total /= 0 then 1 / total else 1+ in [(xi, yi * norm, gi, top * norm, bot * norm) | ((xi, yi, gi), top, bot) <- segs]+ )+ uniqXs+ xs' = [x | (x, _, _, _, _) <- stackedPerX]+ ys' = [y | (_, _, _, y, _) <- stackedPerX]+ bases = [b | (_, _, _, _, b) <- stackedPerX]+ gs' = [g | (_, _, g, _, _) <- stackedPerX]+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "y"+ gName = case groupRef m of+ Just (ColumnRef n) -> n+ Nothing -> "_group"+ base0 = [(xName, ColNum xs'), (yName, ColNum ys'), ("__ybase", ColNum bases)]+ cols =+ if isJustGroup m+ then base0 <> [(gName, ColCat gs')]+ else base0+ in fromColumns cols+ _ -> df++dodgePos :: Double -> Mapping -> DataFrame -> DataFrame+dodgePos gap m df =+ case numColAt (aesX m) df of+ Just xs ->+ let gs = groupKeys m df (length xs)+ seriesOrder = List.nub gs+ nSeries = max 1 (length seriesOrder)+ center = fromIntegral (nSeries - 1) / 2+ shifted =+ [ x + gap * (fromIntegral (seriesIx gs g) - center)+ | (x, g) <- zip xs gs+ ]+ xName = refName (aesX m) "x"+ in replaceColumn xName (ColNum shifted) df+ _ -> df++{- | Deterministic jitter via the golden-ratio low-discrepancy+sequence, so two runs on the same data produce the same offsets+(golden tests stay stable).+-}+jitterPos :: Double -> Double -> Mapping -> DataFrame -> DataFrame+jitterPos dx dy m df =+ let phi = (sqrt 5 - 1) / 2 :: Double+ wobble seed i =+ let r = (fromIntegral i + 1) * phi + seed+ in (r - fromIntegral (floor r :: Int)) - 0.5+ update mc seedScale axis col = case col of+ Just (ColumnRef name) -> case lookupColumn name df of+ Just (ColNum vs) ->+ let vs' = [v + axis * 2 * wobble seedScale i | (i, v) <- zip [0 :: Int ..] vs]+ in replaceColumn name (ColNum vs') mc+ _ -> mc+ Nothing -> mc+ df1 = update df 0.123 dx (aesX m)+ df2 = update df1 0.789 dy (aesY m)+ in df2++{- | A 'ColCat' column projects each row to its index in the+unique-value list, so stack / dodge group rows that share a+category.+-}+numColAt :: Maybe ColumnRef -> DataFrame -> Maybe [Double]+numColAt Nothing _ = Nothing+numColAt (Just (ColumnRef n)) df =+ case lookupColumn n df of+ Just (ColCat xs) ->+ let uniques = List.nub xs+ indexOf x = maybe 0 fromIntegral (List.elemIndex x uniques)+ in Just (map indexOf xs)+ Just c -> columnAsNum c+ Nothing -> Nothing++groupRef :: Mapping -> Maybe ColumnRef+groupRef m = case aesGroup m of+ Just r -> Just r+ Nothing -> case aesColor m of+ Just r -> Just r+ Nothing -> aesFill m++isJustGroup :: Mapping -> Bool+isJustGroup m = case groupRef m of+ Just _ -> True+ Nothing -> False++groupKeys :: Mapping -> DataFrame -> Int -> [Text]+groupKeys m df fallbackLen = case groupRef m of+ Just (ColumnRef n) -> case lookupColumn n df of+ Just c -> columnAsText c+ Nothing -> replicate fallbackLen "all"+ Nothing -> replicate fallbackLen "all"++seriesIx :: [Text] -> Text -> Int+seriesIx all_ k =+ let order = List.nub all_+ go _ [] = 0+ go i (x : xs) = if x == k then i else go (i + 1) xs+ in go 0 order++refName :: Maybe ColumnRef -> Text -> Text+refName (Just (ColumnRef n)) _ = n+refName Nothing fb = fb++replaceColumn :: Text -> Column -> DataFrame -> DataFrame+replaceColumn name col (DataFrame cols)+ | any ((== name) . fst) cols =+ DataFrame [(n, if n == name then col else c) | (n, c) <- cols]+ | otherwise = DataFrame (cols <> [(name, col)])
+ src/Granite/Render/Chrome.hs view
@@ -0,0 +1,339 @@++{-# LANGUAGE Strict #-}++{- |+Module : Granite.Render.Chrome+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Backend-agnostic chart chrome: axes, title, legend. Each helper+returns a list of primitive 'Mark's.+-}+module Granite.Render.Chrome (+ PlotBox (..),+ computePlotBox,+ axesMarks,+ titleMarks,+ legendMarks,+) where++import Data.Text (Text)+import Data.Text qualified as Text++import Granite.Color (Color (..))+import Granite.Render.Scene (+ Mark (..),+ Point (..),+ Rect (..),+ Style (..),+ TextAnchor (..),+ TextStyle (..),+ defaultStyle,+ defaultTextStyle,+ pxPerChar,+ pxPerLine,+ )+import Granite.Scale (TrainedScale (..))+import Granite.Spec (+ ColorSpec (..),+ Coord (..),+ PolarAes (..),+ PolarDir (..),+ Size (..),+ Theme (..),+ )++{- | Pixel rectangle the chart body occupies, plus the overall scene+bounds. Margins around the plot area host title, axis labels, legend.+-}+data PlotBox = PlotBox+ { boxSceneW :: !Double+ , boxSceneH :: !Double+ , boxX :: !Double+ , boxY :: !Double+ , boxW :: !Double+ , boxH :: !Double+ }+ deriving (Eq, Show)++computePlotBox :: Size -> Theme -> Bool -> Bool -> Bool -> PlotBox+computePlotBox sz theme hasTitle hasRightLegend hasBottomLegend =+ let (sceneW, sceneH) = case sz of+ SizeChars w h ->+ (fromIntegral w * themePxPerChar theme, fromIntegral h * themePxPerLine theme)+ SizePixels w h -> (fromIntegral w, fromIntegral h)+ SizeResponsive ar ->+ let h = 320+ in (h * ar, h)+ topMargin = if hasTitle then themeTitleSize theme + 20 else 10+ bottomMargin = (if hasBottomLegend then 30 else 0) + themeFontSize theme * 1.8 + 8+ leftMargin = themeFontSize theme * 5+ rightMargin = if hasRightLegend then 120 else 20+ plotW = max 1 (sceneW - leftMargin - rightMargin)+ plotH = max 1 (sceneH - topMargin - bottomMargin)+ in PlotBox sceneW sceneH leftMargin topMargin plotW plotH++axesMarks :: Theme -> PlotBox -> Coord -> TrainedScale -> TrainedScale -> [Mark]+axesMarks theme box coord xs ys = case coord of+ CoordCartesian -> cartesianAxes theme box False xs ys+ -- CoordFlip rotates 90° CW so the Y axis grows top-down.+ CoordFlip -> cartesianAxes theme box True ys xs+ CoordPolar aes a0 dir -> polarAxes theme box aes a0 dir xs ys++{- | Axes are 'MAxisLine' spines (clean box-drawing chars in terminal,+@<line>@ in SVG). Gridlines and tick stubs are omitted so the+terminal output stays uncluttered; tick /labels/ sit beside each+break. @flipY@ inverts Y for 'CoordFlip'.+-}+cartesianAxes ::+ Theme -> PlotBox -> Bool -> TrainedScale -> TrainedScale -> [Mark]+cartesianAxes theme box flipY xs ys =+ let axisColor = colorOfSpec (themeAxisColor theme)+ textColor = colorOfSpec (themeTextColor theme)++ px = boxX box+ py = boxY box+ pw = boxW box+ ph = boxH box++ spineStyle = defaultStyle{styleStroke = Just axisColor, styleStrokeWidth = 1}++ xAxis = MAxisLine (Point px (py + ph)) (Point (px + pw) (py + ph)) spineStyle+ yAxis = MAxisLine (Point px py) (Point px (py + ph)) spineStyle++ xLabels =+ [ MText+ (Point xPos (py + ph + themeFontSize theme + 4))+ lbl+ defaultTextStyle+ { textFill = textColor+ , textSize = themeFontSize theme+ , textAnchor = AnchorMiddle+ }+ | (v, lbl) <- zip (tsBreaks xs) (tsLabels xs)+ , inDomain (tsDomain xs) v+ , let xPos = px + tsProject xs v * pw+ ]++ yLabels =+ [ MText+ (Point (px - 6) (yPos + themeFontSize theme / 3))+ lbl+ defaultTextStyle+ { textFill = textColor+ , textSize = themeFontSize theme+ , textAnchor = AnchorEnd+ }+ | (v, lbl) <- zip (tsBreaks ys) (tsLabels ys)+ , inDomain (tsDomain ys) v+ , let yPos =+ if flipY+ then py + tsProject ys v * ph+ else py + ph - tsProject ys v * ph+ ]+ in [xAxis, yAxis] <> xLabels <> yLabels++{- | Concentric rings (radial breaks) + radial spokes (angular breaks)++ tick labels. Centred in the plot box with radius = half its+shortest side.+-}+polarAxes ::+ Theme ->+ PlotBox ->+ PolarAes ->+ Double ->+ PolarDir ->+ TrainedScale ->+ TrainedScale ->+ [Mark]+polarAxes theme box aes a0 dir xs ys =+ let cx = boxX box + boxW box / 2+ cy = boxY box + boxH box / 2+ maxR = min (boxW box) (boxH box) / 2+ gridColor = colorOfSpec (themeGridColor theme)+ axisColor = colorOfSpec (themeAxisColor theme)+ textColor = colorOfSpec (themeTextColor theme)+ sign = case dir of+ PolarCW -> 1+ PolarCCW -> -1 :: Double++ (thetaScale, radialScale) = case aes of+ ThetaX -> (xs, ys)+ ThetaY -> (ys, xs)++ circleAt :: Double -> Maybe Color -> Double -> Mark+ circleAt rPx stroke widthPx =+ let nSeg = 64 :: Int+ pts =+ [ Point (cx + rPx * cos a) (cy + rPx * sin a)+ | i <- [0 .. nSeg]+ , let a = (fromIntegral i / fromIntegral nSeg) * 2 * pi+ ]+ in MPolyline pts defaultStyle{styleStroke = stroke, styleStrokeWidth = widthPx}++ rings =+ [ circleAt (tsProject radialScale v * maxR) (Just gridColor) 0.5+ | v <- tsBreaks radialScale+ , inDomain (tsDomain radialScale) v+ , tsProject radialScale v > 1e-6+ ]++ outerRing = circleAt maxR (Just axisColor) 1++ spokeFor v =+ let t = tsProject thetaScale v+ theta = a0 + sign * t * 2 * pi+ ox = cx + maxR * cos theta+ oy = cy + maxR * sin theta+ in MPolyline+ [Point cx cy, Point ox oy]+ defaultStyle{styleStroke = Just gridColor, styleStrokeWidth = 0.5}+ spokes =+ [ spokeFor v+ | v <- tsBreaks thetaScale+ , inDomain (tsDomain thetaScale) v+ ]++ thetaLabelOffset = 10+ thetaLabels =+ [ MText+ ( Point+ (cx + (maxR + thetaLabelOffset) * cos theta)+ (cy + (maxR + thetaLabelOffset) * sin theta + themeFontSize theme / 3)+ )+ lbl+ defaultTextStyle+ { textFill = textColor+ , textSize = themeFontSize theme+ , textAnchor = AnchorMiddle+ }+ | (v, lbl) <- zip (tsBreaks thetaScale) (tsLabels thetaScale)+ , inDomain (tsDomain thetaScale) v+ , let theta = a0 + sign * tsProject thetaScale v * 2 * pi+ ]++ rLabels =+ [ MText+ ( Point+ (cx + rPx * cos a0 + 3)+ (cy + rPx * sin a0 - 2)+ )+ lbl+ defaultTextStyle+ { textFill = textColor+ , textSize = themeFontSize theme+ , textAnchor = AnchorStart+ }+ | (v, lbl) <- zip (tsBreaks radialScale) (tsLabels radialScale)+ , inDomain (tsDomain radialScale) v+ , let rPx = tsProject radialScale v * maxR+ , rPx > 1e-6+ ]+ in rings <> spokes <> [outerRing] <> thetaLabels <> rLabels++inDomain :: (Double, Double) -> Double -> Bool+inDomain (lo, hi) v = v >= lo - 1e-9 && v <= hi + 1e-9++titleMarks :: Theme -> PlotBox -> Maybe Text -> [Mark]+titleMarks _ _ Nothing = []+titleMarks _ _ (Just t) | Text.null t = []+titleMarks theme box (Just t) =+ [ MText+ (Point (boxX box + boxW box / 2) (boxY box - 8))+ t+ defaultTextStyle+ { textFill = colorOfSpec (themeTextColor theme)+ , textSize = themeTitleSize theme+ , textAnchor = AnchorMiddle+ }+ ]++legendMarks :: Theme -> PlotBox -> [(Text, ColorSpec)] -> [Mark]+legendMarks theme box entries =+ let lx = boxX box + boxW box + 15+ ly = boxY box + 5+ rowH = themeFontSize theme + 6+ in concat+ [ let yy = ly + fromIntegral i * rowH+ swatch =+ MRect+ (Rect lx yy 12 12)+ defaultStyle{styleFill = Just (colorOfSpec col)}+ label =+ MText+ (Point (lx + 16) (yy + themeFontSize theme - 1))+ name+ defaultTextStyle+ { textFill = colorOfSpec (themeTextColor theme)+ , textSize = themeFontSize theme+ , textAnchor = AnchorStart+ }+ in [swatch, label]+ | (i, (name, col)) <- zip [0 :: Int ..] entries+ ]++{- | Quantise a 'ColorSpec' to the nearest ANSI 'Color' for the+terminal backend; SVG reads RGB / Hex directly.+-}+colorOfSpec :: ColorSpec -> Color+colorOfSpec (NamedColor c) = c+colorOfSpec (RGB r g b) = nearestAnsi (fromIntegral r) (fromIntegral g) (fromIntegral b)+colorOfSpec (Hex h) =+ case parseHex h of+ Just (r, g, b) -> nearestAnsi r g b+ Nothing -> Default++parseHex :: Text -> Maybe (Double, Double, Double)+parseHex t =+ let s = Text.unpack (Text.dropWhile (== '#') t)+ in case s of+ [a, b, c, d, e, f] ->+ (,,) <$> fromHex2 [a, b] <*> fromHex2 [c, d] <*> fromHex2 [e, f]+ _ -> Nothing++fromHex2 :: String -> Maybe Double+fromHex2 [a, b] = do+ h <- digit a+ l <- digit b+ pure (fromIntegral (h * 16 + l))+ where+ digit ch+ | isDigit ch = Just (fromEnum ch - fromEnum '0')+ | ch >= 'a' && ch <= 'f' = Just (10 + fromEnum ch - fromEnum 'a')+ | ch >= 'A' && ch <= 'F' = Just (10 + fromEnum ch - fromEnum 'A')+ | otherwise = Nothing+fromHex2 _ = Nothing++{- | Nearest of the 16 ANSI colors using the canonical VGA palette+(not the pastel SVG hex values). Important for visibility: mid-gray+@#555555@ maps to 'BrightBlack' (a real grey), not 'Black' (which+would be invisible on a dark terminal).+-}+nearestAnsi :: Double -> Double -> Double -> Color+nearestAnsi r g b =+ let candidates =+ [ (Black, 0, 0, 0)+ , (Red, 170, 0, 0)+ , (Green, 0, 170, 0)+ , (Yellow, 170, 85, 0)+ , (Blue, 0, 0, 170)+ , (Magenta, 170, 0, 170)+ , (Cyan, 0, 170, 170)+ , (White, 170, 170, 170)+ , (BrightBlack, 85, 85, 85)+ , (BrightRed, 255, 85, 85)+ , (BrightGreen, 85, 255, 85)+ , (BrightYellow, 255, 255, 85)+ , (BrightBlue, 85, 85, 255)+ , (BrightMagenta, 255, 85, 255)+ , (BrightCyan, 85, 255, 255)+ , (BrightWhite, 255, 255, 255)+ ]+ dist (_, cr, cg, cb) = sq (r - cr) + sq (g - cg) + sq (b - cb)+ sq x = x * x+ pick (best, bd) cand =+ let d = dist cand+ in if d < bd then (fstC cand, d) else (best, bd)+ fstC (c, _, _, _) = c+ in fst (foldl pick (Default, 1 / 0) candidates)
+ src/Granite/Render/Pipeline.hs view
@@ -0,0 +1,896 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Render.Pipeline+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Chart → Scene pipeline. 'chartToScene' compiles a 'Chart' spec into+a backend-agnostic 'Scene'; 'renderChartTerminal' and+'renderChartSvg' pair it with the matching backend.+-}+module Granite.Render.Pipeline (+ renderChart,+ renderChartTerminal,+ renderChartSvg,+ chartToScene,+) where++import Data.List qualified as List+import Data.Text (Text)+import Data.Text qualified as Text++import Granite.Color (Color (..))+import Granite.Data.Frame (+ Column (..),+ DataFrame (..),+ columnAsNum,+ columnAsText,+ filterByRows,+ lookupColumn,+ )+import Granite.Position (applyPosition)+import Granite.Render.Chrome (+ PlotBox (..),+ axesMarks,+ computePlotBox,+ legendMarks,+ titleMarks,+ )+import Granite.Render.Scene (+ Mark (..),+ Point (..),+ Rect (..),+ Scene (..),+ Style (..),+ TextAnchor (..),+ TextStyle (..),+ defaultStyle,+ defaultTextStyle,+ )+import Granite.Render.Svg qualified as Svg+import Granite.Render.Terminal qualified as Terminal+import Granite.Scale (TrainedScale (..), train)+import Granite.Spec (+ AesDefaults (..),+ Chart (..),+ ColorSpec (..),+ ColumnRef (..),+ Coord (..),+ Facet (..),+ FacetScales (..),+ Geom (..),+ Layer (..),+ Mapping (..),+ PolarAes (..),+ PolarDir (..),+ Scales (..),+ Size (..),+ Theme (..),+ aesX,+ aesY,+ )+import Granite.Stat (applyStat)++type Projector = Double -> Double -> Point++buildProjector :: Coord -> PlotBox -> TrainedScale -> TrainedScale -> Projector+buildProjector c box xs ys = case c of+ CoordCartesian -> cartesianProjector box xs ys+ CoordFlip -> flipProjector box xs ys+ CoordPolar aes a0 dir -> polarProjector aes a0 dir box xs ys++cartesianProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector+cartesianProjector box xs ys x y =+ Point+ (boxX box + tsProject xs x * boxW box)+ (boxY box + boxH box - tsProject ys y * boxH box)++{- | 'CoordFlip' rotates the chart 90° clockwise: the X aesthetic+projects top-down (data x=0 → top), matching ggplot @coord_flip()@+and Plotly's horizontal-bar / funnel convention.+-}+flipProjector :: PlotBox -> TrainedScale -> TrainedScale -> Projector+flipProjector box xs ys x y =+ Point+ (boxX box + tsProject ys y * boxW box)+ (boxY box + tsProject xs x * boxH box)++polarProjector ::+ PolarAes ->+ Double ->+ PolarDir ->+ PlotBox ->+ TrainedScale ->+ TrainedScale ->+ Projector+polarProjector aes a0 dir box xs ys =+ let cx = boxX box + boxW box / 2+ cy = boxY box + boxH box / 2+ maxR = min (boxW box) (boxH box) / 2+ sign = case dir of+ PolarCW -> 1+ PolarCCW -> -1+ in \x y ->+ let (tVal, rVal) = case aes of+ ThetaX -> (tsProject xs x, tsProject ys y)+ ThetaY -> (tsProject ys y, tsProject xs x)+ theta = a0 + sign * tVal * 2 * pi+ r = rVal * maxR+ in Point (cx + r * cos theta) (cy + r * sin theta)++renderChartTerminal :: Chart -> Text+renderChartTerminal = Terminal.renderScene . chartToScene++{- | SVG render; uses responsive sizing when 'chartSize' is+'SizeResponsive', explicit pixel dimensions otherwise.+-}+renderChartSvg :: Chart -> Text+renderChartSvg chart =+ let render = case chartSize chart of+ SizeResponsive _ -> Svg.renderSceneResponsive+ _ -> Svg.renderScene+ in render (chartToScene chart)++renderChart :: Chart -> (Text, Text)+renderChart c = (renderChartTerminal c, renderChartSvg c)++chartToScene :: Chart -> Scene+chartToScene chart =+ let theme = chartTheme chart+ palette = themePalette theme+ coord = chartCoord chart+ hasTitle = case chartTitle chart of+ Just t -> not (Text.null t)+ Nothing -> False+ legendEntries = collectLegend (chartLayers chart) palette+ hasRightLegend = not (null legendEntries)+ box = computePlotBox (chartSize chart) theme hasTitle hasRightLegend False++ panels = layoutPanels theme box chart+ panelMarks = concatMap (renderPanel theme palette coord) panels++ legend = legendMarks theme box legendEntries+ title = titleMarks theme box (chartTitle chart)++ marks = panelMarks <> title <> legend+ in Scene (boxSceneW box) (boxSceneH box) marks++data PanelSpec = PanelSpec+ { panelBox :: PlotBox+ , panelLabel :: Text+ , panelData :: DataFrame+ , panelLayers :: [Layer]+ , panelXScale :: TrainedScale+ , panelYScale :: TrainedScale+ }++renderPanel :: Theme -> [ColorSpec] -> Coord -> PanelSpec -> [Mark]+renderPanel theme palette coord ps =+ let proj = buildProjector coord (panelBox ps) (panelXScale ps) (panelYScale ps)+ layerMarks =+ concat+ [ runLayer theme (panelBox ps) proj palette i (panelData ps) layer+ | (i, layer) <- zip [0 :: Int ..] (panelLayers ps)+ ]+ axes = axesMarks theme (panelBox ps) coord (panelXScale ps) (panelYScale ps)+ strip = stripMark theme (panelBox ps) (panelLabel ps)+ in axes <> layerMarks <> strip++stripMark :: Theme -> PlotBox -> Text -> [Mark]+stripMark theme box label+ | Text.null label = []+ | otherwise =+ [ MText+ (Point (boxX box + boxW box / 2) (boxY box - 4))+ label+ defaultTextStyle+ { textFill = colorOfSpec (themeTextColor theme)+ , textSize = themeFontSize theme+ , textAnchor = AnchorMiddle+ }+ ]+ where+ colorOfSpec spec = case spec of+ NamedColor c -> c+ _ -> Default++layoutPanels :: Theme -> PlotBox -> Chart -> [PanelSpec]+layoutPanels theme box chart = case chartFacet chart of+ FacetNull ->+ [singlePanel chart box ""]+ FacetWrap colRef mNcol mNrow scalesMode ->+ let keys = facetKeys colRef (chartData chart) (chartLayers chart)+ in case keys of+ [] -> [singlePanel chart box ""]+ _ ->+ let n = length keys+ (nrow, ncol) = wrapDims n mNcol mNrow+ cells = gridCells theme box nrow ncol+ in [ panelFor chart colRef key scalesMode cellBox+ | (key, cellBox) <- zip keys cells+ ]+ FacetGrid rowRefs colRefs scalesMode ->+ let (rowKeys, colKeys) = gridKeys rowRefs colRefs (chartData chart) (chartLayers chart)+ rowKeys' = if null rowKeys then [""] else rowKeys+ colKeys' = if null colKeys then [""] else colKeys+ nrow = length rowKeys'+ ncol = length colKeys'+ cells = gridCells theme box nrow ncol+ in [ gridPanel chart rowRefs colRefs rowKey colKey scalesMode cellBox+ | (rowKey, rowIx) <- zip rowKeys' [0 :: Int ..]+ , (colKey, colIx) <- zip colKeys' [0 :: Int ..]+ , let cellBox = cells !! (rowIx * ncol + colIx)+ ]++singlePanel :: Chart -> PlotBox -> Text -> PanelSpec+singlePanel chart box label =+ let xRange = paddedRange (chartLayers chart) (chartData chart) xRangeRefs True+ yRange = paddedRange (chartLayers chart) (chartData chart) yRangeRefs False+ xs0 = train (scaleX (chartScales chart)) xRange+ ys0 = train (scaleY (chartScales chart)) yRange+ xs = applyCategorical aesX (chartLayers chart) (chartData chart) xs0+ ys = applyCategorical aesY (chartLayers chart) (chartData chart) ys0+ in PanelSpec+ { panelBox = box+ , panelLabel = label+ , panelData = chartData chart+ , panelLayers = chartLayers chart+ , panelXScale = xs+ , panelYScale = ys+ }++panelFor :: Chart -> ColumnRef -> Text -> FacetScales -> PlotBox -> PanelSpec+panelFor chart colRef key scalesMode box =+ let (frame, layers) = filterChartByKey chart colRef key+ chart' = chart{chartData = frame, chartLayers = layers}+ (xs, ys) = trainPanelScales chart chart' scalesMode+ in PanelSpec+ { panelBox = box+ , panelLabel = key+ , panelData = frame+ , panelLayers = layers+ , panelXScale = xs+ , panelYScale = ys+ }++gridPanel ::+ Chart ->+ [ColumnRef] ->+ [ColumnRef] ->+ Text ->+ Text ->+ FacetScales ->+ PlotBox ->+ PanelSpec+gridPanel chart rowRefs colRefs rowKey colKey scalesMode box =+ let frame0 = chartData chart+ frame1 = foldl (\f c -> filterFrameByKey c rowKey f) frame0 rowRefs+ frame2 = foldl (\f c -> filterFrameByKey c colKey f) frame1 colRefs+ filterLayer l =+ l+ { layerData =+ fmap+ ( \df ->+ let g0 = foldl (\f c -> filterFrameByKey c rowKey f) df rowRefs+ in foldl (\f c -> filterFrameByKey c colKey f) g0 colRefs+ )+ (layerData l)+ }+ layers = map filterLayer (chartLayers chart)+ chart' = chart{chartData = frame2, chartLayers = layers}+ label = case (Text.null rowKey, Text.null colKey) of+ (True, True) -> ""+ (True, False) -> colKey+ (False, True) -> rowKey+ (False, False) -> rowKey <> " | " <> colKey+ (xs, ys) = trainPanelScales chart chart' scalesMode+ in PanelSpec+ { panelBox = box+ , panelLabel = label+ , panelData = frame2+ , panelLayers = layers+ , panelXScale = xs+ , panelYScale = ys+ }++trainPanelScales ::+ Chart -> Chart -> FacetScales -> (TrainedScale, TrainedScale)+trainPanelScales whole panel mode =+ let xS = scaleX (chartScales whole)+ yS = scaleY (chartScales whole)+ wholeXRange = paddedRange (chartLayers whole) (chartData whole) xRangeRefs True+ wholeYRange = paddedRange (chartLayers whole) (chartData whole) yRangeRefs False+ panelXRange = paddedRange (chartLayers panel) (chartData panel) xRangeRefs True+ panelYRange = paddedRange (chartLayers panel) (chartData panel) yRangeRefs False+ (xRange, yRange) = case mode of+ ScalesFixed -> (wholeXRange, wholeYRange)+ ScalesFreeX -> (panelXRange, wholeYRange)+ ScalesFreeY -> (wholeXRange, panelYRange)+ ScalesFree -> (panelXRange, panelYRange)+ xs = applyCategorical aesX (chartLayers panel) (chartData panel) (train xS xRange)+ ys = applyCategorical aesY (chartLayers panel) (chartData panel) (train yS yRange)+ in (xs, ys)++{- | Strip height of 32 px = two terminal lines, so panel data never+shares a character row with its facet strip label.+-}+gridCells :: Theme -> PlotBox -> Int -> Int -> [PlotBox]+gridCells theme box nrow ncol =+ let stripH = max 32 (themeFontSize theme * 2 + 10)+ gutterX = 10+ gutterY = 14+ cellW = boxW box / fromIntegral ncol+ cellH = boxH box / fromIntegral nrow+ in [ box+ { boxX = boxX box + fromIntegral c * cellW + gutterX / 2+ , boxY = boxY box + fromIntegral r * cellH + stripH+ , boxW = cellW - gutterX+ , boxH = cellH - stripH - gutterY+ }+ | r <- [0 .. nrow - 1]+ , c <- [0 .. ncol - 1]+ ]++wrapDims :: Int -> Maybe Int -> Maybe Int -> (Int, Int)+wrapDims n mNcol mNrow = case (mNcol, mNrow) of+ (Just c, Just r) -> (max 1 r, max 1 c)+ (Just c, Nothing) -> (ceilingDiv n (max 1 c), max 1 c)+ (Nothing, Just r) -> (max 1 r, ceilingDiv n (max 1 r))+ (Nothing, Nothing) ->+ let c = max 1 (ceiling (sqrt (fromIntegral n :: Double)))+ in (ceilingDiv n c, c)+ where+ ceilingDiv a b = (a + b - 1) `div` b++facetKeys :: ColumnRef -> DataFrame -> [Layer] -> [Text]+facetKeys colRef chartFrame layers =+ case keysFrom colRef chartFrame of+ Just ks -> List.nub ks+ Nothing ->+ List.nub $+ concat+ [ ks+ | Just frame <- map layerData layers+ , Just ks <- [keysFrom colRef frame]+ ]+ where+ keysFrom (ColumnRef name) (DataFrame cols) =+ case lookup name cols of+ Just c -> Just (columnAsText c)+ Nothing -> Nothing++gridKeys ::+ [ColumnRef] -> [ColumnRef] -> DataFrame -> [Layer] -> ([Text], [Text])+gridKeys rowRefs colRefs chartFrame _layers =+ let rowKeys = compoundKeys rowRefs chartFrame+ colKeys = compoundKeys colRefs chartFrame+ in (rowKeys, colKeys)+ where+ compoundKeys refs frame+ | null refs = []+ | otherwise =+ let perCol = [maybe [] columnAsText (lookupColumnByRef r frame) | r <- refs]+ rows =+ case perCol of+ [] -> []+ (xs : _) -> map (compoundAt perCol) [0 .. length xs - 1]+ in List.nub rows+ compoundAt cols i =+ Text.intercalate "\x00" [if i < length c then c !! i else "" | c <- cols]+ lookupColumnByRef (ColumnRef n) (DataFrame cols) = lookup n cols++filterFrameByKey :: ColumnRef -> Text -> DataFrame -> DataFrame+filterFrameByKey (ColumnRef name) key df@(DataFrame cols) =+ case lookup name cols of+ Nothing -> df+ Just c ->+ let texts = columnAsText c+ ixs = [i | (i, v) <- zip [0 ..] texts, v == key]+ in filterByRows ixs df++filterChartByKey :: Chart -> ColumnRef -> Text -> (DataFrame, [Layer])+filterChartByKey chart colRef key =+ let frame' = filterFrameByKey colRef key (chartData chart)+ filterLayer l =+ l{layerData = fmap (filterFrameByKey colRef key) (layerData l)}+ layers' = map filterLayer (chartLayers chart)+ in (frame', layers')++runLayer ::+ Theme ->+ PlotBox ->+ Projector ->+ [ColorSpec] ->+ Int ->+ DataFrame ->+ Layer ->+ [Mark]+runLayer theme box proj palette ix globalFrame layer =+ let frame0 = Data.Maybe.fromMaybe globalFrame (layerData layer)+ framePostStat = applyStat (layerStat layer) (layerMapping layer) frame0+ frame = applyPosition (layerPosition layer) (layerMapping layer) framePostStat+ m = layerMapping layer+ defaults = layerAesDef layer+ colorSpec = case defColor defaults of+ Just c -> c+ Nothing -> layerDefaultColor palette ix layer+ col = specToTerminal colorSpec+ radius = case defSize defaults of+ Just r -> r+ Nothing -> pointSize theme layer+ alpha = Data.Maybe.fromMaybe 1 (defAlpha defaults)+ lineW = Data.Maybe.fromMaybe 2 (defLineWidth defaults)+ in case layerGeom layer of+ GeomPoint -> drawPoints proj frame m colorSpec radius alpha+ GeomLine -> drawLine proj frame m colorSpec lineW+ GeomBar -> drawBars proj frame m col+ GeomCol -> drawBars proj frame m col+ GeomHistogram -> drawBars proj frame m col+ GeomRibbon -> drawRibbon proj frame m col+ GeomErrorbar -> drawErrorbar proj frame m col+ GeomTile -> drawTiles proj frame m col+ GeomBoxplot -> drawBoxplot proj frame m col+ GeomDensity -> drawDensity proj frame m col+ GeomText -> drawText proj frame m col (themeFontSize theme)+ GeomArc -> drawArcs box frame m palette++drawPoints ::+ Projector ->+ DataFrame ->+ Mapping ->+ ColorSpec ->+ Double ->+ Double ->+ [Mark]+drawPoints proj frame m col r alpha =+ case (resolveNumColumn frame (aesX m), resolveNumColumn frame (aesY m)) of+ (Just xv, Just yv) ->+ [ MCircle+ (proj x y)+ r+ defaultStyle+ { styleFill = Just (specToTerminal col)+ , styleFillOpacity = alpha+ }+ | (x, y) <- zip xv yv+ ]+ _ -> []++drawLine ::+ Projector ->+ DataFrame ->+ Mapping ->+ ColorSpec ->+ Double ->+ [Mark]+drawLine proj frame m col lineW =+ case (resolveNumColumn frame (aesX m), resolveNumColumn frame (aesY m)) of+ (Just xv, Just yv) ->+ let sorted = List.sortOn fst (zip xv yv)+ pts = [proj x y | (x, y) <- sorted]+ in [ MPolyline+ pts+ defaultStyle+ { styleStroke = Just (specToTerminal col)+ , styleStrokeWidth = lineW+ }+ ]+ _ -> []++drawBars :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawBars proj frame m col =+ case (resolveNumColumn frame (aesX m), resolveNumColumn frame (aesY m)) of+ (Just xs, Just ys) ->+ let bases = case lookupColumn "__ybase" frame >>= columnAsNum of+ Just bs | length bs == length xs -> bs+ _ -> replicate (length xs) 0+ w = barWidth xs+ halfW = w / 2+ in [ rectFromCorners+ (proj (x - halfW) y0)+ (proj (x + halfW) y1)+ col+ | (x, y1, y0) <- zip3 xs ys bases+ ]+ _ -> []++barWidth :: [Double] -> Double+barWidth xs+ | length unique < 2 = 0.8+ | otherwise =+ let diffs = zipWith (-) (drop 1 unique) unique+ pos = filter (> 1e-9) diffs+ in if null pos then 0.8 else minimum pos * 0.8+ where+ unique = List.nub (List.sort xs)++rectFromCorners :: Point -> Point -> Color -> Mark+rectFromCorners (Point xa ya) (Point xb yb) col =+ let x0 = min xa xb+ y0 = min ya yb+ w = abs (xa - xb)+ h = abs (ya - yb)+ in MRect (Rect x0 y0 w h) defaultStyle{styleFill = Just col}++drawRibbon :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawRibbon proj frame m col =+ case ( resolveNumColumn frame (aesX m)+ , resolveNumColumn frame (aesYmin m)+ , resolveNumColumn frame (aesYmax m)+ ) of+ (Just xs, Just lo, Just hi) ->+ let triples = List.sortOn (\(a, _, _) -> a) (zip3 xs lo hi)+ topPts = [proj x h | (x, _, h) <- triples]+ botPts = reverse [proj x l | (x, l, _) <- triples]+ in [ MPolygon+ (topPts <> botPts)+ defaultStyle+ { styleFill = Just col+ , styleFillOpacity = 0.4+ , styleStroke = Just col+ , styleStrokeWidth = 1+ }+ ]+ _ -> []++drawErrorbar :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawErrorbar proj frame m col =+ case ( resolveNumColumn frame (aesX m)+ , resolveNumColumn frame (aesYmin m)+ , resolveNumColumn frame (aesYmax m)+ ) of+ (Just xs, Just lo, Just hi) ->+ let capW = barWidth xs * 0.4+ halfW = capW / 2+ style = defaultStyle{styleStroke = Just col, styleStrokeWidth = 1.5}+ in concat+ [ [ MPolyline [proj x l, proj x h] style+ , MPolyline [proj (x - halfW) l, proj (x + halfW) l] style+ , MPolyline [proj (x - halfW) h, proj (x + halfW) h] style+ ]+ | (x, l, h) <- zip3 xs lo hi+ ]+ _ -> []++drawTiles :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawTiles proj frame m col =+ case (resolveNumColumn frame (aesX m), resolveNumColumn frame (aesY m)) of+ (Just xs, Just ys) ->+ let wX = barWidth xs / 0.8+ wY = barWidth ys / 0.8+ halfX = wX / 2+ halfY = wY / 2+ fillCol = resolveNumColumn frame (aesFill m)+ fillRange = case fillCol of+ Just vs | not (null vs) -> (minimum vs, maximum vs)+ _ -> (0, 1)+ colorFor i = case fillCol of+ Just vs+ | i < length vs ->+ let (lo, hi) = fillRange+ t =+ if hi == lo+ then 0.5+ else (vs !! i - lo) / (hi - lo)+ in gradientColor t+ _ -> col+ in [ rectFromCorners+ (proj (x - halfX) (y - halfY))+ (proj (x + halfX) (y + halfY))+ (colorFor i)+ | (i, (x, y)) <- zip [0 :: Int ..] (zip xs ys)+ ]+ _ -> []++gradientColor :: Double -> Color+gradientColor t =+ let palette =+ [ Blue+ , BrightBlue+ , BrightCyan+ , BrightGreen+ , BrightYellow+ , BrightRed+ ]+ n = length palette+ clamped = max 0 (min 0.9999 t)+ ix = floor (clamped * fromIntegral n) :: Int+ in palette !! ix++drawBoxplot :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawBoxplot proj frame m col =+ case ( resolveNumColumn frame (aesX m)+ , lookupColumn "__ymin" frame >>= columnAsNum+ , lookupColumn "__q1" frame >>= columnAsNum+ , lookupColumn "__median" frame >>= columnAsNum+ , lookupColumn "__q3" frame >>= columnAsNum+ , lookupColumn "__ymax" frame >>= columnAsNum+ ) of+ (Just xs, Just mins, Just qq1, Just meds, Just qq3, Just maxs) ->+ let w = barWidth xs+ halfW = w / 2+ style = defaultStyle{styleStroke = Just col, styleStrokeWidth = 1}+ fillStyle = style{styleFill = Just col, styleFillOpacity = 0.2}+ in concat+ [ [ MPolygon+ [ proj (x - halfW) qLo+ , proj (x + halfW) qLo+ , proj (x + halfW) qHi+ , proj (x - halfW) qHi+ ]+ fillStyle+ , MPolyline+ [proj (x - halfW) medV, proj (x + halfW) medV]+ style{styleStrokeWidth = 2}+ , MPolyline [proj x qLo, proj x ymin] style+ , MPolyline [proj x qHi, proj x ymax] style+ ]+ | (x, ymin, qLo, medV, qHi, ymax) <- List.zip6 xs mins qq1 meds qq3 maxs+ ]+ _ -> []++drawDensity :: Projector -> DataFrame -> Mapping -> Color -> [Mark]+drawDensity proj frame m col =+ drawLine proj frame m (NamedColor col) 2++drawText :: Projector -> DataFrame -> Mapping -> Color -> Double -> [Mark]+drawText proj frame m col size =+ case ( resolveNumColumn frame (aesX m)+ , resolveNumColumn frame (aesY m)+ , aesLabel m+ ) of+ (Just xs, Just ys, Just (ColumnRef labelCol)) ->+ case lookupColumn labelCol frame of+ Just labelColData ->+ let labels = columnAsText labelColData+ triples = zip3 xs ys labels+ in [ MText+ (proj x y)+ lbl+ defaultTextStyle+ { textFill = col+ , textSize = size+ , textAnchor = AnchorMiddle+ }+ | (x, y, lbl) <- triples+ ]+ Nothing -> []+ _ -> []++drawArcs :: PlotBox -> DataFrame -> Mapping -> [ColorSpec] -> [Mark]+drawArcs box frame m palette =+ case resolveNumColumn frame (aesY m) of+ Just vs+ | not (null vs) ->+ let total = sum vs+ cx = boxX box + boxW box / 2+ cy = boxY box + boxH box / 2+ r = min (boxW box) (boxH box) / 2 * 0.9+ fracs = if total == 0 then map (const 0) vs else map (/ total) vs+ starts = scanl (+) (- (pi / 2)) (map (* (2 * pi)) fracs)+ ends = drop 1 starts+ colorAt i = palette !! (i `mod` max 1 (length palette))+ in [ MArc+ (Point cx cy)+ r+ s+ e+ defaultStyle+ { styleFill = Just (specToTerminal (colorAt i))+ , styleStroke = Just (specToTerminal (NamedColor BrightBlack))+ , styleStrokeWidth = 1+ }+ | (i, (s, e)) <- zip [0 :: Int ..] (zip starts ends)+ ]+ _ -> []++{- | Resolve a column to numeric values for projection. Categorical+columns map each row to its position in the unique-value list, so+repeated values share an X position (needed for stacked / grouped+/ faceted bars).+-}+resolveNumColumn :: DataFrame -> Maybe ColumnRef -> Maybe [Double]+resolveNumColumn _ Nothing = Nothing+resolveNumColumn df (Just (ColumnRef n)) =+ case lookupColumn n df of+ Just (ColCat xs) -> Just (categoricalIndices xs)+ Just c -> columnAsNum c+ Nothing -> Nothing++categoricalIndices :: [Text] -> [Double]+categoricalIndices xs =+ let uniques = List.nub xs+ indexOf x = maybe 0 fromIntegral (List.elemIndex x uniques)+ in map indexOf xs++{- | Range across one or more aesthetic getters; the Y-axis caller+folds @aesY@ + @aesYmin@ + @aesYmax@ + the conventional internal+columns so ribbon / errorbar / boxplot layers (which leave 'aesY'+unset) still get a sensible Y range. Stat and position are applied+so histogram-style 'count' columns appear.+-}+unionDataRange ::+ [Mapping -> Maybe ColumnRef] ->+ [Layer] ->+ DataFrame ->+ (Double, Double)+unionDataRange getRefs layers globalFrame =+ let pulls =+ [ values+ | layer <- layers+ , let m = layerMapping layer+ base = Data.Maybe.fromMaybe globalFrame (layerData layer)+ stat' = applyStat (layerStat layer) m base+ frame = applyPosition (layerPosition layer) m stat'+ , getRef <- getRefs+ , Just values <- [resolveNumColumn frame (getRef m)]+ ]+ all_ = concat pulls+ in if null all_+ then (0, 1)+ else (minimum all_, maximum all_)++{- | Range with geom adjustments: bar/col/histogram/tile pad ±halfWidth+around (x, y) so boundary rects don't overflow the plot box; bars+also extend the Y range to include their @__ybase@ (default 0) so a+horizontal bar chart with all-positive values doesn't put its+baseline outside the scale.+-}+paddedRange ::+ [Layer] ->+ DataFrame ->+ [Mapping -> Maybe ColumnRef] ->+ Bool ->+ (Double, Double)+paddedRange layers frame getRefs isXAxis =+ let (lo, hi) = unionDataRange getRefs layers frame+ primary = case getRefs of+ (g : _) -> g+ [] -> const Nothing+ pad = geomAxisPadding primary isXAxis layers frame+ loPadded = lo - pad+ hiPadded = hi + pad+ in case barAxisAnchor isXAxis layers frame of+ Nothing -> (loPadded, hiPadded)+ Just anchor -> (min loPadded anchor, max hiPadded anchor)++yRangeRefs :: [Mapping -> Maybe ColumnRef]+yRangeRefs =+ [ aesY+ , aesYmin+ , aesYmax+ , const (Just (ColumnRef "__ymin"))+ , const (Just (ColumnRef "__q1"))+ , const (Just (ColumnRef "__median"))+ , const (Just (ColumnRef "__q3"))+ , const (Just (ColumnRef "__ymax"))+ , const (Just (ColumnRef "__ybase"))+ ]++xRangeRefs :: [Mapping -> Maybe ColumnRef]+xRangeRefs = [aesX]++{- | When an aesthetic resolves to a 'ColCat' column, override the+trained scale's breaks and labels so each category sits at its+integer index with the category text as its tick label. Numeric+data passes through unchanged.+-}+applyCategorical ::+ (Mapping -> Maybe ColumnRef) ->+ [Layer] ->+ DataFrame ->+ TrainedScale ->+ TrainedScale+applyCategorical getRef layers globalFrame ts =+ case categoricalLabelsFor getRef layers globalFrame of+ Nothing -> ts+ Just labels ->+ let breaks = [fromIntegral i | i <- [0 .. length labels - 1 :: Int]]+ in ts{tsBreaks = breaks, tsLabels = labels}++{- | Read /pre-stat/ — a stat like 'StatBoxplot' consumes the+categorical X and emits numeric indices, but the labels we want+are the user's original group names.+-}+categoricalLabelsFor ::+ (Mapping -> Maybe ColumnRef) ->+ [Layer] ->+ DataFrame ->+ Maybe [Text]+categoricalLabelsFor getRef layers globalFrame = findFirst layers+ where+ findFirst [] = Nothing+ findFirst (layer : rest) =+ let m = layerMapping layer+ frame = Data.Maybe.fromMaybe globalFrame (layerData layer)+ in case getRef m of+ Just (ColumnRef n) -> case lookupColumn n frame of+ Just (ColCat xs) -> Just (List.nub xs)+ _ -> findFirst rest+ Nothing -> findFirst rest++geomAxisPadding ::+ (Mapping -> Maybe ColumnRef) ->+ Bool ->+ [Layer] ->+ DataFrame ->+ Double+geomAxisPadding getRef isXAxis layers globalFrame =+ let perLayerPad layer+ | not (needsPadding (layerGeom layer) isXAxis) = 0+ | otherwise =+ let m = layerMapping layer+ base = Data.Maybe.fromMaybe globalFrame (layerData layer)+ postStat = applyStat (layerStat layer) m base+ postPos = applyPosition (layerPosition layer) m postStat+ in case resolveNumColumn postPos (getRef m) of+ Just vs -> barWidth vs / 2+ Nothing -> 0+ pads = map perLayerPad layers+ in if null pads then 0 else maximum (0 : pads)++needsPadding :: Geom -> Bool -> Bool+needsPadding GeomBar isX = isX+needsPadding GeomCol isX = isX+needsPadding GeomHistogram isX = isX+needsPadding GeomBoxplot isX = isX+needsPadding GeomErrorbar isX = isX+needsPadding GeomTile _ = True+needsPadding _ _ = False++{- | Bar baseline: the minimum of @__ybase@ across bar-like layers+(default 0), so an all-positive chart still includes 0 at the+bottom of the bars.+-}+barAxisAnchor :: Bool -> [Layer] -> DataFrame -> Maybe Double+barAxisAnchor isXAxis layers globalFrame+ | isXAxis = Nothing+ | otherwise =+ let bases = [anchorFor layer | layer <- layers, isBarLike (layerGeom layer)]+ in case bases of+ [] -> Nothing+ xs -> Just (minimum (0 : xs))+ where+ isBarLike GeomBar = True+ isBarLike GeomCol = True+ isBarLike GeomHistogram = True+ isBarLike _ = False++ anchorFor layer =+ let m = layerMapping layer+ base = Data.Maybe.fromMaybe globalFrame (layerData layer)+ postStat = applyStat (layerStat layer) m base+ postPos = applyPosition (layerPosition layer) m postStat+ in case lookupColumn "__ybase" postPos >>= columnAsNum of+ Just bs | not (null bs) -> minimum bs+ _ -> 0++layerDefaultColor :: [ColorSpec] -> Int -> Layer -> ColorSpec+layerDefaultColor palette ix _layer+ | null palette = NamedColor BrightBlue+ | otherwise = palette !! (ix `mod` length palette)++pointSize :: Theme -> Layer -> Double+pointSize _ _ = 3++collectLegend :: [Layer] -> [ColorSpec] -> [(Text, ColorSpec)]+collectLegend layers palette =+ [ (legendName ix layer, palette !! (ix `mod` max 1 (length palette)))+ | (ix, layer) <- zip [0 :: Int ..] layers+ ]+ where+ legendName ix layer =+ case aesGroup (layerMapping layer) of+ Just (ColumnRef n) -> n+ Nothing -> "series " <> Text.pack (show ix)++{- | Quantise 'ColorSpec' to the nearest renderable ANSI 'Color' for+the terminal backend. SVG reads RGB / Hex directly.+-}+specToTerminal :: ColorSpec -> Color+specToTerminal (NamedColor c) = c+specToTerminal (RGB {}) = BrightBlue+specToTerminal (Hex _) = BrightBlue
+ src/Granite/Render/Scene.hs view
@@ -0,0 +1,97 @@++{-# LANGUAGE Strict #-}++{- |+Module : Granite.Render.Scene+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Backend-agnostic IR. Coordinates are in logical pixels; the terminal+backend maps them to character cells via 'pxPerChar' / 'pxPerLine'+(Braille gives 2×4 sub-cell resolution).+-}+module Granite.Render.Scene (+ Point (..),+ Rect (..),+ Mark (..),+ Scene (..),+ Style (..),+ defaultStyle,+ TextStyle (..),+ defaultTextStyle,+ TextAnchor (..),+ pxPerChar,+ pxPerLine,+) where++import Data.Text (Text)+import Granite.Color (Color (..))++data Point = Point !Double !Double+ deriving (Eq, Show)++-- | Axis-aligned rectangle by top-left + size.+data Rect = Rect+ { rectX :: !Double+ , rectY :: !Double+ , rectW :: !Double+ , rectH :: !Double+ }+ deriving (Eq, Show)++-- | 'Nothing' on fill or stroke means "don't paint that side".+data Style = Style+ { styleFill :: !(Maybe Color)+ , styleStroke :: !(Maybe Color)+ , styleStrokeWidth :: !Double+ , styleFillOpacity :: !Double+ }+ deriving (Eq, Show)++defaultStyle :: Style+defaultStyle = Style Nothing Nothing 1 1++data TextAnchor = AnchorStart | AnchorMiddle | AnchorEnd+ deriving (Eq, Show)++data TextStyle = TextStyle+ { textFill :: !Color+ , textSize :: !Double+ , textAnchor :: !TextAnchor+ }+ deriving (Eq, Show)++defaultTextStyle :: TextStyle+defaultTextStyle = TextStyle Default 11 AnchorStart++{- | Primitive drawable marks. 'MArc' takes (center, radius, a0, a1)+in radians CCW from +x. 'MPolygon' is a closed filled polyline.+'MAxisLine' is an axis-aligned 1-px line that the terminal backend+writes as box-drawing chars (@│@ / @─@ / @┼@) for crisp axes;+everything else is rasterised through Braille.+-}+data Mark+ = MCircle !Point !Double !Style+ | MRect !Rect !Style+ | MPolyline ![Point] !Style+ | MPolygon ![Point] !Style+ | MPath !Text !Style+ | MText !Point !Text !TextStyle+ | MArc !Point !Double !Double !Double !Style+ | MAxisLine !Point !Point !Style+ | MGroup ![Mark]+ deriving (Eq, Show)++data Scene = Scene+ { sceneWidth :: !Double+ , sceneHeight :: !Double+ , sceneMarks :: ![Mark]+ }+ deriving (Eq, Show)++pxPerChar :: Double+pxPerChar = 10++pxPerLine :: Double+pxPerLine = 16
+ src/Granite/Render/Svg.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Render.Svg+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++SVG backend.+-}+module Granite.Render.Svg (+ renderScene,+ renderSceneResponsive,+ attr,+ svgDoc,+ svgDocWith,+ svgRect,+ svgCircle,+ svgLine,+ svgPolyline,+ svgPath,+ svgText,+) where++import Data.Text (Text)+import Data.Text qualified as T++import Granite.Color (Color (..), colorHex)+import Granite.Internal.Util (escXml, showD)+import Granite.Render.Scene (+ Mark (..),+ Point (..),+ Rect (..),+ Scene (..),+ Style (..),+ TextAnchor (..),+ TextStyle (..),+ )++attr :: Text -> Text -> Text+attr k v = " " <> k <> "=\"" <> v <> "\""++svgDoc :: Double -> Double -> Text -> Text+svgDoc = svgDocWith False++svgDocWith :: Bool -> Double -> Double -> Text -> Text+svgDocWith responsive w h content =+ "<svg xmlns=\"http://www.w3.org/2000/svg\""+ <> attr "viewBox" ("0 0 " <> showD w <> " " <> showD h)+ <> sizing+ <> attr "font-family" "system-ui, -apple-system, sans-serif"+ <> ">\n"+ <> "<rect width=\"100%\" height=\"100%\" fill=\"white\"/>\n"+ <> content+ <> "</svg>\n"+ where+ sizing+ | responsive =+ attr "preserveAspectRatio" "xMidYMid meet"+ <> attr "width" "100%"+ <> attr "style" "height:auto"+ | otherwise =+ attr "width" (showD w) <> attr "height" (showD h)++svgRect :: Double -> Double -> Double -> Double -> Text -> Text -> Text+svgRect x y w h fill extra =+ "<rect"+ <> attr "x" (showD x)+ <> attr "y" (showD y)+ <> attr "width" (showD w)+ <> attr "height" (showD h)+ <> attr "fill" fill+ <> extra+ <> "/>\n"++svgCircle :: Double -> Double -> Double -> Text -> Text+svgCircle cx cy r fill =+ "<circle"+ <> attr "cx" (showD cx)+ <> attr "cy" (showD cy)+ <> attr "r" (showD r)+ <> attr "fill" fill+ <> "/>\n"++svgLine :: Double -> Double -> Double -> Double -> Text -> Double -> Text+svgLine x1 y1 x2 y2 stroke strokeW =+ "<line"+ <> attr "x1" (showD x1)+ <> attr "y1" (showD y1)+ <> attr "x2" (showD x2)+ <> attr "y2" (showD y2)+ <> attr "stroke" stroke+ <> attr "stroke-width" (showD strokeW)+ <> "/>\n"++svgPolyline :: [(Double, Double)] -> Text -> Double -> Text+svgPolyline pts stroke strokeW =+ "<polyline"+ <> attr "points" (T.intercalate " " [showD x <> "," <> showD y | (x, y) <- pts])+ <> attr "fill" "none"+ <> attr "stroke" stroke+ <> attr "stroke-width" (showD strokeW)+ <> attr "stroke-linejoin" "round"+ <> attr "stroke-linecap" "round"+ <> "/>\n"++svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text+svgText x y anchor fill size content =+ "<text"+ <> attr "x" (showD x)+ <> attr "y" (showD y)+ <> attr "text-anchor" anchor+ <> attr "fill" fill+ <> attr "font-size" (showD size)+ <> ">"+ <> escXml content+ <> "</text>\n"++svgPath :: Text -> Text -> Text -> Text+svgPath d fill extra =+ "<path"+ <> attr "d" d+ <> attr "fill" fill+ <> extra+ <> "/>\n"++renderScene :: Scene -> Text+renderScene scene =+ svgDoc (sceneWidth scene) (sceneHeight scene) $+ T.concat (map renderMark (sceneMarks scene))++renderSceneResponsive :: Scene -> Text+renderSceneResponsive scene =+ svgDocWith True (sceneWidth scene) (sceneHeight scene) $+ T.concat (map renderMark (sceneMarks scene))++renderMark :: Mark -> Text+renderMark m = case m of+ MRect (Rect x y w h) sty ->+ let fill = maybe "none" colorHex (styleFill sty)+ extras =+ strokeAttrs sty+ <> opacityAttr sty+ in svgRect x y w h fill extras+ MCircle (Point x y) r sty ->+ let fill = maybe "none" colorHex (styleFill sty)+ in "<circle"+ <> attr "cx" (showD x)+ <> attr "cy" (showD y)+ <> attr "r" (showD r)+ <> attr "fill" fill+ <> strokeAttrs sty+ <> opacityAttr sty+ <> "/>\n"+ MText (Point x y) txt ts ->+ svgText+ x+ y+ (anchorText (textAnchor ts))+ (colorHex (textFill ts))+ (textSize ts)+ txt+ MPolyline pts sty ->+ let stroke = maybe "#000000" colorHex (styleStroke sty)+ pairs = [(px, py) | Point px py <- pts]+ in svgPolyline pairs stroke (styleStrokeWidth sty)+ MPolygon pts sty ->+ let fill = maybe "none" colorHex (styleFill sty)+ pairs = [(px, py) | Point px py <- pts]+ ptsStr = T.intercalate " " [showD px <> "," <> showD py | (px, py) <- pairs]+ in "<polygon"+ <> attr "points" ptsStr+ <> attr "fill" fill+ <> strokeAttrs sty+ <> opacityAttr sty+ <> "/>\n"+ MAxisLine (Point x1 y1) (Point x2 y2) sty ->+ let stroke = maybe "#000000" colorHex (styleStroke sty)+ in svgLine x1 y1 x2 y2 stroke (styleStrokeWidth sty)+ MPath d sty ->+ let fill = maybe "none" colorHex (styleFill sty)+ in svgPath d fill (strokeAttrs sty)+ MArc (Point cx cy) r a0 a1 sty ->+ let x0 = cx + r * cos a0+ y0 = cy + r * sin a0+ x1 = cx + r * cos a1+ y1 = cy + r * sin a1+ largeArc = if a1 - a0 > pi then "1" else "0"+ d =+ "M "+ <> showD cx+ <> " "+ <> showD cy+ <> " L "+ <> showD x0+ <> " "+ <> showD y0+ <> " A "+ <> showD r+ <> " "+ <> showD r+ <> " 0 "+ <> largeArc+ <> " 0 "+ <> showD x1+ <> " "+ <> showD y1+ <> " Z"+ fill = maybe "none" colorHex (styleFill sty)+ in svgPath d fill (strokeAttrs sty)+ MGroup ms ->+ "<g>" <> T.concat (map renderMark ms) <> "</g>\n"++anchorText :: TextAnchor -> Text+anchorText AnchorStart = "start"+anchorText AnchorMiddle = "middle"+anchorText AnchorEnd = "end"++strokeAttrs :: Style -> Text+strokeAttrs sty =+ case styleStroke sty of+ Nothing -> ""+ Just c ->+ attr "stroke" (colorHex c) <> attr "stroke-width" (showD (styleStrokeWidth sty))++opacityAttr :: Style -> Text+opacityAttr sty+ | styleFillOpacity sty < 1 = attr "fill-opacity" (showD (styleFillOpacity sty))+ | otherwise = ""
+ src/Granite/Render/Terminal.hs view
@@ -0,0 +1,450 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Render.Terminal+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Terminal backend.+-}+module Granite.Render.Terminal (+ renderScene,+ Canvas (..),+ Array2D,+ newCanvas,+ setDotC,+ fillDotsC,+ lineDotsC,+ renderCanvas,+ toBit,+ getA2D,+ setA2D,+ newA2D,+) where++import Data.Bits ((.|.))+import Data.Char (chr)+import Data.List qualified as List+import Data.Text (Text)+import Data.Text qualified as Text++import Granite.Color (Color, ansiOff, ansiOn, paint)+import Granite.Internal.Util (setAt, updateAt)+import Granite.Render.Scene (+ Mark (..),+ Point (..),+ Rect (..),+ Scene (..),+ Style (..),+ TextAnchor (..),+ TextStyle (..),+ pxPerChar,+ pxPerLine,+ )++renderScene :: Scene -> Text+renderScene scene =+ let wChars = max 1 (ceiling (sceneWidth scene / pxPerChar))+ hChars = max 1 (ceiling (sceneHeight scene / pxPerLine))+ grid0 = replicate hChars (replicate wChars (' ', Nothing :: Maybe Color))+ canvas0 = newCanvas wChars hChars+ (grid1, canvas1) = List.foldl' (drawMark wChars hChars) (grid0, canvas0) (sceneMarks scene)+ grid2 = mergeCanvas grid1 canvas1+ in Text.unlines (map renderRuns grid2)++mergeCanvas :: [[(Char, Maybe Color)]] -> Canvas -> [[(Char, Maybe Color)]]+mergeCanvas grid canvas =+ [ zipWith merge row [0 :: Int ..]+ | (y, row) <- zip [0 :: Int ..] grid+ , let merge (ch, mc) x =+ case (ch, mc) of+ (' ', Nothing) ->+ let bits = getA2D (buffer canvas) x y+ col = getA2D (cbuf canvas) x y+ glyph = if bits == 0 then ' ' else chr (0x2800 + bits)+ in (glyph, col)+ _ -> (ch, mc)+ ]++drawMark ::+ Int ->+ Int ->+ ([[(Char, Maybe Color)]], Canvas) ->+ Mark ->+ ([[(Char, Maybe Color)]], Canvas)+drawMark wChars hChars (grid, canvas) mark = case mark of+ MRect (Rect x y w h) sty ->+ let col = styleFill sty+ cx0 = clampInt 0 (wChars - 1) (floor (x / pxPerChar))+ cy0 = clampInt 0 (hChars - 1) (floor (y / pxPerLine))+ cx1 = clampInt 0 (wChars - 1) (floor ((x + w - 1) / pxPerChar))+ cy1 = clampInt 0 (hChars - 1) (floor ((y + h - 1) / pxPerLine))+ grid' =+ List.foldl'+ ( \g cy ->+ List.foldl'+ (\g' cx -> setCell g' cx cy ('█', col))+ g+ [cx0 .. cx1]+ )+ grid+ [cy0 .. cy1]+ in (grid', canvas)+ MText (Point x y) txt ts ->+ let cy = clampInt 0 (hChars - 1) (floor (y / pxPerLine))+ width = Text.length txt+ startCol = case textAnchor ts of+ AnchorStart -> floor (x / pxPerChar)+ AnchorMiddle -> floor (x / pxPerChar) - width `div` 2+ AnchorEnd -> floor (x / pxPerChar) - width+ grid' = placeChars grid wChars cy startCol (Text.unpack txt) (textFill ts)+ in (grid', canvas)+ MCircle (Point x y) r sty ->+ let col = styleFill sty+ xDotC = round (x * 2 / pxPerChar)+ yDotC = round (y * 4 / pxPerLine)+ rDotX = max 1 (round (r * 2 / pxPerChar))+ rDotY = max 1 (round (r * 4 / pxPerLine))+ canvas' =+ fillDotsC+ (xDotC - rDotX, yDotC - rDotY)+ (xDotC + rDotX, yDotC + rDotY)+ ( \dx dy ->+ let ddx = fromIntegral (dx - xDotC) / fromIntegral rDotX :: Double+ ddy = fromIntegral (dy - yDotC) / fromIntegral rDotY :: Double+ in ddx * ddx + ddy * ddy <= 1+ )+ col+ canvas+ in (grid, canvas')+ MPolyline pts sty ->+ let col = styleFill sty+ toDot (Point x y) =+ ( round (x * 2 / pxPerChar)+ , round (y * 4 / pxPerLine)+ )+ dots = map toDot pts+ pairs = zip dots (drop 1 dots)+ canvas' =+ List.foldl'+ (\c ((x0, y0), (x1, y1)) -> lineDotsC (x0, y0) (x1, y1) col c)+ canvas+ pairs+ in (grid, canvas')+ MPolygon pts sty ->+ let stroke = case styleStroke sty of+ Just c -> Just c+ Nothing -> styleFill sty+ outline =+ if null pts+ then pts+ else pts <> [head pts]+ in drawMark+ wChars+ hChars+ (grid, canvas)+ (MPolyline outline sty{styleStroke = stroke})+ MAxisLine (Point x1 y1) (Point x2 y2) sty ->+ let col = styleStroke sty+ grid' = drawAxisLine wChars hChars x1 y1 x2 y2 col grid+ in (grid', canvas)+ MArc (Point cx cy) r a0 a1 sty ->+ let nSeg = 32 :: Int+ ang i = a0 + (a1 - a0) * fromIntegral i / fromIntegral nSeg+ pts =+ [ Point (cx + r * cos (ang i)) (cy + r * sin (ang i))+ | i <- [0 .. nSeg]+ ]+ in drawMark wChars hChars (grid, canvas) (MPolyline pts sty)+ MPath _ _ -> (grid, canvas)+ MGroup ms ->+ List.foldl' (drawMark wChars hChars) (grid, canvas) ms++placeChars ::+ [[(Char, Maybe Color)]] ->+ Int ->+ Int ->+ Int ->+ String ->+ Color ->+ [[(Char, Maybe Color)]]+placeChars grid wChars cy startCol s col+ | cy < 0 || cy >= length grid = grid+ | otherwise =+ let row0 = grid !! cy+ row' = applyChars row0 wChars startCol s+ in setAt grid cy row'+ where+ applyChars row _ _ [] = row+ applyChars row w c (ch : rest)+ | c < 0 || c >= w = applyChars row w (c + 1) rest+ | otherwise =+ let row' = setAt row c (ch, Just col)+ in applyChars row' w (c + 1) rest++setCell ::+ [[(Char, Maybe Color)]] ->+ Int ->+ Int ->+ (Char, Maybe Color) ->+ [[(Char, Maybe Color)]]+setCell grid cx cy cell =+ updateAt grid cy (\row -> setAt row cx cell)++clampInt :: Int -> Int -> Int -> Int+clampInt low high x = max low (min high x)++drawAxisLine ::+ Int ->+ Int ->+ Double ->+ Double ->+ Double ->+ Double ->+ Maybe Color ->+ [[(Char, Maybe Color)]] ->+ [[(Char, Maybe Color)]]+drawAxisLine wChars hChars x1 y1 x2 y2 col grid+ | abs (y2 - y1) < 1e-6 =+ let cy = clampInt 0 (hChars - 1) (floor (y1 / pxPerLine))+ cxL = clampInt 0 (wChars - 1) (floor (min x1 x2 / pxPerChar))+ cxR = clampInt 0 (wChars - 1) (floor (max x1 x2 / pxPerChar))+ in List.foldl' (\g cx -> writeAxisCell g cx cy '─' col) grid [cxL .. cxR]+ | abs (x2 - x1) < 1e-6 =+ let cx = clampInt 0 (wChars - 1) (floor (x1 / pxPerChar))+ cyT = clampInt 0 (hChars - 1) (floor (min y1 y2 / pxPerLine))+ cyB = clampInt 0 (hChars - 1) (floor (max y1 y2 / pxPerLine))+ in List.foldl' (\g cy -> writeAxisCell g cx cy '│' col) grid [cyT .. cyB]+ | otherwise = grid++writeAxisCell ::+ [[(Char, Maybe Color)]] ->+ Int ->+ Int ->+ Char ->+ Maybe Color ->+ [[(Char, Maybe Color)]]+writeAxisCell grid cx cy ch col =+ let existing = case grid `atRow` cy >>= (`atCol` cx) of+ Just (c, _) -> c+ Nothing -> ' '+ finalCh = combineAxis existing ch+ in setCell grid cx cy (finalCh, col)+ where+ atRow rs i+ | i < 0 || i >= length rs = Nothing+ | otherwise = Just (rs !! i)+ atCol cs i+ | i < 0 || i >= length cs = Nothing+ | otherwise = Just (cs !! i)++combineAxis :: Char -> Char -> Char+combineAxis existing new+ | existing == '│' && new == '─' = '┼'+ | existing == '─' && new == '│' = '┼'+ | existing == '┼' = '┼'+ | otherwise = new++renderRuns :: [(Char, Maybe Color)] -> Text+renderRuns = go+ where+ go [] = Text.empty+ go xs@((_, Nothing) : _) =+ let (plain, rest) = span (\(_, mc) -> case mc of Nothing -> True; _ -> False) xs+ in Text.pack (map fst plain) <> go rest+ go ((ch, Just c) : rest) =+ let (run, after) =+ span (\(_, mc) -> mc == Just c || isNothing mc) rest+ chunk = ch : map fst run+ in if all (== ' ') chunk+ then Text.pack chunk <> go after+ else ansiOn c <> Text.pack chunk <> ansiOff <> go after++data Array2D a = A2D Int Int (Arr a)++getA2D :: Array2D a -> Int -> Int -> a+getA2D (A2D w _ xs) x y = indexA xs (y * w + x)++setA2D :: Array2D a -> Int -> Int -> a -> Array2D a+setA2D (A2D w h xs) x y v =+ let i = y * w + x+ in A2D w h (setArr xs i v)++newA2D :: Int -> Int -> a -> Array2D a+newA2D w h v = A2D w h (fromList (replicate (w * h) v))++toBit :: Int -> Int -> Int+toBit ry rx = case (ry, rx) of+ (0, 0) -> 1+ (1, 0) -> 2+ (2, 0) -> 4+ (3, 0) -> 64+ (0, 1) -> 8+ (1, 1) -> 16+ (2, 1) -> 32+ (3, 1) -> 128+ _ -> 0++data Canvas = Canvas+ { cW :: Int+ , cH :: Int+ , buffer :: Array2D Int+ , cbuf :: Array2D (Maybe Color)+ }++newCanvas :: Int -> Int -> Canvas+newCanvas w h = Canvas w h (newA2D w h 0) (newA2D w h Nothing)++setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas+setDotC c xDot yDot mcol+ | xDot < 0 || yDot < 0 || xDot >= cW c * 2 || yDot >= cH c * 4 = c+ | otherwise =+ let (cx, rx) = xDot `divMod` 2+ (cy, ry) = yDot `divMod` 4+ b = toBit ry rx+ m = getA2D (buffer c) cx cy+ c' = c{buffer = setA2D (buffer c) cx cy (m .|. b)}+ in case mcol of+ Nothing -> c'+ Just col -> c'{cbuf = setA2D (cbuf c) cx cy (Just col)}++fillDotsC ::+ (Int, Int) ->+ (Int, Int) ->+ (Int -> Int -> Bool) ->+ Maybe Color ->+ Canvas ->+ Canvas+fillDotsC (x0, y0) (x1, y1) p mcol c0 =+ let xs = [max 0 x0 .. min (cW c0 * 2 - 1) x1]+ ys = [max 0 y0 .. min (cH c0 * 4 - 1) y1]+ in List.foldl'+ (\c y -> List.foldl' (\c' x -> if p x y then setDotC c' x y mcol else c') c xs)+ c0+ ys++lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas+lineDotsC (x0, y0) (x1, y1) mcol c0 =+ let dx = abs (x1 - x0)+ sx = if x0 < x1 then 1 else -1+ dy = negate (abs (y1 - y0))+ sy = if y0 < y1 then 1 else -1+ go x y err c+ | x == x1 && y == y1 = setDotC c x y mcol+ | otherwise =+ let e2 = 2 * err+ (x', err') = if e2 >= dy then (x + sx, err + dy) else (x, err)+ (y', err'') = if e2 <= dx then (y + sy, err' + dx) else (y, err')+ in go x' y' err'' (setDotC c x y mcol)+ in go x0 y0 (dx + dy) c0++renderCanvas :: Canvas -> Text+renderCanvas (Canvas w h a colA) =+ let glyph 0 = ' '+ glyph m = chr (0x2800 + m)+ rows =+ fmap+ ( \y -> flip fmap [0 .. w - 1] $ \x ->+ let m = getA2D a x y+ ch = glyph m+ mc = getA2D colA x y+ in maybe (Text.singleton ch) (`paint` ch) mc+ )+ [0 .. h - 1]+ in Text.unlines (fmap Text.concat rows)++data Arr a+ = E+ | N Int Int (Arr a) a (Arr a)++sizeA :: Arr a -> Int+sizeA E = 0+sizeA (N sz _ _ _ _) = sz++heightA :: Arr a -> Int+heightA E = 0+heightA (N _ h _ _ _) = h++mk :: Arr a -> a -> Arr a -> Arr a+mk l x r = N sz h l x r+ where+ sl = sizeA l+ sr = sizeA r+ hl = heightA l+ hr = heightA r+ sz = 1 + sl + sr+ h = 1 + max hl hr++rotateL :: Arr a -> Arr a+rotateL (N _ _ l x (N _ _ rl y rr)) = mk (mk l x rl) y rr+rotateL _ = error "rotateL: malformed tree"++rotateR :: Arr a -> Arr a+rotateR (N _ _ (N _ _ ll y lr) x r) = mk ll y (mk lr x r)+rotateR _ = error "rotateR: malformed tree"++balance :: Arr a -> Arr a+balance t@(N _ _ l x r)+ | heightA l > heightA r + 1 =+ case l of+ N _ _ ll _ lr ->+ if heightA ll >= heightA lr+ then rotateR t+ else rotateR (mk (rotateL l) x r)+ _ -> t+ | heightA r > heightA l + 1 =+ case r of+ N _ _ rl _ rr ->+ if heightA rr >= heightA rl+ then rotateL t+ else rotateL (mk l x (rotateR r))+ _ -> t+ | otherwise = mk l x r+balance t = t++indexA :: Arr a -> Int -> a+indexA t i =+ case t of+ E -> error ("index out of bounds: " <> show i)+ N _ _ l x r ->+ let sl = sizeA l+ in if i < 0 || i >= 1 + sl + sizeA r+ then error ("index out of bounds: " <> show i)+ else+ if i < sl+ then indexA l i+ else+ if i == sl+ then x+ else indexA r (i - sl - 1)++setArr :: Arr a -> Int -> a -> Arr a+setArr t i y =+ case t of+ E -> error ("index out of bounds when setting: " <> show i)+ N _ _ l x r ->+ let sl = sizeA l+ in if i < 0 || i >= 1 + sl + sizeA r+ then error ("index out of bounds: " <> show i)+ else+ if i < sl+ then balance (mk (setArr l i y) x r)+ else+ if i == sl+ then mk l y r+ else balance (mk l x (setArr r (i - sl - 1) y))++fromList :: [a] -> Arr a+fromList xs = fst (build (length xs) xs)+ where+ build :: Int -> [a] -> (Arr a, [a])+ build 0 ys = (E, ys)+ build n ys =+ let (l, ys1) = build (n `div` 2) ys+ (x, ys2) = case ys1 of+ [] -> error "IMPOSSIBLE"+ (v : vs) -> (v, vs)+ (r, ys3) = build (n - n `div` 2 - 1) ys2+ in (mk l x r, ys3)
+ src/Granite/Scale.hs view
@@ -0,0 +1,223 @@++{-# LANGUAGE Strict #-}++{- |+Module : Granite.Scale+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Scale training: turn a declarative 'Scale' into a 'TrainedScale' that+projects data values onto [0,1] and generates round-number ticks.+-}+module Granite.Scale (+ TrainedScale (..),+ train,+ niceTicks,+ niceNum,+) where++import Data.Text (Text)++import Granite.Format (Formatter (..), runFormatter)+import Granite.Internal.Util (eps)+import Granite.Spec (+ BreaksSpec (..),+ Expand (..),+ LogBase (..),+ Scale (..),+ ScaleOpts (..),+ )++data TrainedScale = TrainedScale+ { tsDomain :: !(Double, Double)+ , tsProject :: !(Double -> Double)+ , tsUnproject :: !(Double -> Double)+ , tsBreaks :: ![Double]+ , tsLabels :: ![Text]+ }++train :: Scale -> (Double, Double) -> TrainedScale+train scale dataRange = case scale of+ SLinear opts -> trainLinear opts dataRange+ SLog base opts -> trainLog base opts dataRange+ SSqrt opts -> trainSqrt opts dataRange+ SIdentity -> trainIdentity dataRange+ SReverse inner -> reverseScale (train inner dataRange)+ SDiscrete -> trainLinear (defaultOpts BreaksNice) dataRange+ SColorContinuous _ -> trainLinear (defaultOpts BreaksNice) dataRange+ SColorDiscrete _ -> trainLinear (defaultOpts BreaksNice) dataRange++defaultOpts :: BreaksSpec -> ScaleOpts+defaultOpts brk =+ ScaleOpts+ { scaleDomain = Nothing+ , scaleBreaks = brk+ , scaleLabels = FormatDefault+ , scaleExpand = Expand 0.05 0+ , scaleClip = False+ }++trainLinear :: ScaleOpts -> (Double, Double) -> TrainedScale+trainLinear opts dataRange =+ let (lo, hi) = expandRange (scaleExpand opts) (overrideRange (scaleDomain opts) dataRange)+ span_ = hi - lo + eps+ project v = (v - lo) / span_+ unproject t = lo + t * span_+ breaks = chooseBreaks (scaleBreaks opts) (lo, hi)+ labels = map (runFormatter (scaleLabels opts)) breaks+ in TrainedScale (lo, hi) project unproject breaks labels++{- | Log scales need a strictly positive domain. When the data range+contains zero or negatives we fall back to a window 3 decades below+the data max (or [1, 10] if neither bound is positive).+-}+trainLog :: LogBase -> ScaleOpts -> (Double, Double) -> TrainedScale+trainLog base opts (dlo, dhi) =+ let safeLo+ | dlo > 0 = dlo+ | dhi > 0 = dhi / 1000+ | otherwise = 1+ safeHi+ | dhi > safeLo = dhi+ | otherwise = safeLo * 10+ (lo, hi) =+ expandLog (scaleExpand opts) (overrideRange (scaleDomain opts) (safeLo, safeHi))+ b = logBaseConst base+ ll = logBase b lo+ lh = logBase b hi+ span_ = lh - ll + eps+ project v = (logBase b (max safeLo v) - ll) / span_+ unproject t = b ** (ll + t * span_)+ breaks = case scaleBreaks opts of+ BreaksAt xs -> xs+ BreaksCount n -> sampleLogBreaks b lo hi n+ BreaksNice -> integerPowers b lo hi+ labels = map (runFormatter (scaleLabels opts)) breaks+ in TrainedScale (lo, hi) project unproject breaks labels++logBaseConst :: LogBase -> Double+logBaseConst Base2 = 2+logBaseConst BaseE = exp 1+logBaseConst Base10 = 10++integerPowers :: Double -> Double -> Double -> [Double]+integerPowers b lo hi =+ let kLo = floor (logBase b lo) :: Int+ kHi = ceiling (logBase b hi) :: Int+ n = kHi - kLo + 1+ maxTicks = 10+ in if n <= maxTicks+ then [b ** fromIntegral k | k <- [kLo .. kHi]]+ else+ let stride = (n + maxTicks - 1) `div` maxTicks+ in [b ** fromIntegral k | k <- [kLo, kLo + stride .. kHi]]++sampleLogBreaks :: Double -> Double -> Double -> Int -> [Double]+sampleLogBreaks b lo hi n+ | n < 2 = [lo, hi]+ | otherwise =+ let ll = logBase b lo+ lh = logBase b hi+ step = (lh - ll) / fromIntegral (n - 1)+ in [b ** (ll + step * fromIntegral i) | i <- [0 .. n - 1]]++trainSqrt :: ScaleOpts -> (Double, Double) -> TrainedScale+trainSqrt opts dataRange =+ let (lo0, hi0) = overrideRange (scaleDomain opts) dataRange+ lo = max 0 lo0+ hi = max lo hi0+ (lo', hi') = expandRange (scaleExpand opts) (lo, hi)+ sLo = sqrt (max 0 lo')+ sHi = sqrt (max sLo hi')+ span_ = sHi - sLo + eps+ project v = (sqrt (max 0 v) - sLo) / span_+ unproject t =+ let s = sLo + t * span_+ in s * s+ breaks = chooseBreaks (scaleBreaks opts) (lo', hi')+ labels = map (runFormatter (scaleLabels opts)) breaks+ in TrainedScale (lo', hi') project unproject breaks labels++trainIdentity :: (Double, Double) -> TrainedScale+trainIdentity (lo, hi) =+ let breaks = chooseBreaks BreaksNice (lo, hi)+ labels = map (runFormatter FormatDefault) breaks+ in TrainedScale+ { tsDomain = (lo, hi)+ , tsProject = id+ , tsUnproject = id+ , tsBreaks = breaks+ , tsLabels = labels+ }++reverseScale :: TrainedScale -> TrainedScale+reverseScale ts =+ ts+ { tsProject = \v -> 1 - tsProject ts v+ , tsUnproject = tsUnproject ts . (1 -)+ }++overrideRange :: Maybe (Double, Double) -> (Double, Double) -> (Double, Double)+overrideRange Nothing r = r+overrideRange (Just (a, b)) _ = (a, b)++expandRange :: Expand -> (Double, Double) -> (Double, Double)+expandRange (Expand m a) (lo, hi) =+ let pad = (hi - lo) * m + a+ in (lo - pad, hi + pad)++expandLog :: Expand -> (Double, Double) -> (Double, Double)+expandLog (Expand m _) (lo, hi)+ | m <= 0 = (lo, hi)+ | otherwise =+ let factor = (hi / lo) ** m+ in (lo / factor, hi * factor)++chooseBreaks :: BreaksSpec -> (Double, Double) -> [Double]+chooseBreaks brk (lo, hi) = case brk of+ BreaksAt xs -> xs+ BreaksCount n -> niceTicks (lo, hi) n+ BreaksNice -> niceTicks (lo, hi) 5++{- | Heckbert "loose label" tick selection. Round-number positions in+@{1, 2, 2.5, 5} × 10^k@ that bracket the data range.+-}+niceTicks :: (Double, Double) -> Int -> [Double]+niceTicks (lo, hi) target0+ | not (isValid lo && isValid hi) || lo == hi = [lo]+ | lo > hi = niceTicks (hi, lo) target0+ | otherwise =+ let target = max 2 target0+ range = niceNum (hi - lo) False+ step = niceNum (range / fromIntegral (target - 1)) True+ gMin = (fromIntegral :: Int -> Double) (floor (lo / step)) * step+ gMax = (fromIntegral :: Int -> Double) (ceiling (hi / step)) * step+ n = round ((gMax - gMin) / step) + 1+ in [gMin + step * fromIntegral i | i <- [0 .. n - 1]]+ where+ isValid x = not (isNaN x || isInfinite x)++niceNum :: Double -> Bool -> Double+niceNum 0 _ = 1+niceNum x roundIt =+ let absX = abs x+ sign = if x < 0 then (-1) else 1+ exp10 = floor (logBase 10 absX) :: Int+ f = absX / (10 ** fromIntegral exp10)+ nf+ | roundIt =+ if f < 1.5+ then 1+ else+ if f < 3+ then 2+ else+ if f < 7+ then 5+ else 10+ | f <= 1 = 1+ | f <= 2 = 2+ | f <= 5 = 5+ | otherwise = 10+ in sign * nf * (10 ** fromIntegral exp10)
+ src/Granite/Spec.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Spec+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Declarative Grammar-of-Graphics chart IR: data + layers + scales ++coord + facet + theme + size.+-}+module Granite.Spec (+ Chart (..),+ emptyChart,+ module Granite.Data.Frame,+ module Granite.Format,+ ColumnRef (..),+ Mapping (..),+ emptyMapping,+ AesDefaults (..),+ emptyAesDefaults,+ ColorSpec (..),+ Layer (..),+ defLayer,+ Geom (..),+ Stat (..),+ BinSpec (..),+ SmoothMethod (..),+ SummaryFun (..),+ Position (..),+ Scale (..),+ ScaleOpts (..),+ defScaleOpts,+ LogBase (..),+ BreaksSpec (..),+ Expand (..),+ Scales (..),+ defScales,+ Coord (..),+ PolarAes (..),+ PolarDir (..),+ Facet (..),+ FacetScales (..),+ Theme (..),+ defTheme,+ Size (..),+) where++import Data.Text (Text)+import Data.Word (Word8)++import Granite.Color (Color (..))+import Granite.Data.Frame+import Granite.Format++newtype ColumnRef = ColumnRef Text+ deriving (Eq, Show, Read)++data Mapping = Mapping+ { aesX :: Maybe ColumnRef+ , aesY :: Maybe ColumnRef+ , aesColor :: Maybe ColumnRef+ , aesFill :: Maybe ColumnRef+ , aesSize :: Maybe ColumnRef+ , aesAlpha :: Maybe ColumnRef+ , aesGroup :: Maybe ColumnRef+ , aesYmin :: Maybe ColumnRef+ , aesYmax :: Maybe ColumnRef+ , aesLabel :: Maybe ColumnRef+ }+ deriving (Eq, Show, Read)++emptyMapping :: Mapping+emptyMapping =+ Mapping+ { aesX = Nothing+ , aesY = Nothing+ , aesColor = Nothing+ , aesFill = Nothing+ , aesSize = Nothing+ , aesAlpha = Nothing+ , aesGroup = Nothing+ , aesYmin = Nothing+ , aesYmax = Nothing+ , aesLabel = Nothing+ }++data AesDefaults = AesDefaults+ { defColor :: Maybe ColorSpec+ , defFill :: Maybe ColorSpec+ , defSize :: Maybe Double+ , defAlpha :: Maybe Double+ , defLineWidth :: Maybe Double+ , defLineDash :: Maybe [Double]+ }+ deriving (Eq, Show, Read)++emptyAesDefaults :: AesDefaults+emptyAesDefaults =+ AesDefaults+ { defColor = Nothing+ , defFill = Nothing+ , defSize = Nothing+ , defAlpha = Nothing+ , defLineWidth = Nothing+ , defLineDash = Nothing+ }++data ColorSpec+ = NamedColor Color+ | RGB Word8 Word8 Word8+ | Hex Text+ deriving (Eq, Show, Read)++data Layer = Layer+ { layerData :: Maybe DataFrame+ , layerMapping :: Mapping+ , layerGeom :: Geom+ , layerStat :: Stat+ , layerPosition :: Position+ , layerAesDef :: AesDefaults+ }+ deriving (Eq, Show, Read)++defLayer :: Geom -> Layer+defLayer g =+ Layer+ { layerData = Nothing+ , layerMapping = emptyMapping+ , layerGeom = g+ , layerStat = defaultStat g+ , layerPosition = PosIdentity+ , layerAesDef = emptyAesDefaults+ }++defaultStat :: Geom -> Stat+defaultStat g = case g of+ GeomBar -> StatCount+ GeomBoxplot -> StatBoxplot+ GeomDensity -> StatDensity+ GeomHistogram -> StatBin (BinByCount 30)+ _ -> StatIdentity++data Geom+ = GeomPoint+ | GeomLine+ | GeomBar+ | GeomCol+ | GeomRibbon+ | GeomErrorbar+ | GeomTile+ | GeomBoxplot+ | GeomDensity+ | GeomHistogram+ | GeomText+ | GeomArc+ deriving (Eq, Show, Read)++data Stat+ = StatIdentity+ | StatBin BinSpec+ | StatDensity+ | StatSmooth SmoothMethod+ | StatBoxplot+ | StatCount+ | StatSummary SummaryFun+ deriving (Eq, Show, Read)++data BinSpec+ = BinByCount Int+ | BinByWidth Double+ | BinByEdges [Double]+ deriving (Eq, Show, Read)++data SmoothMethod+ = SmoothLm+ | SmoothLoess Double+ | SmoothMovingAvg Int+ deriving (Eq, Show, Read)++data SummaryFun+ = SumMean+ | SumMedian+ | SumQuantile Double+ | SumSum+ deriving (Eq, Show, Read)++data Position+ = PosIdentity+ | PosStack+ | PosDodge Double+ | PosJitter Double Double+ | PosFill+ deriving (Eq, Show, Read)++data LogBase = Base2 | BaseE | Base10+ deriving (Eq, Show, Read)++data Expand = Expand+ { expandMult :: Double+ , expandAdd :: Double+ }+ deriving (Eq, Show, Read)++data BreaksSpec+ = BreaksNice+ | BreaksCount Int+ | BreaksAt [Double]+ deriving (Eq, Show, Read)++data ScaleOpts = ScaleOpts+ { scaleDomain :: Maybe (Double, Double)+ , scaleBreaks :: BreaksSpec+ , scaleLabels :: Formatter+ , scaleExpand :: Expand+ , scaleClip :: Bool+ }+ deriving (Eq, Show, Read)++defScaleOpts :: ScaleOpts+defScaleOpts =+ ScaleOpts+ { scaleDomain = Nothing+ , scaleBreaks = BreaksNice+ , scaleLabels = FormatDefault+ , scaleExpand = Expand 0.05 0+ , scaleClip = False+ }++data Scale+ = SLinear ScaleOpts+ | SLog LogBase ScaleOpts+ | SSqrt ScaleOpts+ | SReverse Scale+ | SIdentity+ | SDiscrete+ | SColorContinuous [ColorSpec]+ | SColorDiscrete [ColorSpec]+ deriving (Eq, Show, Read)++data Scales = Scales+ { scaleX :: Scale+ , scaleY :: Scale+ , scaleColor :: Maybe Scale+ , scaleFill :: Maybe Scale+ , scaleSize :: Maybe Scale+ }+ deriving (Eq, Show, Read)++defScales :: Scales+defScales =+ Scales+ { scaleX = SLinear defScaleOpts+ , scaleY = SLinear defScaleOpts+ , scaleColor = Nothing+ , scaleFill = Nothing+ , scaleSize = Nothing+ }++data PolarAes = ThetaX | ThetaY+ deriving (Eq, Show, Read)++data PolarDir = PolarCW | PolarCCW+ deriving (Eq, Show, Read)++data Coord+ = CoordCartesian+ | CoordFlip+ | CoordPolar PolarAes Double PolarDir+ deriving (Eq, Show, Read)++data FacetScales+ = ScalesFixed+ | ScalesFreeX+ | ScalesFreeY+ | ScalesFree+ deriving (Eq, Show, Read)++data Facet+ = FacetNull+ | FacetWrap ColumnRef (Maybe Int) (Maybe Int) FacetScales+ | FacetGrid [ColumnRef] [ColumnRef] FacetScales+ deriving (Eq, Show, Read)++data Theme = Theme+ { themePalette :: [ColorSpec]+ , themePieColors :: [ColorSpec]+ , themeAxisColor :: ColorSpec+ , themeGridColor :: ColorSpec+ , themeTextColor :: ColorSpec+ , themeBackground :: ColorSpec+ , themeFontSize :: Double+ , themeTitleSize :: Double+ , themeStrokeWidth :: Double+ , themePxPerChar :: Double+ , themePxPerLine :: Double+ }+ deriving (Eq, Show, Read)++defTheme :: Theme+defTheme =+ Theme+ { themePalette =+ [ NamedColor BrightBlue+ , NamedColor BrightMagenta+ , NamedColor BrightCyan+ , NamedColor BrightGreen+ , NamedColor BrightYellow+ , NamedColor BrightRed+ , NamedColor BrightWhite+ , NamedColor BrightBlack+ ]+ , themePieColors =+ [ NamedColor BrightRed+ , NamedColor BrightGreen+ , NamedColor BrightYellow+ , NamedColor BrightBlue+ , NamedColor BrightMagenta+ , NamedColor BrightCyan+ , NamedColor BrightWhite+ , NamedColor BrightBlack+ ]+ , themeAxisColor = Hex "#aaaaaa"+ , themeGridColor = Hex "#eeeeee"+ , themeTextColor = Hex "#555555"+ , themeBackground = Hex "#ffffff"+ , themeFontSize = 11+ , themeTitleSize = 14+ , themeStrokeWidth = 1+ , themePxPerChar = 10+ , themePxPerLine = 16+ }++data Size+ = SizeChars Int Int+ | SizePixels Int Int+ | SizeResponsive Double+ deriving (Eq, Show, Read)++data Chart = Chart+ { chartData :: DataFrame+ , chartLayers :: [Layer]+ , chartScales :: Scales+ , chartCoord :: Coord+ , chartFacet :: Facet+ , chartTheme :: Theme+ , chartTitle :: Maybe Text+ , chartSize :: Size+ }+ deriving (Eq, Show, Read)++emptyChart :: Chart+emptyChart =+ Chart+ { chartData = emptyFrame+ , chartLayers = []+ , chartScales = defScales+ , chartCoord = CoordCartesian+ , chartFacet = FacetNull+ , chartTheme = defTheme+ , chartTitle = Nothing+ , chartSize = SizeChars 60 20+ }
+ src/Granite/Stat.hs view
@@ -0,0 +1,390 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}++{- |+Module : Granite.Stat+Copyright : (c) 2025+License : MIT+Maintainer : mschavinda@gmail.com++Statistical transforms ('Stat'). Each runs on a layer's mapped X / Y+columns and returns a new frame, generally with the same column names+holding the transformed values. 'StatBoxplot' additionally writes+@__ymin@ / @__q1@ / @__median@ / @__q3@ / @__ymax@ for the boxplot+geom to read.+-}+module Granite.Stat (+ applyStat,+ binData,+ kdeData,+ smoothLm,+ smoothMovingAvg,+ smoothLoess,+ boxplotSummary,+ BoxStats (..),+ countByCategory,+ summarizeByCategory,+) where++import Data.List qualified as List+import Data.Text (Text)++import Granite.Data.Frame (+ Column (..),+ DataFrame (..),+ columnAsNum,+ columnAsText,+ fromColumns,+ lookupColumn,+ )+import Granite.Spec (+ BinSpec (..),+ ColumnRef (..),+ Mapping (..),+ SmoothMethod (..),+ Stat (..),+ SummaryFun (..),+ )++applyStat :: Stat -> Mapping -> DataFrame -> DataFrame+applyStat stat m df = case stat of+ StatIdentity -> df+ StatBin spec -> runBin spec m df+ StatDensity -> runDensity m df+ StatSmooth method -> runSmooth method m df+ StatBoxplot -> runBoxplot m df+ StatCount -> runCount m df+ StatSummary fn -> runSummary fn m df++runBin :: BinSpec -> Mapping -> DataFrame -> DataFrame+runBin spec m df =+ case resolveNum (aesX m) df of+ Nothing -> df+ Just xs ->+ let (mids, counts) = binData spec xs+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "count"+ in fromColumns+ [ (xName, ColNum mids)+ , (yName, ColNum counts)+ ]++binData :: BinSpec -> [Double] -> ([Double], [Double])+binData _ [] = ([], [])+binData spec xs =+ let lo = minimum xs+ hi = maximum xs+ edges = case spec of+ BinByCount n -> evenEdges n lo hi+ BinByWidth w+ | w <= 0 -> evenEdges 1 lo hi+ | otherwise -> stepEdges w lo hi+ BinByEdges es -> List.sort es+ nBins = max 1 (length edges - 1)+ mids =+ [ (e0 + e1) / 2+ | (e0, e1) <- zip edges (drop 1 edges)+ ]+ counts0 = replicate nBins (0 :: Int)+ counts =+ foldr+ ( \v acc ->+ let ix = which edges v+ in update acc ix+ )+ counts0+ xs+ in (mids, map fromIntegral counts)+ where+ update :: [Int] -> Int -> [Int]+ update cs i+ | i < 0 || i >= length cs = cs+ | otherwise = take i cs ++ [cs !! i + 1] ++ drop (i + 1) cs++ -- Epsilon tolerance so values landing exactly on an internal edge+ -- go to the right-side bin, matching @[lo, hi)@ even after the+ -- rounding error in @lo + step * i@.+ which :: [Double] -> Double -> Int+ which es v+ | length es < 2 = -1+ | v + eps < head es = -1+ | v > last es + eps = -1+ | otherwise = go 0+ where+ eps = 1e-9+ n = length es - 1+ go i+ | i >= n = n - 1+ | v + eps < es !! (i + 1) = i+ | i == n - 1 && v <= es !! (i + 1) + eps = i+ | otherwise = go (i + 1)++evenEdges :: Int -> Double -> Double -> [Double]+evenEdges n lo hi+ | n < 1 = [lo, hi]+ | lo == hi = [lo - 0.5, hi + 0.5]+ | otherwise =+ let step = (hi - lo) / fromIntegral n+ in [lo + step * fromIntegral i | i <- [0 .. n]]++stepEdges :: Double -> Double -> Double -> [Double]+stepEdges w lo hi+ | lo == hi = [lo - w / 2, hi + w / 2]+ | otherwise =+ let n = max 1 (ceiling ((hi - lo) / w))+ in [lo + w * fromIntegral i | i <- [0 .. n]]++runDensity :: Mapping -> DataFrame -> DataFrame+runDensity m df =+ case resolveNum (aesX m) df of+ Nothing -> df+ Just xs ->+ let (gx, gy) = kdeData 128 xs+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "density"+ in fromColumns [(xName, ColNum gx), (yName, ColNum gy)]++-- | Gaussian KDE on @n@ grid points; bandwidth is Silverman's rule.+kdeData :: Int -> [Double] -> ([Double], [Double])+kdeData _ [] = ([], [])+kdeData n xs =+ let nn = length xs+ mu = sum xs / fromIntegral nn+ var = sum [(x - mu) ** 2 | x <- xs] / fromIntegral (max 1 (nn - 1))+ sigma = sqrt (max var 1e-12)+ h = 1.06 * sigma * fromIntegral nn ** (-0.2)+ lo = minimum xs - 3 * h+ hi = maximum xs + 3 * h+ grid = evenSpaced n lo hi+ density g =+ let k v = exp (negate ((g - v) ** 2) / (2 * h * h)) / (h * sqrt (2 * pi))+ in sum (map k xs) / fromIntegral nn+ in (grid, map density grid)++evenSpaced :: Int -> Double -> Double -> [Double]+evenSpaced n lo hi+ | n < 2 = [lo]+ | otherwise =+ let step = (hi - lo) / fromIntegral (n - 1)+ in [lo + step * fromIntegral i | i <- [0 .. n - 1]]++runSmooth :: SmoothMethod -> Mapping -> DataFrame -> DataFrame+runSmooth method m df =+ case ( resolveNum (aesX m) df+ , resolveNum (aesY m) df+ ) of+ (Just xs, Just ys) ->+ let pairs = List.sortOn fst (zip xs ys)+ (sx, sy) = unzip pairs+ fitted = case method of+ SmoothLm -> smoothLm sx sy+ SmoothLoess span_ -> smoothLoess span_ sx sy+ SmoothMovingAvg w -> smoothMovingAvg w sy+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "y"+ in fromColumns [(xName, ColNum sx), (yName, ColNum fitted)]+ _ -> df++-- | OLS regression, evaluated at the input X positions.+smoothLm :: [Double] -> [Double] -> [Double]+smoothLm xs ys+ | length xs < 2 = ys+ | otherwise =+ let n = fromIntegral (length xs) :: Double+ mx = sum xs / n+ my = sum ys / n+ num = sum (zipWith (\x y -> (x - mx) * (y - my)) xs ys)+ den = sum [(x - mx) ** 2 | x <- xs]+ slope = if den == 0 then 0 else num / den+ intercept = my - slope * mx+ in [intercept + slope * x | x <- xs]++{- | Trailing moving average; leading edge is the partial-window mean+so the output length matches the input.+-}+smoothMovingAvg :: Int -> [Double] -> [Double]+smoothMovingAvg w ys+ | w <= 1 = ys+ | otherwise =+ [ let lo = max 0 (i - w + 1)+ window = take (i - lo + 1) (drop lo ys)+ k = fromIntegral (length window) :: Double+ in if k == 0 then 0 else sum window / k+ | i <- [0 .. length ys - 1]+ ]++{- | LOESS-style local linear regression with tricube weights;+@span_@ is the neighbourhood fraction in @(0, 1]@.+-}+smoothLoess :: Double -> [Double] -> [Double] -> [Double]+smoothLoess span_ xs ys+ | length xs < 2 = ys+ | otherwise =+ let n = length xs+ k = max 2 (round (span_ * fromIntegral n))+ in [loessAt xs ys k x | x <- xs]++loessAt :: [Double] -> [Double] -> Int -> Double -> Double+loessAt xs ys k x0 =+ let dists = [(abs (x - x0), x, y) | (x, y) <- zip xs ys]+ nearest = take k (List.sortOn (\(d, _, _) -> d) dists)+ maxD = case nearest of+ [] -> 1+ ds -> maximum [d | (d, _, _) <- ds] + 1e-12+ wts = [tricube (d / maxD) | (d, _, _) <- nearest]+ xv = [x | (_, x, _) <- nearest]+ yv = [y | (_, _, y) <- nearest]+ sw = sum wts+ swx = sum (zipWith (*) wts xv)+ swy = sum (zipWith (*) wts yv)+ swxx = sum (zipWith (\w x -> w * x * x) wts xv)+ swxy = sum (zipWith3 (\w x y -> w * x * y) wts xv yv)+ denom = sw * swxx - swx * swx+ slope = if denom == 0 then 0 else (sw * swxy - swx * swy) / denom+ intercept = if sw == 0 then 0 else (swy - slope * swx) / sw+ in intercept + slope * x0++tricube :: Double -> Double+tricube u+ | abs u >= 1 = 0+ | otherwise = (1 - abs u ** 3) ** 3++runBoxplot :: Mapping -> DataFrame -> DataFrame+runBoxplot m df =+ case resolveNum (aesY m) df of+ Nothing -> df+ Just ys ->+ let groupNames = case aesX m of+ Just (ColumnRef n) -> case lookupColumn n df of+ Just c -> columnAsText c+ Nothing -> replicate (length ys) "all"+ Nothing -> replicate (length ys) "all"+ grouped = groupBy fst (zip groupNames ys)+ summaries =+ [ (name, boxplotSummary [v | (_, v) <- xs])+ | (name, xs) <- grouped+ ]+ xName = refName (aesX m) "group"+ in fromColumns+ [ (xName, ColCat [n | (n, _) <- summaries])+ , ("__ymin", ColNum [yMin s | (_, s) <- summaries])+ , ("__q1", ColNum [q1 s | (_, s) <- summaries])+ , ("__median", ColNum [med s | (_, s) <- summaries])+ , ("__q3", ColNum [q3 s | (_, s) <- summaries])+ , ("__ymax", ColNum [yMax s | (_, s) <- summaries])+ ]++data BoxStats = BoxStats+ { yMin :: !Double+ , q1 :: !Double+ , med :: !Double+ , q3 :: !Double+ , yMax :: !Double+ }+ deriving (Eq, Show)++{- | Five-number summary using Tukey hinges: when @n@ is odd the+median is included in both halves, so @boxplotSummary [1..9]@+gives @(1, 3, 5, 7, 9)@.+-}+boxplotSummary :: [Double] -> BoxStats+boxplotSummary [] = BoxStats 0 0 0 0 0+boxplotSummary xs =+ let sorted = List.sort xs+ n = length sorted+ m =+ if n `mod` 2 == 1+ then sorted !! (n `div` 2)+ else (sorted !! (n `div` 2 - 1) + sorted !! (n `div` 2)) / 2+ half =+ if n `mod` 2 == 1+ then (n `div` 2) + 1+ else n `div` 2+ lower = take half sorted+ upper = drop (n - half) sorted+ qq xs' =+ if null xs'+ then m+ else+ let k = length xs'+ in if k `mod` 2 == 1+ then xs' !! (k `div` 2)+ else (xs' !! (k `div` 2 - 1) + xs' !! (k `div` 2)) / 2+ in BoxStats+ { yMin = head sorted+ , q1 = qq lower+ , med = m+ , q3 = qq upper+ , yMax = last sorted+ }++runCount :: Mapping -> DataFrame -> DataFrame+runCount m df =+ let xs = case aesX m of+ Just (ColumnRef n) -> maybe [] columnAsText (lookupColumn n df)+ Nothing -> []+ counts = countByCategory xs+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "count"+ in fromColumns+ [ (xName, ColCat [k | (k, _) <- counts])+ , (yName, ColNum [fromIntegral v | (_, v) <- counts])+ ]++countByCategory :: [Text] -> [(Text, Int)]+countByCategory xs =+ let uniq = List.nub xs+ in [(u, length [x | x <- xs, x == u]) | u <- uniq]++runSummary :: SummaryFun -> Mapping -> DataFrame -> DataFrame+runSummary fn m df =+ case resolveNum (aesY m) df of+ Nothing -> df+ Just ys ->+ let groupKeys = case aesX m of+ Just (ColumnRef n) -> case lookupColumn n df of+ Just c -> columnAsText c+ Nothing -> replicate (length ys) "all"+ Nothing -> replicate (length ys) "all"+ summaries = summarizeByCategory fn (zip groupKeys ys)+ xName = refName (aesX m) "x"+ yName = refName (aesY m) "y"+ in fromColumns+ [ (xName, ColCat [k | (k, _) <- summaries])+ , (yName, ColNum [v | (_, v) <- summaries])+ ]++summarizeByCategory :: SummaryFun -> [(Text, Double)] -> [(Text, Double)]+summarizeByCategory fn pairs =+ let grouped = groupBy fst pairs+ in [(name, applyFn fn (map snd vs)) | (name, vs) <- grouped]+ where+ applyFn SumMean xs = if null xs then 0 else sum xs / fromIntegral (length xs)+ applyFn SumSum xs = sum xs+ applyFn SumMedian xs =+ let s = List.sort xs+ n = length s+ in if n == 0+ then 0+ else+ if n `mod` 2 == 1+ then s !! (n `div` 2)+ else (s !! (n `div` 2 - 1) + s !! (n `div` 2)) / 2+ applyFn (SumQuantile p) xs =+ let s = List.sort xs+ n = length s+ ix = max 0 (min (n - 1) (round (p * fromIntegral (n - 1)) :: Int))+ in if n == 0 then 0 else s !! ix++resolveNum :: Maybe ColumnRef -> DataFrame -> Maybe [Double]+resolveNum Nothing _ = Nothing+resolveNum (Just (ColumnRef n)) df = lookupColumn n df >>= columnAsNum++refName :: Maybe ColumnRef -> Text -> Text+refName (Just (ColumnRef n)) _ = n+refName Nothing fallback = fallback++groupBy :: (Eq k) => (a -> k) -> [a] -> [(k, [a])]+groupBy f xs =+ let keys = List.nub (map f xs)+ in [(k, [x | x <- xs, f x == k]) | k <- keys]
src/Granite/Svg.hs view
@@ -6,27 +6,11 @@ Copyright : (c) 2025 License : MIT Maintainer : mschavinda@gmail.com-Stability : experimental-Portability : POSIX -An SVG-based plotting backend that mirrors the API of "Granite".-Every chart function returns a self-contained SVG document as 'Text'.--= Basic Usage--@-{\-# LANGUAGE OverloadedStrings #-\}-import qualified Data.Text.IO as T-import Granite.Svg--main = do- let chart = bars [(\"Q1\",12),(\"Q2\",18),(\"Q3\",9),(\"Q4\",15)]- defPlot { plotTitle = \"Sales\" }- T.writeFile \"chart.svg\" chart-@+SVG plotting backend that mirrors the API of "Granite". Each chart+function returns a self-contained SVG document as 'Text'. -} module Granite.Svg (- -- * Re-exports from Granite Plot (..), defPlot, LegendPos (..),@@ -36,8 +20,6 @@ Bins (..), bins, series,-- -- * Chart types (SVG output) scatter, lineGraph, bars,@@ -46,10 +28,18 @@ pie, heatmap, boxPlot,+ area,+ ribbon,+ density,+ errorBars,+ funnel,+ polarLine,+ waterfall,+ distPlot, ) where import Data.List qualified as List-import Data.Maybe (fromMaybe, listToMaybe)+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as T import Granite (@@ -63,52 +53,44 @@ defPlot, series, )+import Granite.Color (colorHex)+import Granite.Internal.LegacyChart qualified as LC+import Granite.Internal.Util (+ addAt,+ clamp,+ eps,+ maximum',+ minimum',+ normalize,+ quartiles,+ showD,+ ticks1D,+ )+import Granite.Render.Pipeline (renderChartSvg)+import Granite.Render.Svg (+ attr,+ svgCircle,+ svgDoc,+ svgLine,+ svgPath,+ svgPolyline,+ svgRect,+ svgText,+ ) import Numeric (showFFloat) ---------------------------------------------------------------------------- Scaling constants----------------------------------------------------------------------------- | Pixels per terminal character width. cW :: Double cW = 10 --- | Pixels per terminal character height. cH :: Double cH = 16 --- | Font size for axis labels (px). labelFontSize :: Double labelFontSize = 11 --- | Font size for chart title (px). titleFontSize :: Double titleFontSize = 14 ---------------------------------------------------------------------------- Colour mapping (ANSI → hex)---------------------------------------------------------------------------colorHex :: Color -> Text-colorHex Default = "#555555"-colorHex Black = "#2c3e50"-colorHex Red = "#c0392b"-colorHex Green = "#27ae60"-colorHex Yellow = "#f39c12"-colorHex Blue = "#2980b9"-colorHex Magenta = "#8e44ad"-colorHex Cyan = "#16a085"-colorHex White = "#ecf0f1"-colorHex BrightBlack = "#7f8c8d"-colorHex BrightRed = "#e74c3c"-colorHex BrightGreen = "#2ecc71"-colorHex BrightYellow = "#f1c40f"-colorHex BrightBlue = "#3498db"-colorHex BrightMagenta = "#9b59b6"-colorHex BrightCyan = "#1abc9c"-colorHex BrightWhite = "#bdc3c7"---- Heatmap intensity palette (low → high). heatColors :: [Text] heatColors = [ "#2980b9"@@ -124,22 +106,6 @@ , "#c0392b" ] ---------------------------------------------------------------------------- Helpers copied from Granite (not exported there)---------------------------------------------------------------------------clamp :: (Ord a) => a -> a -> a -> a-clamp lo hi x = max lo (min hi x)--eps :: Double-eps = 1e-12--minimum', maximum' :: [Double] -> Double-minimum' [] = 0-minimum' xs = minimum xs-maximum' [] = 1-maximum' xs = maximum xs- boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double) boundsXY cfg pts = let (xs, ys) = unzip pts@@ -155,68 +121,20 @@ , fromMaybe (ymax + pady) (snd (yBounds cfg)) ) -quartiles :: [Double] -> (Double, Double, Double, Double, Double)-quartiles [] = (0, 0, 0, 0, 0)-quartiles xs =- let sorted = List.sort xs- n = length sorted- q1Idx = n `div` 4- q2Idx = n `div` 2- q3Idx = 3 * n `div` 4- getIdx i = if i < n then sorted !! i else last sorted- in if n < 5- then let m = sum xs / fromIntegral n in (m, m, m, m, m)- else- ( fromMaybe 0 (listToMaybe sorted)- , getIdx q1Idx- , getIdx q2Idx- , getIdx q3Idx- , last sorted- )--normalize :: [(Text, Double)] -> [(Text, Double)]-normalize xs =- let s = sum (map (abs . snd) xs) + 1e-12- in [(n, max 0 (v / s)) | (n, v) <- xs]--ticks1D ::- Int ->- Int ->- (Double, Double) ->- Bool ->- [(Int, Double)]-ticks1D screenLen want (vmin, vmax) invertY =- let n = max 2 want- lastIx = max 0 (screenLen - 1)- toVal t =- if invertY- then vmax - t * (vmax - vmin)- else vmin + t * (vmax - vmin)- mk' k =- let t = if n == 1 then 0 else fromIntegral k / fromIntegral (n - 1)- pos = round (t * fromIntegral lastIx)- in (pos, toVal t)- raw = [mk' k | k <- [0 .. n - 1]]- in List.nubBy (\a b -> fst a == fst b) raw----------------------------------------------------------------------------- Layout record-------------------------------------------------------------------------- data Layout = Layout { svgW :: !Double , svgH :: !Double- , plotX :: !Double -- left edge of plot area- , plotY :: !Double -- top edge of plot area- , plotW :: !Double -- width of plot area- , plotH :: !Double -- height of plot area+ , plotX :: !Double+ , plotY :: !Double+ , plotW :: !Double+ , plotH :: !Double } mkLayout :: Plot -> Layout mkLayout cfg = let pw = fromIntegral (widthChars cfg) * cW ph = fromIntegral (heightChars cfg) * cH- lm = fromIntegral (leftMargin cfg) * cW + 10 -- extra padding+ lm = fromIntegral (leftMargin cfg) * cW + 10 tm = if T.null (plotTitle cfg) then 10@@ -237,103 +155,6 @@ , plotH = ph } ---------------------------------------------------------------------------- SVG primitives---------------------------------------------------------------------------showD :: Double -> Text-showD d- | d == fromIntegral (round d :: Int) = T.pack (show (round d :: Int))- | otherwise = T.pack (showFFloat (Just 2) d "")--escXml :: Text -> Text-escXml =- T.replace "&" "&"- . T.replace "<" "<"- . T.replace ">" ">"- . T.replace "\"" """--attr :: Text -> Text -> Text-attr k v = " " <> k <> "=\"" <> v <> "\""--svgDoc :: Double -> Double -> Text -> Text-svgDoc w h content =- "<svg xmlns=\"http://www.w3.org/2000/svg\""- <> attr "viewBox" ("0 0 " <> showD w <> " " <> showD h)- <> attr "width" (showD w)- <> attr "height" (showD h)- <> attr "font-family" "system-ui, -apple-system, sans-serif"- <> ">\n"- <> "<rect width=\"100%\" height=\"100%\" fill=\"white\"/>\n"- <> content- <> "</svg>\n"--svgRect :: Double -> Double -> Double -> Double -> Text -> Text -> Text-svgRect x y w h fill extra =- "<rect"- <> attr "x" (showD x)- <> attr "y" (showD y)- <> attr "width" (showD w)- <> attr "height" (showD h)- <> attr "fill" fill- <> extra- <> "/>\n"--svgCircle :: Double -> Double -> Double -> Text -> Text-svgCircle cx cy r fill =- "<circle"- <> attr "cx" (showD cx)- <> attr "cy" (showD cy)- <> attr "r" (showD r)- <> attr "fill" fill- <> "/>\n"--svgLine :: Double -> Double -> Double -> Double -> Text -> Double -> Text-svgLine x1 y1 x2 y2 stroke strokeW =- "<line"- <> attr "x1" (showD x1)- <> attr "y1" (showD y1)- <> attr "x2" (showD x2)- <> attr "y2" (showD y2)- <> attr "stroke" stroke- <> attr "stroke-width" (showD strokeW)- <> "/>\n"--svgPolyline :: [(Double, Double)] -> Text -> Double -> Text-svgPolyline pts stroke strokeW =- "<polyline"- <> attr "points" (T.intercalate " " [showD x <> "," <> showD y | (x, y) <- pts])- <> attr "fill" "none"- <> attr "stroke" stroke- <> attr "stroke-width" (showD strokeW)- <> attr "stroke-linejoin" "round"- <> attr "stroke-linecap" "round"- <> "/>\n"--svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text-svgText x y anchor fill size content =- "<text"- <> attr "x" (showD x)- <> attr "y" (showD y)- <> attr "text-anchor" anchor- <> attr "fill" fill- <> attr "font-size" (showD size)- <> ">"- <> escXml content- <> "</text>\n"--svgPath :: Text -> Text -> Text -> Text-svgPath d fill extra =- "<path"- <> attr "d" d- <> attr "fill" fill- <> extra- <> "/>\n"----------------------------------------------------------------------------- Shared drawing: title, axes, legend-------------------------------------------------------------------------- drawTitle :: Plot -> Layout -> Text drawTitle cfg lay | T.null (plotTitle cfg) = ""@@ -353,11 +174,9 @@ pw = plotW lay ph = plotH lay - -- Axis lines xAxis = svgLine px (py + ph) (px + pw) (py + ph) "#aaa" 1 yAxis = svgLine px py px (py + ph) "#aaa" 1 - -- Y ticks yN = yNumTicks cfg yTks = ticks1D (round ph) yN (ymin, ymax) True ySlot = max 1 (leftMargin cfg)@@ -369,11 +188,10 @@ lbl = yFormatter cfg (yEnv i) ySlot v in svgLine px yy (px - 4) yy "#aaa" 1 <> svgText (px - 8) (yy + 4) "end" "#555" labelFontSize lbl- <> svgLine px yy (px + pw) yy "#eee" 0.5 -- grid line+ <> svgLine px yy (px + pw) yy "#eee" 0.5 | (i, (pos, v)) <- zip [0 ..] yTks ] - -- X ticks xN = xNumTicks cfg xTks = ticks1D (round pw) xN (xmin, xmax) False xSlot = max 1 (round pw `div` max 1 xN)@@ -385,7 +203,7 @@ lbl = xFormatter cfg (xEnv i) xSlot v in svgLine xx (py + ph) xx (py + ph + 4) "#aaa" 1 <> svgText xx (py + ph + 16) "middle" "#555" labelFontSize lbl- <> svgLine xx py xx (py + ph) "#eee" 0.5 -- grid line+ <> svgLine xx py xx (py + ph) "#eee" 0.5 | (i, (pos, v)) <- zip [0 ..] xTks ] in xAxis <> yAxis <> yElems <> xElems@@ -400,7 +218,6 @@ xAxis = svgLine px (py + ph) (px + pw) (py + ph) "#aaa" 1 yAxis = svgLine px py px (py + ph) "#aaa" 1 - -- Y ticks (value axis) yN = yNumTicks cfg yTks = ticks1D (round ph) yN (ymin, ymax) True ySlot = max 1 (leftMargin cfg)@@ -416,7 +233,6 @@ | (i, (pos, v)) <- zip [0 ..] yTks ] - -- X category labels n = length catNames catElems = T.concat@@ -459,24 +275,14 @@ (startX, "") entries ---------------------------------------------------------------------------- Coordinate mapping----------------------------------------------------------------------------- | Map data X to SVG X. mapX :: Layout -> Double -> Double -> Double -> Double mapX lay xmin xmax x = plotX lay + (x - xmin) / (xmax - xmin + eps) * plotW lay --- | Map data Y to SVG Y (flipped: higher values → lower Y). mapY :: Layout -> Double -> Double -> Double -> Double mapY lay ymin ymax y = plotY lay + plotH lay - (y - ymin) / (ymax - ymin + eps) * plotH lay ---------------------------------------------------------------------------- SCATTER-------------------------------------------------------------------------- scatter :: [(Text, [(Double, Double)])] -> Plot ->@@ -505,10 +311,6 @@ legend = drawLegend cfg lay [(n, col) | ((n, _), col) <- withCol] in svgDoc (svgW lay) (svgH lay) (title <> axes <> points <> legend) ---------------------------------------------------------------------------- LINE GRAPH-------------------------------------------------------------------------- lineGraph :: [(Text, [(Double, Double)])] -> Plot ->@@ -535,10 +337,6 @@ legend = drawLegend cfg lay [(n, col) | ((n, _), col) <- withCol] in svgDoc (svgW lay) (svgH lay) (title <> axes <> lines' <> legend) ---------------------------------------------------------------------------- BARS-------------------------------------------------------------------------- bars :: [(Text, Double)] -> Plot ->@@ -550,7 +348,7 @@ cols = cycle (colorPalette cfg) n = length kvs - barGap = 0.15 -- 15% gap on each side+ barGap = 0.15 groupW = plotW lay / fromIntegral (max 1 n) rects =@@ -568,10 +366,6 @@ legend = drawLegend cfg lay [(name, col) | ((name, _), col) <- zip kvs cols] in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend) ---------------------------------------------------------------------------- STACKED BARS-------------------------------------------------------------------------- stackedBars :: [(Text, [(Text, Double)])] -> Plot ->@@ -615,10 +409,6 @@ legend = drawLegend cfg lay [(n, col) | (n, col) <- seriesColors] in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend) ---------------------------------------------------------------------------- HISTOGRAM-------------------------------------------------------------------------- histogram :: Bins -> [Double] ->@@ -656,10 +446,6 @@ legend = drawLegend cfg lay [("count", BrightCyan)] in svgDoc (svgW lay) (svgH lay) (title <> axes <> rects <> legend) ---------------------------------------------------------------------------- PIE-------------------------------------------------------------------------- pie :: [(Text, Double)] -> Plot ->@@ -715,10 +501,6 @@ legend = drawLegend cfg lay [(n, col) | (n, _, col) <- withP] in svgDoc (svgW lay) (svgH lay) (title <> slices <> legend) ---------------------------------------------------------------------------- HEATMAP-------------------------------------------------------------------------- heatmap :: [[Double]] -> Plot ->@@ -752,7 +534,7 @@ [ T.concat [ let cx = plotX lay + fromIntegral c * cellW cy = plotY lay + fromIntegral r * cellH- dataRow = rows - 1 - r -- flip: row 0 at bottom+ dataRow = rows - 1 - r v = (matrix !! dataRow) !! c in svgRect cx cy cellW cellH (colorForVal v) "" | c <- [0 .. cols - 1]@@ -760,7 +542,6 @@ | r <- [0 .. rows - 1] ] - -- Axis labels: column indices on x, row indices on y colLabels = T.concat [ svgText@@ -784,7 +565,6 @@ | r <- [0 .. rows - 1] ] - -- Draw border border = svgRect (plotX lay)@@ -796,7 +576,6 @@ title = drawTitle cfg lay - -- Gradient legend gradLegend = let gw = min 200 (plotW lay * 0.5) gh = 12@@ -829,10 +608,6 @@ (svgH lay) (title <> cells <> colLabels <> rowLabels <> border <> gradLegend) ---------------------------------------------------------------------------- BOX PLOT-------------------------------------------------------------------------- boxPlot :: [(Text, [Double])] -> Plot ->@@ -860,11 +635,9 @@ (minV, q1, med, q3, maxV) = qs col = colorHex c - -- Whisker: min to Q1 whiskerBot = svgLine midX (scY minV) midX (scY q1) col 1.5 capBot = svgLine (bx + boxW * 0.25) (scY minV) (bx + boxW * 0.75) (scY minV) col 1.5 - -- Box: Q1 to Q3 boxY = scY q3 boxH = scY q1 - scY q3 box =@@ -880,10 +653,8 @@ <> attr "rx" "2" ) - -- Median line medLine = svgLine bx (scY med) (bx + boxW) (scY med) col 2.5 - -- Whisker: Q3 to max whiskerTop = svgLine midX (scY q3) midX (scY maxV) col 1.5 capTop = svgLine (bx + boxW * 0.25) (scY maxV) (bx + boxW * 0.75) (scY maxV) col 1.5 in whiskerBot <> capBot <> whiskerTop <> capTop <> box <> medLine@@ -896,14 +667,42 @@ legend = drawLegend cfg lay [(name, col) | ((name, _), col) <- zip stats cols] in svgDoc (svgW lay) (svgH lay) (title <> axes <> boxes <> legend) -addAt :: [Int] -> Int -> Int -> [Int]-addAt xs i v = updateAt xs i (+ v)+area :: [(Text, [(Double, Double)])] -> Plot -> Text+area sers cfg =+ renderChartSvg $+ LC.areaChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg) -updateAt :: [a] -> Int -> (a -> a) -> [a]-updateAt xs i f- | i < 0 = xs- | otherwise = go xs i- where- go [] _ = []- go (x : rest) 0 = f x : rest- go (x : rest) n = x : go rest (n - 1)+ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text+ribbon sers cfg =+ renderChartSvg $+ LC.ribbonChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++density :: [(Text, [Double])] -> Plot -> Text+density sers cfg =+ renderChartSvg $+ LC.densityChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text+errorBars sers cfg =+ renderChartSvg $+ LC.errorBarsChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++funnel :: [(Text, Double)] -> Plot -> Text+funnel stages cfg =+ renderChartSvg $+ LC.funnelChart stages (widthChars cfg) (heightChars cfg) (plotTitle cfg)++polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text+polarLine sers cfg =+ renderChartSvg $+ LC.polarLineChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++waterfall :: [(Text, Double, Double)] -> Plot -> Text+waterfall rows cfg =+ renderChartSvg $+ LC.waterfallChart rows (widthChars cfg) (heightChars cfg) (plotTitle cfg)++distPlot :: [(Text, [Double])] -> Plot -> Text+distPlot sers cfg =+ renderChartSvg $+ LC.distPlotChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)
+ test/Golden.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{- |+A tiny golden-file helper. Compares actual output against a reference+committed to @test/golden/@. Set @GRANITE_BLESS_GOLDEN=1@ to overwrite+the reference with the actual output (useful when you intentionally+change the renderer).++Designed for the granite dep budget (base + text only): no+tasty-golden, no hspec-golden, no system-filepath.+-}+module Golden (+ goldenText,+ goldenDir,+) where++import Control.Exception (IOException, try)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as Text.IO+import System.Environment (lookupEnv)+import System.IO (hPutStrLn, stderr)+import Test.Hspec++goldenDir :: FilePath+goldenDir = "test/golden"++{- | Compare @actual@ against the file at @goldenDir/name@.++ * If the file is missing → the test fails with a clear hint.+ * If @GRANITE_BLESS_GOLDEN=1@ → write @actual@ to disk and pass.+ * Otherwise compare byte-for-byte.+-}+goldenText :: FilePath -> Text -> Expectation+goldenText name actual = do+ let path = goldenDir <> "/" <> name+ blessing <- lookupEnv "GRANITE_BLESS_GOLDEN"+ case blessing of+ Just "1" -> do+ Text.IO.writeFile path actual+ hPutStrLn stderr ("blessed: " <> path)+ _ -> do+ r <- try (Text.IO.readFile path) :: IO (Either IOException Text)+ case r of+ Left _ ->+ expectationFailure $+ "Missing golden file "+ <> path+ <> ".\nRun with GRANITE_BLESS_GOLDEN=1 to create it."+ Right expected -> do+ let aLines = Text.lines actual+ eLines = Text.lines expected+ if actual == expected+ then pure ()+ else+ expectationFailure $+ "Golden mismatch in "+ <> path+ <> "\nFirst diverging line "+ <> firstDiff aLines eLines+ <> "\n(Re-bless with GRANITE_BLESS_GOLDEN=1 if the change is intentional.)"++firstDiff :: [Text] -> [Text] -> String+firstDiff as es = go 0 as es+ where+ go _ [] [] = "(unknown — file lengths match but bytes differ)"+ go i [] (e : _) = " (line " <> show i <> ": actual EOF, expected " <> Text.unpack e <> ")"+ go i (a : _) [] = " (line " <> show i <> ": actual " <> Text.unpack a <> ", expected EOF)"+ go i (a : as') (e : es')+ | a == e = go (i + 1) as' es'+ | otherwise =+ " (line "+ <> show i+ <> ":\n actual: "+ <> Text.unpack a+ <> "\n expected: "+ <> Text.unpack e+ <> ")"
+ test/GoldenSpec.hs view
@@ -0,0 +1,365 @@+{-# LANGUAGE OverloadedStrings #-}++module GoldenSpec (spec) where++import Data.Text (Text)++import Golden (goldenText)+import Granite.Chart (lineChart, scatterChart)+import Granite.Color (Color (..))+import Granite.Data.Frame (Column (..))+import Granite.Render.Pipeline (renderChartSvg, renderChartTerminal)+import Granite.Render.Scene (+ Mark (..),+ Point (..),+ Rect (..),+ Scene (..),+ Style (..),+ TextStyle (..),+ defaultStyle,+ defaultTextStyle,+ )+import Granite.Render.Svg qualified as Svg+import Granite.Render.Terminal qualified as Terminal+import Granite.Spec (+ BinSpec (..),+ Chart (..),+ ColumnRef (..),+ Coord (..),+ Facet (..),+ FacetScales (..),+ Geom (..),+ Layer (..),+ LogBase (..),+ Mapping (..),+ PolarAes (..),+ PolarDir (..),+ Scale (..),+ Scales (..),+ Size (..),+ Stat (..),+ defLayer,+ defScaleOpts,+ defScales,+ emptyChart,+ emptyMapping,+ fromColumns,+ scaleY,+ )+import Test.Hspec++------------------------------------------------------------------------+-- Fixtures+------------------------------------------------------------------------++quadraticSeries :: Text -> [(Double, Double)] -> (Text, [(Double, Double)])+quadraticSeries n pts = (n, pts)++twoSeriesScatter :: Chart+twoSeriesScatter =+ scatterChart+ [ quadraticSeries "A" [(0, 0), (1, 1), (2, 4), (3, 9), (4, 16)]+ , quadraticSeries "B" [(0, 1), (1, 3), (2, 6), (3, 10), (4, 15)]+ ]+ (Just "Random points")++singleSeriesLine :: Chart+singleSeriesLine =+ lineChart+ [("sine", [(x, sin x) | x <- [0, 0.5 .. 6.0]])]+ (Just "sin(x)")++logYScatter :: Chart+logYScatter =+ twoSeriesScatter+ { chartScales = defScales{scaleY = SLog Base10 defScaleOpts}+ , chartTitle = Just "Log Y"+ }++responsiveScatter :: Chart+responsiveScatter =+ twoSeriesScatter+ { chartSize = SizeResponsive 1.6+ , chartTitle = Just "Responsive"+ }++reverseYLine :: Chart+reverseYLine =+ singleSeriesLine+ { chartScales = defScales{scaleY = SReverse (scaleY defScales)}+ , chartTitle = Just "Reverse Y"+ }++flippedLine :: Chart+flippedLine =+ lineChart+ [("y=2x", [(0, 0), (1, 2), (2, 4), (3, 6), (4, 8)])]+ (Just "CoordFlip")+ `withCoord` CoordFlip+ where+ withCoord c k = c{chartCoord = k}++-- A faceted scatter: same data spread across three panels by the+-- @series@ column. Tests FacetWrap layout + per-panel chrome.+facetedScatter :: Chart+facetedScatter =+ let pts =+ [ (0 :: Double, 1 :: Double, "A" :: Text)+ , (1, 4, "A")+ , (2, 9, "A")+ , (3, 16, "A")+ , (0, 0, "B")+ , (1, 2, "B")+ , (2, 4, "B")+ , (3, 6, "B")+ , (0, 5, "C")+ , (1, 4, "C")+ , (2, 3, "C")+ , (3, 2, "C")+ ]+ xs = [x | (x, _, _) <- pts]+ ys = [y | (_, y, _) <- pts]+ gs = [g | (_, _, g) <- pts]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("series", ColCat gs)+ ]+ layer =+ (defLayer GeomPoint)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartFacet = FacetWrap (ColumnRef "series") (Just 3) Nothing ScalesFixed+ , chartTitle = Just "Faceted by series"+ , chartSize = SizeChars 70 18+ }++-- A vertical bar chart with pre-aggregated heights. Uses StatIdentity+-- (the ggplot @stat="identity"@ convention) so the Y values pass+-- through unchanged. Exercises GeomBar.+barBasic :: Chart+barBasic =+ let xs = [0, 1, 2, 3] :: [Double]+ ys = [12, 7, 18, 9] :: [Double]+ df = fromColumns [("x", ColNum xs), ("y", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Bars"+ , chartSize = SizeChars 40 14+ }++-- Histogram of 50 numeric values bucketed into 8 bins. Exercises+-- StatBin + GeomHistogram. aesY points to the @count@ column that+-- StatBin emits, so the bar heights track the bin counts.+histBasic :: Chart+histBasic =+ let raw = take 50 (cycle [1.0, 1.2, 1.8, 2.0, 2.3, 2.7, 3.1, 3.4, 3.8, 4.2])+ df = fromColumns [("x", ColNum raw)]+ layer =+ (defLayer GeomHistogram)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatBin (BinByCount 8)+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Histogram"+ , chartSize = SizeChars 44 14+ }++-- Boxplot summarising three groups (A/B/C). Exercises StatBoxplot ++-- GeomBoxplot.+boxBasic :: Chart+boxBasic =+ let pts =+ [ (0 :: Double, v)+ | v <- [1, 2, 3, 4, 5, 6, 7, 8, 9 :: Double]+ ]+ <> [(1, v) | v <- [3, 4, 5, 6, 7, 8, 9, 10, 11 :: Double]]+ <> [(2, v) | v <- [5, 6, 7, 8, 9, 10, 11, 12, 13 :: Double]]+ df =+ fromColumns+ [ ("g", ColNum [g | (g, _) <- pts])+ , ("y", ColNum [v | (_, v) <- pts])+ ]+ layer =+ (defLayer GeomBoxplot)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "g")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatBoxplot+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Boxplot"+ , chartSize = SizeChars 40 16+ }++-- Pie chart of 4 slices. Exercises GeomArc.+pieBasic :: Chart+pieBasic =+ let df =+ fromColumns+ [ ("slice", ColCat ["A", "B", "C", "D"])+ , ("value", ColNum [40, 25, 20, 15])+ ]+ layer =+ (defLayer GeomArc)+ { layerMapping =+ emptyMapping{aesY = Just (ColumnRef "value")}+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Pie"+ , chartSize = SizeChars 30 16+ }++-- A four-petal rose in polar coordinates: r = |sin(2θ)| sampled at 33+-- angular positions. Locks in the polar projector + polar chrome.+polarRose :: Chart+polarRose =+ let nSteps = 32 :: Int+ pts =+ [ (theta, abs (sin (2 * theta)))+ | i <- [0 .. nSteps]+ , let theta = (fromIntegral i / fromIntegral nSteps) * 2 * pi+ ]+ base = lineChart [("r = |sin(2θ)|", pts)] (Just "Polar rose")+ in base+ { chartCoord = CoordPolar ThetaX 0 PolarCCW+ , chartSize = SizeChars 40 20+ }++noTitleScatter :: Chart+noTitleScatter = twoSeriesScatter{chartTitle = Nothing}++emptyChartFixture :: Chart+emptyChartFixture = emptyChart++-- A scene mixing every primitive mark; locked in once so future renderer+-- changes have to be intentional.+mixedPrimitivesScene :: Scene+mixedPrimitivesScene =+ Scene+ { sceneWidth = 240+ , sceneHeight = 120+ , sceneMarks =+ [ MRect (Rect 10 10 40 30) defaultStyle{styleFill = Just BrightBlue}+ , MCircle (Point 120 50) 12 defaultStyle{styleFill = Just BrightRed}+ , MPolyline+ [Point 20 100, Point 80 80, Point 140 90, Point 220 70]+ defaultStyle{styleStroke = Just BrightGreen, styleStrokeWidth = 2}+ , MText (Point 120 25) "Primitives" defaultTextStyle{textFill = BrightYellow}+ , MArc (Point 200 50) 20 0 1.5 defaultStyle{styleFill = Just BrightMagenta}+ ]+ }++------------------------------------------------------------------------+-- Spec+------------------------------------------------------------------------++spec :: Spec+spec = describe "Golden charts (run GRANITE_BLESS_GOLDEN=1 to refresh)" $ do+ describe "Scatter" $ do+ it "two-series scatter renders to expected terminal output" $+ goldenText "scatter-basic.txt" (renderChartTerminal twoSeriesScatter)++ it "two-series scatter renders to expected SVG output" $+ goldenText "scatter-basic.svg" (renderChartSvg twoSeriesScatter)++ it "no-title scatter renders to expected SVG output" $+ goldenText "scatter-no-title.svg" (renderChartSvg noTitleScatter)++ describe "Line chart" $ do+ it "single-series line renders to expected terminal output" $+ goldenText "line-basic.txt" (renderChartTerminal singleSeriesLine)++ it "single-series line renders to expected SVG output" $+ goldenText "line-basic.svg" (renderChartSvg singleSeriesLine)++ describe "Scales" $ do+ it "log-Y scatter renders to expected SVG output" $+ goldenText "scatter-log-y.svg" (renderChartSvg logYScatter)++ it "reverse-Y line renders to expected SVG output" $+ goldenText "line-reverse-y.svg" (renderChartSvg reverseYLine)++ describe "Coord" $ do+ it "CoordFlip line renders to expected terminal output" $+ goldenText "line-coord-flip.txt" (renderChartTerminal flippedLine)++ it "CoordFlip line renders to expected SVG output" $+ goldenText "line-coord-flip.svg" (renderChartSvg flippedLine)++ it "Polar rose renders to expected terminal output" $+ goldenText "polar-rose.txt" (renderChartTerminal polarRose)++ it "Polar rose renders to expected SVG output" $+ goldenText "polar-rose.svg" (renderChartSvg polarRose)++ describe "Facets" $ do+ it "FacetWrap by series renders to expected terminal output" $+ goldenText "facet-wrap.txt" (renderChartTerminal facetedScatter)++ it "FacetWrap by series renders to expected SVG output" $+ goldenText "facet-wrap.svg" (renderChartSvg facetedScatter)++ describe "Geoms (Phase 7b)" $ do+ it "bar chart renders to expected terminal output" $+ goldenText "bar-basic.txt" (renderChartTerminal barBasic)+ it "bar chart renders to expected SVG output" $+ goldenText "bar-basic.svg" (renderChartSvg barBasic)++ it "histogram renders to expected terminal output" $+ goldenText "hist-basic.txt" (renderChartTerminal histBasic)+ it "histogram renders to expected SVG output" $+ goldenText "hist-basic.svg" (renderChartSvg histBasic)++ it "boxplot renders to expected terminal output" $+ goldenText "box-basic.txt" (renderChartTerminal boxBasic)+ it "boxplot renders to expected SVG output" $+ goldenText "box-basic.svg" (renderChartSvg boxBasic)++ it "pie chart renders to expected SVG output" $+ goldenText "pie-basic.svg" (renderChartSvg pieBasic)++ describe "Sizing" $ do+ it "responsive scatter renders to expected SVG output" $+ goldenText "scatter-responsive.svg" (renderChartSvg responsiveScatter)++ describe "Empty chart" $ do+ it "empty chart renders to expected SVG output" $+ goldenText "empty.svg" (renderChartSvg emptyChartFixture)++ describe "Scene primitives" $ do+ it "mixed-marks Scene → terminal" $+ goldenText "primitives.txt" (Terminal.renderScene mixedPrimitivesScene)++ it "mixed-marks Scene → SVG" $+ goldenText "primitives.svg" (Svg.renderScene mixedPrimitivesScene)
+ test/PipelineSpec.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}++module PipelineSpec (spec) where++import Data.Text qualified as Text++import Granite.Render.Pipeline+import Granite.Render.Scene (Scene (..))+import Granite.Spec+import Test.Hspec++-- A scatter chart equivalent to the README example: two named series+-- of (x, y) data, rendered through the new IR pipeline.+scatterChart :: Chart+scatterChart =+ emptyChart+ { chartTitle = Just "Random points"+ , chartSize = SizeChars 68 22+ , chartLayers =+ [ pointLayer "A" [(0, 0), (1, 1), (2, 4), (3, 9), (4, 16)]+ , pointLayer "B" [(0, 1), (1, 3), (2, 6), (3, 10), (4, 15)]+ ]+ }+ where+ pointLayer name pts =+ let xs = map fst pts+ ys = map snd pts+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ ]+ in (defLayer GeomPoint)+ { layerData = Just df+ , layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef name)+ }+ }++spec :: Spec+spec = describe "Granite.Render.Pipeline" $ do+ describe "scatter Chart through the IR" $ do+ it "produces a non-empty Scene with both axes" $ do+ let scene = chartToScene scatterChart+ sceneWidth scene `shouldSatisfy` (> 0)+ sceneHeight scene `shouldSatisfy` (> 0)+ length (sceneMarks scene) `shouldSatisfy` (> 0)++ it "terminal output contains the title" $ do+ let term = renderChartTerminal scatterChart+ term `shouldSatisfy` Text.isInfixOf "Random points"++ it "SVG output contains the title and viewBox" $ do+ let svg = renderChartSvg scatterChart+ svg `shouldSatisfy` Text.isInfixOf "Random points"+ svg `shouldSatisfy` Text.isInfixOf "viewBox"++ it "SVG output has axis structure (lines + tick text)" $ do+ let svg = renderChartSvg scatterChart+ -- Axes are emitted as <line> (since the chrome+ -- gridline/tick refactor); <polyline> still appears for+ -- data layers.+ svg `shouldSatisfy` Text.isInfixOf "<line"+ svg `shouldSatisfy` Text.isInfixOf "<text"++ it "SVG output has at least one circle per series" $ do+ let svg = renderChartSvg scatterChart+ ncircles = Text.count "<circle" svg+ ncircles `shouldSatisfy` (>= 5 * 2) -- 5 points × 2 series+ it "SVG output has a legend swatch per series" $ do+ let svg = renderChartSvg scatterChart+ nrects = Text.count "<rect" svg+ -- 1 background + 2 legend swatches; allow more from future chrome+ nrects `shouldSatisfy` (>= 3)++ it "terminal line count is similar to legacy output" $ do+ let term = renderChartTerminal scatterChart+ lineCount = length (Text.lines term)+ -- For a 68×22 char canvas plus title + bottom labels we expect+ -- roughly 24 lines (22 plot rows + title + axis labels).+ lineCount `shouldSatisfy` (>= 15)+ lineCount `shouldSatisfy` (<= 40)++ describe "Log-scale chart" $ do+ let logChart =+ scatterChart+ { chartScales =+ defScales{scaleY = SLog Base10 defScaleOpts}+ , chartTitle = Just "Log Y"+ }+ it "renders without error and includes log-friendly breaks" $ do+ let svg = renderChartSvg logChart+ svg `shouldSatisfy` Text.isInfixOf "Log Y"+ svg `shouldSatisfy` Text.isInfixOf "<svg"++ describe "Empty chart" $ do+ it "renders an empty chart without crashing" $ do+ let svg = renderChartSvg emptyChart+ term = renderChartTerminal emptyChart+ svg `shouldSatisfy` Text.isInfixOf "<svg"+ Text.length term `shouldSatisfy` (>= 0)++ describe "SizeResponsive" $ do+ let responsive =+ scatterChart{chartSize = SizeResponsive 2.0}+ let fixed =+ scatterChart{chartSize = SizeChars 60 20}++ it "drops absolute width/height for SizeResponsive" $ do+ let svg = renderChartSvg responsive+ svg `shouldSatisfy` Text.isInfixOf "viewBox=\"0 0"+ svg `shouldSatisfy` Text.isInfixOf "preserveAspectRatio"+ svg `shouldSatisfy` Text.isInfixOf "width=\"100%\""+ svg `shouldSatisfy` Text.isInfixOf "style=\"height:auto"++ it "keeps absolute width/height for SizeChars / SizePixels" $ do+ let svg = renderChartSvg fixed+ -- inspect just the opening <svg ...> tag, not the body+ openSvg = Text.takeWhile (/= '>') (Text.dropWhile (/= '<') svg)+ openSvg `shouldSatisfy` Text.isInfixOf "viewBox"+ openSvg `shouldSatisfy` (not . Text.isInfixOf "preserveAspectRatio")+ openSvg `shouldSatisfy` (not . Text.isInfixOf "width=\"100%\"")
+ test/PlotlySpec.hs view
@@ -0,0 +1,467 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Replicas of canonical examples from the Plotly basic / statistical /+scientific / financial galleries:++ * https://plotly.com/python/basic-charts/+ * https://plotly.com/python/statistical-charts/+ * https://plotly.com/python/scientific-charts/+ * https://plotly.com/python/financial-charts/++Each fixture is one chart, locked as a terminal + SVG golden. Charts+already covered by 'GoldenSpec' (line, scatter, vertical bar, pie,+histogram, box plot, polar rose, log-Y) are not duplicated here.++Out of scope (see memory @granite-ir-rewrite@ for the rationale):+3D, ternary, contour, network, dendrogram, sunburst, sankey, treemap,+gantt, candlestick / OHLC, gauge / indicator, imshow, wind rose,+violin, 2D-density heatmap.+-}+module PlotlySpec (spec) where++import Data.Text (Text)+import Data.Text qualified as Text++import Golden (goldenText)+import Granite.Data.Frame (Column (..), fromColumns)+import Granite.Render.Pipeline (renderChartSvg, renderChartTerminal)+import Granite.Spec (+ BinSpec (..),+ Chart (..),+ ColumnRef (..),+ Coord (..),+ Geom (..),+ Layer (..),+ Mapping (..),+ Position (..),+ Size (..),+ Stat (..),+ defLayer,+ emptyChart,+ emptyMapping,+ )+import Test.Hspec++------------------------------------------------------------------------+-- Spec entry+------------------------------------------------------------------------++spec :: Spec+spec = describe "Plotly gallery replicas (Phase 8)" $ do+ describe "Basic" $ do+ chartCase "plotly-bar-horizontal" horizontalBar+ chartCase "plotly-bar-stacked" stackedBar+ chartCase "plotly-bar-grouped" groupedBar+ chartCase "plotly-area-filled" filledArea++ describe "Statistical" $ do+ chartCase "plotly-error-bars" errorBars+ chartCase "plotly-density" densityCurve+ chartCase "plotly-distplot" distPlot++ describe "Scientific" $ do+ chartCase "plotly-heatmap" heatmap+ chartCase "plotly-heatmap-annotated" annotatedHeatmap++ describe "Financial" $ do+ chartCase "plotly-funnel" funnel+ chartCase "plotly-waterfall" waterfall++-- | Bless one chart as a (terminal, svg) pair of goldens.+chartCase :: String -> Chart -> SpecWith ()+chartCase name chart = do+ it (name <> " — terminal") $+ goldenText (name <> ".txt") (renderChartTerminal chart)+ it (name <> " — svg") $+ goldenText (name <> ".svg") (renderChartSvg chart)++------------------------------------------------------------------------+-- Basic+------------------------------------------------------------------------++{- | Horizontal bar chart: five items ranked left-to-right (highest+value at top). Built from a vertical bar + 'CoordFlip'.+-}+horizontalBar :: Chart+horizontalBar =+ let xs = [0, 1, 2, 3, 4] :: [Double]+ ys = [82, 67, 45, 33, 21] :: [Double]+ df = fromColumns [("item", ColNum xs), ("value", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "item")+ , aesY = Just (ColumnRef "value")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordFlip+ , chartTitle = Just "Top 5 (horizontal)"+ , chartSize = SizeChars 60 16+ }++{- | Stacked bar chart: four quarters × three product lines. Long+format + 'PosStack' splits each X-column into a vertical stack.+-}+stackedBar :: Chart+stackedBar =+ let quarters = concat [replicate 3 q | q <- [0, 1, 2, 3 :: Double]]+ products = take 12 (cycle ["Product A", "Product B", "Product C"])+ sales = [12, 8, 4, 15, 10, 6, 18, 12, 8, 22, 14, 10] :: [Double]+ df =+ fromColumns+ [ ("quarter", ColNum quarters)+ , ("product", ColCat products)+ , ("sales", ColNum sales)+ ]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "quarter")+ , aesY = Just (ColumnRef "sales")+ , aesGroup = Just (ColumnRef "product")+ , aesFill = Just (ColumnRef "product")+ }+ , layerStat = StatIdentity+ , layerPosition = PosStack+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Sales by quarter (stacked)"+ , chartSize = SizeChars 60 16+ }++{- | Grouped (dodged) bar chart: same data as 'stackedBar' but each+product sits side-by-side at every quarter via 'PosDodge'.+-}+groupedBar :: Chart+groupedBar =+ stackedBar+ { chartLayers =+ [ (head (chartLayers stackedBar))+ { layerPosition = PosDodge 0.25+ }+ ]+ , chartTitle = Just "Sales by quarter (grouped)"+ }++{- | Filled area chart: a smooth curve with the region between the+curve and 'aesYmin'=0 shaded.+-}+filledArea :: Chart+filledArea =+ let xs = [0 .. 12] :: [Double]+ ys = [sin (x / 2) + 2 | x <- xs]+ zeros = replicate (length xs) 0 :: [Double]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("ymin", ColNum zeros)+ , ("ymax", ColNum ys)+ ]+ layer =+ (defLayer GeomRibbon)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesYmin = Just (ColumnRef "ymin")+ , aesYmax = Just (ColumnRef "ymax")+ }+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Filled area"+ , chartSize = SizeChars 56 14+ }++------------------------------------------------------------------------+-- Statistical+------------------------------------------------------------------------++{- | Five (x, y) points each with a vertical confidence interval shown+as an 'MPolyline' error bar. Two layers: GeomPoint over GeomErrorbar.+-}+errorBars :: Chart+errorBars =+ let xs = [1, 2, 3, 4, 5] :: [Double]+ ys = [2.1, 3.5, 5.2, 4.7, 6.1] :: [Double]+ los = [1.5, 2.8, 4.6, 4.0, 5.3] :: [Double]+ his = [2.7, 4.2, 5.8, 5.4, 6.9] :: [Double]+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum ys)+ , ("lo", ColNum los)+ , ("hi", ColNum his)+ ]+ m =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesYmin = Just (ColumnRef "lo")+ , aesYmax = Just (ColumnRef "hi")+ }+ pts = (defLayer GeomPoint){layerMapping = m, layerStat = StatIdentity}+ bars = (defLayer GeomErrorbar){layerMapping = m, layerStat = StatIdentity}+ in emptyChart+ { chartData = df+ , chartLayers = [bars, pts]+ , chartTitle = Just "Measurements ± CI"+ , chartSize = SizeChars 56 14+ }++{- | Density (KDE) curve over a small sample. StatDensity produces a+(grid x, density) frame; GeomDensity renders it as a line.+-}+densityCurve :: Chart+densityCurve =+ let sample =+ [ 1.0+ , 1.2+ , 1.3+ , 1.4+ , 1.5+ , 1.7+ , 2.0+ , 2.1+ , 2.2+ , 2.3+ , 2.5+ , 2.8+ , 3.0+ , 3.1+ , 3.3+ , 3.4+ , 3.7+ , 3.9+ , 4.0+ , 4.2+ ] ::+ [Double]+ df = fromColumns [("x", ColNum sample)]+ layer =+ (defLayer GeomDensity)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ }+ , layerStat = StatDensity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Density (KDE)"+ , chartSize = SizeChars 56 14+ }++{- | Two layers on shared axes: a histogram of the sample with a KDE+line on top. The layers share the chart-level data frame.+-}+distPlot :: Chart+distPlot =+ let sample =+ [ 1.0+ , 1.2+ , 1.3+ , 1.4+ , 1.5+ , 1.7+ , 2.0+ , 2.1+ , 2.2+ , 2.3+ , 2.5+ , 2.8+ , 3.0+ , 3.1+ , 3.3+ , 3.4+ , 3.7+ , 3.9+ , 4.0+ , 4.2+ ] ::+ [Double]+ df = fromColumns [("x", ColNum sample)]+ hist =+ (defLayer GeomHistogram)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatBin (BinByCount 8)+ }+ kde =+ (defLayer GeomDensity)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "density")+ }+ , layerStat = StatDensity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [hist, kde]+ , chartTitle = Just "Distribution"+ , chartSize = SizeChars 56 16+ }++------------------------------------------------------------------------+-- Scientific+------------------------------------------------------------------------++{- | A 5×5 heatmap with intensity varying as @sin(x) + cos(y)@. Rendered+via 'GeomTile' — the SVG backend gets distinct fill rectangles per+cell; terminal renders the cell outlines.+-}+heatmap :: Chart+heatmap =+ let coords =+ [ ( fromIntegral x+ , fromIntegral y+ , sin (fromIntegral x / 2) + cos (fromIntegral y / 2)+ )+ | x <- [0 .. 4 :: Int]+ , y <- [0 .. 4 :: Int]+ ]+ df =+ fromColumns+ [ ("x", ColNum [x | (x, _, _) <- coords])+ , ("y", ColNum [y | (_, y, _) <- coords])+ , ("z", ColNum [z | (_, _, z) <- coords])+ ]+ layer =+ (defLayer GeomTile)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesFill = Just (ColumnRef "z")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Heatmap"+ , chartSize = SizeChars 48 16+ }++{- | Same data as 'heatmap' but with value labels overlaid in each+cell via a 'GeomText' layer. Plotly\'s "annotated heatmap" example.+-}+annotatedHeatmap :: Chart+annotatedHeatmap =+ let coords =+ [ ( fromIntegral x+ , fromIntegral y+ , sin (fromIntegral x / 2) + cos (fromIntegral y / 2)+ )+ | x <- [0 .. 4 :: Int]+ , y <- [0 .. 4 :: Int]+ ]+ labels = [oneDecimal z | (_, _, z) <- coords]+ df =+ fromColumns+ [ ("x", ColNum [x | (x, _, _) <- coords])+ , ("y", ColNum [y | (_, y, _) <- coords])+ , ("z", ColNum [z | (_, _, z) <- coords])+ , ("label", ColCat labels)+ ]+ labelLayer =+ (defLayer GeomText)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesLabel = Just (ColumnRef "label")+ }+ , layerStat = StatIdentity+ }+ in heatmap+ { chartData = df+ , chartLayers = chartLayers heatmap <> [labelLayer]+ , chartTitle = Just "Annotated heatmap"+ }++oneDecimal :: Double -> Text+oneDecimal v =+ let rounded = fromIntegral (round (v * 10) :: Int) / 10 :: Double+ in Text.pack (show rounded)++------------------------------------------------------------------------+-- Financial+------------------------------------------------------------------------++{- | Funnel: five sales-pipeline stages with shrinking counts. Built+from horizontal bars (CoordFlip + GeomBar).+-}+funnel :: Chart+funnel =+ let xs = [0, 1, 2, 3, 4] :: [Double]+ ys = [1000, 720, 480, 220, 120] :: [Double]+ df = fromColumns [("stage", ColNum xs), ("count", ColNum ys)]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "stage")+ , aesY = Just (ColumnRef "count")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartCoord = CoordFlip+ , chartTitle = Just "Sales funnel"+ , chartSize = SizeChars 60 14+ }++{- | Waterfall: incremental deltas making up a final total. Built from+a stacked bar where the base of each bar is the running total up+to that step (encoded as a per-row __ybase via a manual second+layer; for the IR we just place each delta as a bar with its+visible y range).+-}+waterfall :: Chart+waterfall =+ let xs = [0, 1, 2, 3, 4, 5] :: [Double]+ -- starting total, three positive deltas, one negative, ending total+ ystart = [0, 100, 130, 180, 175, 0] :: [Double]+ yend = [100, 130, 180, 175, 195, 195] :: [Double]+ -- We render the bars by reading the explicit __ybase column,+ -- which the bar geom already understands (Phase 7a wrote that+ -- convention).+ df =+ fromColumns+ [ ("x", ColNum xs)+ , ("y", ColNum yend)+ , ("__ybase", ColNum ystart)+ ]+ layer =+ (defLayer GeomBar)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ }+ , layerStat = StatIdentity+ }+ in emptyChart+ { chartData = df+ , chartLayers = [layer]+ , chartTitle = Just "Waterfall"+ , chartSize = SizeChars 60 14+ }
+ test/PositionSpec.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings #-}++module PositionSpec (spec) where++import Data.Text qualified as Text++import Granite.Data.Frame (+ Column (..),+ DataFrame (..),+ fromColumns,+ lookupColumn,+ )+import Granite.Position (applyPosition)+import Granite.Spec (+ ColumnRef (..),+ Mapping (..),+ Position (..),+ emptyMapping,+ )+import Test.Hspec++-- Long-format fixture: two X values, two series ("A", "B"), totals 30+-- at X=1 and 40 at X=2.+sampleFrame :: DataFrame+sampleFrame =+ fromColumns+ [ ("x", ColNum [1, 1, 2, 2])+ , ("y", ColNum [10, 20, 15, 25])+ , ("series", ColCat ["A", "B", "A", "B"])+ ]++sampleMapping :: Mapping+sampleMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesGroup = Just (ColumnRef "series")+ }++spec :: Spec+spec = describe "Granite.Position" $ do+ describe "PosIdentity" $ do+ it "leaves the frame unchanged" $+ applyPosition PosIdentity sampleMapping sampleFrame+ `shouldBe` sampleFrame++ describe "PosStack" $ do+ let stacked = applyPosition PosStack sampleMapping sampleFrame++ it "produces the same number of rows" $ do+ let DataFrame cols = stacked+ case lookup "x" cols of+ Just (ColNum xs) -> length xs `shouldBe` 4+ _ -> expectationFailure "x column missing"++ it "stacks y values cumulatively within each x" $ do+ case lookupColumn "y" stacked of+ Just (ColNum ys) -> ys `shouldBe` [10, 30, 15, 40]+ _ -> expectationFailure "y column missing"++ it "writes __ybase column with segment bottoms" $ do+ case lookupColumn "__ybase" stacked of+ Just (ColNum bs) -> bs `shouldBe` [0, 10, 0, 15]+ _ -> expectationFailure "__ybase column missing"++ describe "PosFill" $ do+ let filled = applyPosition PosFill sampleMapping sampleFrame++ it "normalises every x-group to sum to 1" $ do+ case lookupColumn "y" filled of+ Just (ColNum ys) ->+ let near a b = abs (a - b) < 1e-9+ -- (10/30, (10+20)/30, 15/40, (15+25)/40)+ expected = [1 / 3, 1, 3 / 8, 1]+ in and (zipWith near ys expected) `shouldBe` True+ _ -> expectationFailure "y column missing"++ describe "PosDodge" $ do+ let dodged = applyPosition (PosDodge 0.3) sampleMapping sampleFrame++ it "preserves row count" $ do+ case lookupColumn "x" dodged of+ Just (ColNum xs) -> length xs `shouldBe` 4+ _ -> expectationFailure "x column missing"++ it "spreads two series symmetrically around the original x" $ do+ -- nSeries=2, center=0.5, gap=0.3; series A gets -0.15, B gets +0.15+ case lookupColumn "x" dodged of+ Just (ColNum xs) -> xs `shouldBe` [0.85, 1.15, 1.85, 2.15]+ _ -> expectationFailure "x column missing"++ describe "PosJitter" $ do+ let jittered = applyPosition (PosJitter 0.2 0.5) sampleMapping sampleFrame++ it "preserves row count" $ do+ case lookupColumn "x" jittered of+ Just (ColNum xs) -> length xs `shouldBe` 4+ _ -> expectationFailure "x column missing"++ it "is deterministic across runs" $ do+ let again = applyPosition (PosJitter 0.2 0.5) sampleMapping sampleFrame+ jittered `shouldBe` again++ it "keeps offsets within the requested amplitude" $ do+ case (lookupColumn "x" jittered, lookupColumn "y" jittered) of+ (Just (ColNum xs), Just (ColNum ys)) -> do+ -- amplitude is ±dx and ±dy; allow a tiny epsilon+ all (\(a, b) -> abs (a - b) <= 0.2 + 1e-9) (zip xs [1, 1, 2, 2])+ `shouldBe` True+ all (\(a, b) -> abs (a - b) <= 0.5 + 1e-9) (zip ys [10, 20, 15, 25])+ `shouldBe` True+ _ -> expectationFailure "x / y missing"++ describe "edge cases" $ do+ it "stack with no group column treats everything as one series" $ do+ let m = emptyMapping{aesX = Just (ColumnRef "x"), aesY = Just (ColumnRef "y")}+ df =+ fromColumns+ [ ("x", ColNum [1, 1, 2])+ , ("y", ColNum [5, 10, 7])+ ]+ stacked = applyPosition PosStack m df+ case lookupColumn "y" stacked of+ Just (ColNum ys) -> ys `shouldBe` [5, 15, 7]+ _ -> expectationFailure "y missing"++ it "frame without the mapped x/y is returned unchanged for stack" $ do+ let bare = fromColumns [("not_x", ColNum [1, 2, 3])]+ m = emptyMapping{aesX = Just (ColumnRef "x"), aesY = Just (ColumnRef "y")}+ applyPosition PosStack m bare `shouldBe` bare++ it "compiles against the Text import" $+ Text.length "ok" `shouldBe` 2
+ test/RenderSpec.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module RenderSpec (spec) where++import Data.Text qualified as Text+import Granite.Color (Color (..))+import Granite.Render.Scene+import Granite.Render.Svg qualified as Svg+import Granite.Render.Terminal qualified as Terminal+import Test.Hspec++-- A small fixture exercising the four marks both backends understand today.+sampleScene :: Scene+sampleScene =+ Scene+ { sceneWidth = 200+ , sceneHeight = 100+ , sceneMarks =+ [ MRect (Rect 10 10 40 30) defaultStyle{styleFill = Just BrightBlue}+ , MCircle (Point 120 50) 12 defaultStyle{styleFill = Just BrightRed}+ , MPolyline+ [Point 20 80, Point 60 70, Point 100 75, Point 160 60]+ defaultStyle{styleStroke = Just BrightGreen, styleStrokeWidth = 2}+ , MText (Point 100 20) "Hello" defaultTextStyle{textFill = BrightYellow}+ ]+ }++spec :: Spec+spec = do+ describe "Granite.Render.Scene + backends" $ do+ it "both backends accept the same Scene" $ do+ let terminal = Terminal.renderScene sampleScene+ svg = Svg.renderScene sampleScene+ Text.length terminal `shouldSatisfy` (> 0)+ Text.length svg `shouldSatisfy` (> 0)++ it "SVG output is a well-formed document with all four marks" $ do+ let svg = Svg.renderScene sampleScene+ svg `shouldSatisfy` Text.isInfixOf "<svg"+ svg `shouldSatisfy` Text.isInfixOf "</svg>"+ svg `shouldSatisfy` Text.isInfixOf "<rect"+ svg `shouldSatisfy` Text.isInfixOf "<circle"+ svg `shouldSatisfy` Text.isInfixOf "<polyline"+ svg `shouldSatisfy` Text.isInfixOf "<text"+ svg `shouldSatisfy` Text.isInfixOf "Hello"++ it "SVG honours the requested viewport" $ do+ let svg = Svg.renderScene sampleScene+ svg `shouldSatisfy` Text.isInfixOf "viewBox=\"0 0 200 100\""++ it "Terminal output contains text marks and is multi-line" $ do+ let terminal = Terminal.renderScene sampleScene+ terminal `shouldSatisfy` Text.isInfixOf "Hello"+ length (Text.lines terminal) `shouldSatisfy` (> 1)++ it "Terminal output dimensions track the scene size" $ do+ let small =+ Terminal.renderScene+ sampleScene{sceneWidth = 80, sceneHeight = 32}+ big =+ Terminal.renderScene+ sampleScene{sceneWidth = 320, sceneHeight = 128}+ length (Text.lines big) `shouldSatisfy` (> length (Text.lines small))++ it "An empty scene still renders without crashing" $ do+ let empty = Scene 100 50 []+ term = Terminal.renderScene empty+ svg = Svg.renderScene empty+ Text.length term `shouldSatisfy` (>= 0)+ svg `shouldSatisfy` Text.isInfixOf "<svg"++ it "Grouping marks renders the same as flattening them" $ do+ let grouped =+ sampleScene+ { sceneMarks =+ [MGroup (sceneMarks sampleScene)]+ }+ flat = sampleScene+ Svg.renderScene grouped `shouldSatisfy` Text.isInfixOf "<g>"+ Text.length (Terminal.renderScene grouped)+ `shouldBe` Text.length (Terminal.renderScene flat)
+ test/ScaleSpec.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module ScaleSpec (spec) where++import Granite.Scale (TrainedScale (..), niceNum, niceTicks, train)+import Granite.Spec (+ Expand (..),+ LogBase (..),+ Scale (..),+ ScaleOpts (..),+ defScaleOpts,+ )+import Test.Hspec+import Test.QuickCheck++{- | A floating-point domain that the property tests treat as well-formed:+finite, non-NaN, and strictly increasing.+-}+data Domain = Domain {dLo :: Double, dHi :: Double}+ deriving (Eq, Show)++instance Arbitrary Domain where+ arbitrary = do+ a <- choose (-1000, 1000)+ d <- choose (0.5, 1000) -- guaranteed positive span+ pure (Domain a (a + d))++-- | A strictly-positive domain for log-scale tests.+data PosDomain = PosDomain {pdLo :: Double, pdHi :: Double}+ deriving (Eq, Show)++instance Arbitrary PosDomain where+ arbitrary = do+ lo <- choose (0.01, 100)+ factor <- choose (1.1, 1000)+ pure (PosDomain lo (lo * factor))++spec :: Spec+spec = describe "Granite.Scale" $ do+ describe "niceNum" $ do+ it "is idempotent on numbers already in {1,2,5} × 10^k" $ do+ niceNum 1 False `shouldBe` 1+ niceNum 2 False `shouldBe` 2+ niceNum 5 False `shouldBe` 5+ niceNum 10 False `shouldBe` 10+ niceNum 100 False `shouldBe` 100+ niceNum 0.5 False `shouldBe` 0.5+ niceNum 0.1 False `shouldBe` 0.1++ it "is always positive for positive input" $+ property $ \(Positive (x :: Double)) ->+ niceNum x True > 0++ it "is non-decreasing in 'ceil' mode" $+ property $ \(Positive (x :: Double)) ->+ niceNum x False >= x++ describe "niceTicks" $ do+ it "returns at least 2 ticks for a non-degenerate range" $+ property $ \(Domain lo hi) ->+ length (niceTicks (lo, hi) 5) >= 2++ it "ticks span the data range" $+ property $ \(Domain lo hi) ->+ let ticks = niceTicks (lo, hi) 5+ tMin = minimum ticks+ tMax = maximum ticks+ in tMin <= lo + 1e-9 .&&. tMax >= hi - 1e-9++ it "ticks are monotonically increasing" $+ property $ \(Domain lo hi) ->+ let ticks = niceTicks (lo, hi) 5+ in and (zipWith (<) ticks (drop 1 ticks))++ it "uses round-number step sizes ({1, 2, 5} × 10^k)" $+ property $ \(Domain lo hi) ->+ let ticks = niceTicks (lo, hi) 5+ in case ticks of+ (a : b : _) -> isRoundStep (b - a)+ _ -> True++ it "tick count is reasonable for the requested target" $+ property $ \(Domain lo hi) ->+ let ticks = niceTicks (lo, hi) 5+ n = length ticks+ in n >= 2 .&&. n <= 12 -- nice numbers can over- or under-shoot a bit+ describe "train (linear)" $ do+ it "projects the lower bound to 0 and upper bound to 1" $+ property $ \(Domain lo hi) ->+ let ts = train (SLinear defScaleOpts) (lo, hi)+ (lo', hi') = tsDomain ts+ in abs (tsProject ts lo') < 1e-9+ .&&. abs (tsProject ts hi' - 1) < 1e-9++ it "is the identity round-trip: unproject . project ≈ id" $+ property $ \(Domain lo hi) (v0 :: Double) ->+ let ts = train (SLinear defScaleOpts) (lo, hi)+ (lo', hi') = tsDomain ts+ v = lo' + (v0 `divNorm` (hi' - lo'))+ t = tsProject ts v+ v' = tsUnproject ts t+ in abs (v - v') < 1e-6 .||. abs (hi' - lo') < 1e-12++ it "applies the configured expansion factor symmetrically" $+ property $ \(Domain lo hi) ->+ let mult = 0.1+ expand = Expand mult 0+ ts = train (SLinear defScaleOpts{scaleExpand = expand}) (lo, hi)+ (lo', hi') = tsDomain ts+ pad = (hi - lo) * mult+ in abs ((lo - pad) - lo') < 1e-6+ .&&. abs ((hi + pad) - hi') < 1e-6++ describe "train (log)" $ do+ it "log-base-10 of 1..1000 produces three-decade nice breaks" $ do+ let ts = train (SLog Base10 defScaleOpts) (1, 1000)+ breaks = tsBreaks ts+ length breaks `shouldSatisfy` (>= 2)+ length breaks `shouldSatisfy` (<= 12)+ -- All breaks must be positive powers of 10+ all+ (\v -> abs (v - 10 ** fromIntegral (round (logBase 10 v) :: Int)) < 1e-6 * v)+ breaks+ `shouldBe` True++ it "handles data with zero by clamping the domain" $ do+ -- previously this emitted hundreds of ticks; now caps at 10+ let ts = train (SLog Base10 defScaleOpts) (0, 100)+ breaks = tsBreaks ts+ length breaks `shouldSatisfy` (<= 12)++ it "is positive-only: projection of values below the floor saturates" $ do+ let ts = train (SLog Base10 defScaleOpts) (1, 1000)+ tsProject ts 0.0001 `shouldSatisfy` (\t -> t >= -1e-6)++ describe "train (sqrt)" $ do+ it "projects 0 to 0 (sqrt scale is bounded at 0)" $ do+ let ts = train (SSqrt defScaleOpts) (0, 100)+ abs (tsProject ts 0) `shouldSatisfy` (< 0.1)+ tsProject ts 100 `shouldSatisfy` (> 0.8)++ it "places 25 closer to 50% than to 50 (sqrt compresses tail)" $ do+ let ts = train (SSqrt defScaleOpts) (0, 100)+ t25 = tsProject ts 25+ t50 = tsProject ts 50+ -- sqrt(25) / sqrt(100) = 0.5 (so 25 lands at 50% — that's the point)+ abs (t25 - 0.5) `shouldSatisfy` (< 0.1)+ t50 `shouldSatisfy` (> t25)++ describe "train (reverse)" $ do+ it "reverses the projection of its inner scale" $+ property $ \(Domain lo hi) (Positive (t :: Double)) ->+ let unit = min 1.0 (t / 10)+ inner = SLinear defScaleOpts{scaleExpand = Expand 0 0}+ ts = train inner (lo, hi)+ rs = train (SReverse inner) (lo, hi)+ (l, h) = tsDomain ts+ mid = l + unit * (h - l)+ in abs (tsProject ts mid + tsProject rs mid - 1) < 1e-6++ describe "train (identity)" $ do+ it "projects values through unchanged" $ do+ let ts = train SIdentity (0, 10)+ tsProject ts 0 `shouldBe` 0+ tsProject ts 5 `shouldBe` 5+ tsUnproject ts 7 `shouldBe` 7++------------------------------------------------------------------------+-- Helpers+------------------------------------------------------------------------++-- | Is @step@ of the form @{1, 2, 2.5, 5} × 10^k@?+isRoundStep :: Double -> Bool+isRoundStep s+ | s <= 0 = False+ | otherwise =+ let k = floor (logBase 10 s) :: Int+ mant = s / (10 ** fromIntegral k)+ -- Heckbert's set is {1, 2, 5}; we are slightly looser.+ allowed = [1, 2, 2.5, 5, 10]+ in any (\a -> abs (mant - a) < 1e-6) allowed++-- | Normalise a Double to a value in @[0, 1]@.+divNorm :: Double -> Double -> Double+divNorm v span_+ | abs span_ < 1e-12 = 0+ | otherwise =+ let u = abs v / (abs v + 1)+ in u * span_
+ test/SpecPropSpec.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}++module SpecPropSpec (spec) where++import Data.Text qualified as Text++import Granite.Color (Color (..))+import Granite.Spec+import Test.Hspec++-- A representative chart that exercises every constructor we expect to+-- be JSON-faithful: layers with mappings + stats + positions, scales of+-- various transforms, polar coord, facet wrap, theme, responsive size.+representativeChart :: Chart+representativeChart =+ emptyChart+ { chartData =+ fromColumns+ [ ("x", ColNum [1, 2, 3, 4, 5])+ , ("y", ColNum [1.1, 4.0, 9.2, 16.05, 25.5])+ , ("group", ColCat ["A", "A", "B", "B", "B"])+ ,+ ( "when"+ , ColTime+ [1700000000000, 1700000003600, 1700000007200, 1700000010800, 1700000014400]+ )+ , ("active", ColBool [True, False, True, False, True])+ ]+ , chartLayers =+ [ (defLayer GeomPoint)+ { layerMapping =+ emptyMapping+ { aesX = Just (ColumnRef "x")+ , aesY = Just (ColumnRef "y")+ , aesColor = Just (ColumnRef "group")+ }+ , layerAesDef = emptyAesDefaults{defSize = Just 3}+ }+ , (defLayer GeomLine)+ { layerMapping =+ emptyMapping{aesX = Just (ColumnRef "x"), aesY = Just (ColumnRef "y")}+ , layerStat = StatSmooth (SmoothLoess 0.5)+ }+ , (defLayer GeomBar)+ { layerMapping = emptyMapping{aesX = Just (ColumnRef "group")}+ , layerStat = StatCount+ , layerPosition = PosDodge 0.1+ }+ ]+ , chartScales =+ defScales+ { scaleX = SLog Base10 defScaleOpts{scaleBreaks = BreaksCount 5}+ , scaleY = SSqrt defScaleOpts{scaleLabels = FormatPrecision 2}+ , scaleColor =+ Just (SColorDiscrete [NamedColor BrightBlue, Hex "#ff0000", RGB 0 128 0])+ }+ , chartCoord = CoordPolar ThetaX 0 PolarCCW+ , chartFacet = FacetWrap (ColumnRef "group") (Just 2) Nothing ScalesFreeY+ , chartTitle = Just "Round-trip fixture"+ , chartSize = SizeResponsive 1.5+ }++spec :: Spec+spec = describe "Granite.Spec" $ do+ describe "show / read round trip (sentinel for JSON faithfulness)" $ do+ it "round-trips emptyChart" $ do+ (read (show emptyChart) :: Chart) `shouldBe` emptyChart++ it "round-trips a representative chart" $ do+ (read (show representativeChart) :: Chart) `shouldBe` representativeChart++ it "double-encoding is idempotent" $ do+ let s = show representativeChart+ show (read s :: Chart) `shouldBe` s++ describe "DataFrame" $ do+ it "addColumn preserves order" $ do+ let f =+ addColumn "z" (ColNum [3]) $+ addColumn "y" (ColNum [2]) $+ addColumn "x" (ColNum [1]) emptyFrame+ columnNames f `shouldBe` ["x", "y", "z"]++ it "addColumn replaces existing in place" $ do+ let f0 =+ addColumn "y" (ColNum [10]) $+ addColumn "x" (ColNum [1]) emptyFrame+ f1 = addColumn "x" (ColNum [99]) f0+ columnNames f1 `shouldBe` ["x", "y"]+ lookupColumn "x" f1 `shouldBe` Just (ColNum [99])++ it "frameLength is the longest column" $ do+ let f =+ addColumn "short" (ColNum [1]) $+ addColumn "long" (ColNum [1, 2, 3]) emptyFrame+ frameLength f `shouldBe` 3++ describe "Granite.Format" $ do+ it "FormatPrecision 2 uses fixed notation" $+ runFormatter (FormatPrecision 2) 3.14159 `shouldBe` "3.14"+ it "FormatPercent 1 multiplies by 100" $+ runFormatter (FormatPercent 1) 0.345 `shouldBe` "34.5%"+ it "FormatComma groups thousands" $+ runFormatter FormatComma 1234567 `shouldBe` "1,234,567"+ it "FormatSI uses k for thousands" $+ Text.isInfixOf "k" (runFormatter FormatSI 1500) `shouldBe` True+ it "FormatSI uses M for millions" $+ Text.isInfixOf "M" (runFormatter FormatSI 2_500_000) `shouldBe` True
+ test/StatSpec.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}++module StatSpec (spec) where++import Granite.Spec (BinSpec (..), SummaryFun (..))+import Granite.Stat (+ BoxStats (..),+ binData,+ boxplotSummary,+ countByCategory,+ kdeData,+ smoothLm,+ smoothMovingAvg,+ summarizeByCategory,+ )+import Test.Hspec++spec :: Spec+spec = describe "Granite.Stat" $ do+ describe "binData" $ do+ it "10 evenly-spaced values into 5 equal-width bins → counts of 2 each" $ do+ let xs = [0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5, 8.5, 9.5]+ (mids, counts) = binData (BinByCount 5) xs+ length mids `shouldBe` 5+ counts `shouldBe` [2, 2, 2, 2, 2]++ it "BinByWidth covers every input value" $ do+ let (_, counts) = binData (BinByWidth 1.0) [0, 0.5, 1.2, 1.8, 2.1]+ sum counts `shouldBe` 5++ it "BinByEdges respects manual breaks" $ do+ let (_, counts) = binData (BinByEdges [0, 1, 2, 3]) [0.5, 1.5, 2.5, 2.7]+ counts `shouldBe` [1, 1, 2]++ it "empty input → empty output" $+ binData (BinByCount 5) [] `shouldBe` ([], [])++ describe "kdeData" $ do+ it "produces n grid points" $ do+ let (gx, gy) = kdeData 64 [0, 1, 2, 3, 4, 5]+ length gx `shouldBe` 64+ length gy `shouldBe` 64++ it "all density values are non-negative" $ do+ let (_, gy) = kdeData 32 [0, 1, 2, 3, 4, 5]+ all (>= 0) gy `shouldBe` True++ describe "smoothLm" $ do+ it "fits a perfect line exactly" $ do+ let xs = [0, 1, 2, 3, 4]+ ys = [1, 3, 5, 7, 9]+ fitted = smoothLm xs ys+ all (< 1e-9) (zipWith (\a b -> abs (a - b)) ys fitted) `shouldBe` True++ describe "smoothMovingAvg" $ do+ it "window of 1 is identity" $+ smoothMovingAvg 1 [1, 2, 3, 4, 5] `shouldBe` [1, 2, 3, 4, 5]++ it "window of 3 on a constant signal preserves the constant" $+ all (== 3) (smoothMovingAvg 3 [3, 3, 3, 3, 3]) `shouldBe` True++ describe "boxplotSummary" $ do+ it "[1..9] → min=1, Q1=3, med=5, Q3=7, max=9" $ do+ let bs = boxplotSummary [1 .. 9]+ yMin bs `shouldBe` 1+ q1 bs `shouldBe` 3+ med bs `shouldBe` 5+ q3 bs `shouldBe` 7+ yMax bs `shouldBe` 9++ describe "countByCategory" $ do+ it "preserves first-seen order" $+ countByCategory ["b", "a", "b", "c", "a"]+ `shouldBe` [("b", 2), ("a", 2), ("c", 1)]++ describe "summarizeByCategory" $ do+ it "mean per group" $+ summarizeByCategory SumMean [("a", 1), ("a", 3), ("b", 10), ("b", 20)]+ `shouldBe` [("a", 2.0), ("b", 15.0)]++ it "sum per group" $+ summarizeByCategory SumSum [("a", 1), ("a", 3), ("b", 10), ("b", 20)]+ `shouldBe` [("a", 4.0), ("b", 30.0)]++ it "median per group" $+ summarizeByCategory+ SumMedian+ [("a", 1), ("a", 2), ("a", 3), ("b", 10), ("b", 20), ("b", 30)]+ `shouldBe` [("a", 2.0), ("b", 20.0)]