granite 0.7.3.1 → 0.7.4.0
raw patch · 5 files changed
+435/−1 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Granite: gauss :: [Double] -> [(Text, Double)] -> Plot -> Text
+ Granite.Svg: gauss :: [Double] -> [(Text, Double)] -> Plot -> Text
Files
- CHANGELOG.md +4/−0
- app/Main.hs +37/−0
- granite.cabal +1/−1
- src/Granite.hs +217/−0
- src/Granite/Svg.hs +176/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for granite +## 0.7.4.0 -- 2026-07-01+* Fix exponentiation to work with MicroHs+* Add gauss bell plus standard deviation charts+ ## 0.7.3.1 -- 2026-06-22 * Fix kde computation of average
app/Main.hs view
@@ -197,6 +197,43 @@ ] defPlot{widthChars = 60, heightChars = 18, plotTitle = "Distribution"} + section "Gauss — where the stars sit on the curve (g + a per 90)"+ -- A synthetic right-skewed "every attacker" population: most players cluster+ -- low, a long thin tail of elite finishers. Each value is goals+assists per 90.+ let population =+ concat+ [ replicate count value+ | (count, value) <-+ [ (40, 0.05)+ , (90, 0.12)+ , (120, 0.20)+ , (110, 0.28)+ , (80, 0.36)+ , (55, 0.45)+ , (35, 0.55)+ , (20, 0.66)+ , (10, 0.78)+ , (6, 0.90)+ , (3, 1.02)+ ]+ ]+ stars =+ [ ("Lewandowski", 0.95)+ , ("Mbappé", 0.92)+ , ("Haaland", 1.05)+ , ("Ronaldo", 1.10)+ , ("Messi", 1.45)+ ]+ Text.IO.putStrLn $+ gauss+ population+ stars+ defPlot+ { widthChars = 72+ , heightChars = 22+ , plotTitle = "every attacker, top-5 leagues · goals + assists per 90"+ }+ section :: Text -> IO () section name = do Text.IO.putStrLn ""
granite.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: granite-version: 0.7.3.1+version: 0.7.4.0 synopsis: Easy terminal plotting. description: A terminal plotting library for quick and easy visualisation. license: MIT
src/Granite.hs view
@@ -85,6 +85,7 @@ polarLine, waterfall, distPlot,+ gauss, -- * Differential flame graphs FlameNode (..),@@ -1204,3 +1205,219 @@ distPlot sers cfg = renderChartTerminal $ LC.distPlotChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++{- | Gaussian / normal-distribution chart in standard-deviation (z-score) units.++Given a population sample, 'gauss' computes the mean (μ) and standard deviation+(σ), draws the kernel-density estimate of the distribution as a stippled bell+curve, and annotates named markers at their z-score positions. The marker with+the largest z-score is highlighted as the outlier.++This reproduces the "where does X sit on the curve?" style of chart: a smooth+density curve filled with scattered dots, an x-axis labelled in σ units, and+lollipop annotations dropping from each named value down to the axis.++==== __Example__++@+let -- goals + assists per 90 for every attacker in the league+ population = ...+ stars =+ [ ("Lewandowski", 1.05)+ , ("Mbappé", 1.02)+ , ("Haaland", 1.10)+ , ("Ronaldo", 1.12)+ , ("Messi", 1.45)+ ]+chart = gauss population stars defPlot{plotTitle = "g + a per 90"}+@+-}+gauss ::+ -- | Population sample (used to compute μ and σ)+ [Double] ->+ -- | Named markers as @(label, raw value)@; the largest z is highlighted+ [(Text, Double)] ->+ -- | Plot configuration+ Plot ->+ -- | Rendered chart as Text+ Text+gauss population markers cfg =+ let n = length population+ mu = if n == 0 then 0 else sum population / fromIntegral n+ var =+ if n < 2+ then 0+ else sum [(x - mu) ^ (2 :: Int) | x <- population] / fromIntegral (n - 1)+ sigma = sqrt (max var eps)+ z v = (v - mu) / sigma++ zsData = map z population+ zsMark = [(name, z v) | (name, v) <- markers]+ maxMarkerZ = maximum' (0 : [zz | (_, zz) <- zsMark])++ -- z-space domain, with a little padding.+ allZ = zsData <> [zz | (_, zz) <- zsMark]+ zlo0 = minimum' (0 : allZ)+ zhi0 = maximum' (1 : allZ)+ padz = (zhi0 - zlo0) * 0.06 + 1e-9+ zmin = zlo0 - padz+ zmax = zhi0 + padz+ zspan = zmax - zmin + eps++ wC = widthChars cfg+ hC = heightChars cfg+ wDots = wC * 2+ hDots = hC * 4+ left = leftMargin cfg++ -- Gaussian KDE in z-space (Silverman bandwidth).+ sdz =+ let m = sum zsData / fromIntegral (max 1 n)+ in sqrt (max eps (sum [(zz - m) ^ (2 :: Int) | zz <- zsData] / fromIntegral (max 1 (n - 1))))+ hbw = max 1e-6 (1.06 * sdz * fromIntegral (max 1 n) ** (-0.2))+ dens x =+ sum [exp (negate ((x - zz) ^ (2 :: Int)) / (2 * hbw * hbw)) | zz <- zsData]+ / (fromIntegral (max 1 n) * hbw * sqrt (2 * pi))++ xAtDot xd = zmin + (fromIntegral xd / fromIntegral (max 1 (wDots - 1))) * zspan+ colDens = [dens (xAtDot xd) | xd <- [0 .. wDots - 1]]+ dmax = maximum' colDens + eps++ -- Curve fills up to ~90% of the canvas height at its peak.+ topFrac = 0.9+ yTopOf d =+ clamp 0 (hDots - 1) $+ round (fromIntegral (hDots - 1) * (1 - (d / dmax) * topFrac))++ -- Deterministic stipple so the fill looks scattered but is reproducible.+ inkStip xd yd =+ let a = xd * 374761393 + (yd + 1) * 668265263+ b = (a `xor` (a `div` 13)) * 1274126177+ in (abs b `mod` 100) < 46++ -- Map a z value to a dot column / character column.+ sxz zz = clamp 0 (wDots - 1) (round ((zz - zmin) / zspan * fromIntegral (wDots - 1)))+ sxChar zz = left + 1 + sxz zz `div` 2++ curveCol = BrightWhite+ fillCol = BrightBlack+ meanCol = BrightBlack++ -- Stipple under the curve + draw the curve outline.+ canvas0 = newCanvas wC hC+ drawCol c (xd, d) =+ let yt = yTopOf d+ c1 = setDotC c xd yt (Just curveCol)+ in List.foldl'+ (\cc yd -> if inkStip xd yd then setDotC cc xd yd (Just fillCol) else cc)+ c1+ [yt + 1 .. hDots - 1]+ cFilled = List.foldl' drawCol canvas0 (zip [0 ..] colDens)++ -- Faint dashed guide at the mean (z = 0), if it is inside the domain.+ cMean =+ if zmin <= 0 && zmax >= 0+ then+ let xd0 = sxz 0+ in List.foldl'+ (\cc yd -> if yd `mod` 4 < 2 then setDotC cc xd0 yd (Just meanCol) else cc)+ cFilled+ [0 .. hDots - 1]+ else cFilled++ -- Lollipop leader lines for each marker (highlighted one is brighter).+ markerColor zz = if zz >= maxMarkerZ - eps then BrightMagenta else BrightCyan+ drawMarker c (_name, zz) =+ let xd = sxz zz+ col = markerColor zz+ c1 = lineDotsC (xd, hDots - 1) (xd, 0) (Just col) c+ in if zz >= maxMarkerZ - eps+ then+ List.foldl'+ (\cc (ax, ay) -> setDotC cc ax ay (Just col))+ c1+ [ (xd + dx, hDots - 1 + dy)+ | dx <- [-1, 0, 1]+ , dy <- [-1, 0]+ ]+ else c1+ cMarked = List.foldl' drawMarker cMean zsMark++ -- Plot body: blank y-axis gutter + axis bar + canvas.+ plotLines =+ [ Text.replicate left " " <> "│" <> ln+ | ln <- Text.lines (renderCanvas cMarked)+ ]++ -- Annotation band above the plot: marker labels stacked to avoid overlap.+ -- Enough rows that tightly clustered tail markers each get their own line.+ annRows = max 1 (min 6 (length zsMark))+ chartW = left + 1 + wC+ sigmaTxt zz = Text.pack (showFFloat (Just 1) zz "") <> "σ"+ sortedM = List.sortOn (\(_, zz) -> sxz zz) zsMark+ assign occ acc [] = (occ, acc)+ assign occ acc ((name, zz) : rest) =+ let lbl = name <> " " <> sigmaTxt zz+ w = wcswidth lbl+ center = sxChar zz+ start = clamp 0 (max 0 (chartW - w)) (center - w `div` 2)+ end = start + w+ fits r = all (\(s, e) -> end + 1 <= s || start >= e + 1) (occ !! r)+ row = case filter fits [0 .. annRows - 1] of+ (r : _) -> r+ [] -> annRows - 1+ occ' = updateAt occ row ((start, end) :)+ in assign occ' ((row, start, lbl, markerColor zz) : acc) rest+ (_, placements) = assign (replicate annRows []) [] sortedM+ baseCells = replicate chartW (' ', Nothing)+ putLabel grid (row, start, lbl, col) =+ updateAt grid row $ \cells ->+ List.foldl'+ (\cs (i, ch) -> setAt cs (start + i) (ch, Just col))+ cells+ (zip [0 ..] (Text.unpack lbl))+ annGrid = List.foldl' putLabel (replicate annRows baseCells) placements+ renderCells =+ Text.concat+ . map (\(ch, mc) -> maybe (Text.singleton ch) (`paint` ch) mc)+ annLines = if null zsMark then [] else map renderCells annGrid++ -- σ x-axis: an integer tick for each standard deviation in range.+ xBar = Text.replicate left " " <> "└" <> Text.replicate wC "─"+ sigInts = [k | k <- [ceiling zmin .. floor zmax :: Int], k /= 0]+ xTickPlacements =+ [ (max 0 (sxChar (fromIntegral k) - wcswidth lbl `div` 2), lbl)+ | k <- sigInts+ , let lbl = Text.pack (show k) <> "σ"+ ]+ xLine = placeLabels (Text.replicate chartW " ") 0 xTickPlacements+ avgLine =+ if zmin <= 0 && zmax >= 0+ then+ let lbl = "average" :: Text+ start = clamp 0 (max 0 (chartW - wcswidth lbl)) (sxChar 0 - wcswidth lbl `div` 2)+ in [placeLabels (Text.replicate chartW " ") 0 [(start, lbl)]]+ else []++ showD2 v = Text.pack (showFFloat (Just 2) v "")+ footer =+ Text.replicate left " "+ <> "μ="+ <> showD2 mu+ <> " σ="+ <> showD2 sigma+ <> ( case List.sortOn (negate . snd) zsMark of+ ((hiName, hiZ) : _) ->+ " "+ <> Text.concat (map (paint BrightMagenta) (Text.unpack ("◆ " <> hiName <> " " <> sigmaTxt hiZ)))+ [] -> ""+ )++ allLines =+ filter (not . Text.null) [plotTitle cfg]+ <> annLines+ <> plotLines+ <> [xBar, xLine]+ <> avgLine+ <> [footer]+ in Text.unlines allLines
src/Granite/Svg.hs view
@@ -36,6 +36,7 @@ polarLine, waterfall, distPlot,+ gauss, ) where import Data.List qualified as List@@ -706,3 +707,178 @@ distPlot sers cfg = renderChartSvg $ LC.distPlotChart sers (widthChars cfg) (heightChars cfg) (plotTitle cfg)++-- | Gaussian / normal-distribution chart in standard-deviation (z-score) units.+-- Mirrors 'Granite.gauss': a KDE bell curve with a stippled scatter fill, an+-- x-axis labelled in σ units, and lollipop annotations for named markers+-- (the largest z highlighted as the outlier).+gauss ::+ -- | Population sample (used to compute μ and σ)+ [Double] ->+ -- | Named markers as @(label, raw value)@; the largest z is highlighted+ [(Text, Double)] ->+ Plot ->+ Text+gauss population markers cfg =+ let n = length population+ mu = if n == 0 then 0 else sum population / fromIntegral n+ var =+ if n < 2+ then 0+ else sum [(x - mu) ^ (2 :: Int) | x <- population] / fromIntegral (n - 1)+ sigma = sqrt (max var eps)+ z v = (v - mu) / sigma++ zsData = map z population+ zsMark = [(name, z v) | (name, v) <- markers]+ maxMarkerZ = maximum' (0 : [zz | (_, zz) <- zsMark])++ allZ = zsData <> [zz | (_, zz) <- zsMark]+ zlo0 = minimum' (0 : allZ)+ zhi0 = maximum' (1 : allZ)+ padz = (zhi0 - zlo0) * 0.06 + 1e-9+ zmin = zlo0 - padz+ zmax = zhi0 + padz++ -- Gaussian KDE in z-space (Silverman bandwidth).+ sdz =+ let m = sum zsData / fromIntegral (max 1 n)+ in sqrt (max eps (sum [(zz - m) ^ (2 :: Int) | zz <- zsData] / fromIntegral (max 1 (n - 1))))+ hbw = max 1e-6 (1.06 * sdz * fromIntegral (max 1 n) ** (-0.2))+ dens x =+ sum [exp (negate ((x - zz) ^ (2 :: Int)) / (2 * hbw * hbw)) | zz <- zsData]+ / (fromIntegral (max 1 n) * hbw * sqrt (2 * pi))++ lay = mkLayout cfg+ baseY = plotY lay + plotH lay+ mx = mapX lay zmin zmax++ nGrid = max 8 (widthChars cfg * 3)+ zAt i = zmin + fromIntegral i / fromIntegral nGrid * (zmax - zmin)+ densVals = [dens (zAt i) | i <- [0 .. nGrid]]+ dmax = maximum' densVals + eps+ topFrac = 0.9+ densToY d = baseY - (d / dmax) * topFrac * plotH lay++ curvePts = [(mx (zAt i), densToY d) | (i, d) <- zip [0 :: Int ..] densVals]++ -- Light fill under the curve.+ fillPath =+ svgPath+ ( "M "+ <> showD (fst (head curvePts))+ <> " "+ <> showD baseY+ <> " "+ <> T.concat ["L " <> showD x <> " " <> showD y <> " " | (x, y) <- curvePts]+ <> "L "+ <> showD (fst (last curvePts))+ <> " "+ <> showD baseY+ <> " Z"+ )+ "#dfe4e8"+ (attr "fill-opacity" "0.6")+ curveStroke = svgPolyline curvePts "#5b6770" 2++ -- Faint dashed guide at the mean (z = 0).+ meanLine+ | zmin <= 0 && zmax >= 0 =+ "<line"+ <> attr "x1" (showD (mx 0))+ <> attr "y1" (showD (plotY lay))+ <> attr "x2" (showD (mx 0))+ <> attr "y2" (showD baseY)+ <> attr "stroke" "#cfd6dc"+ <> attr "stroke-width" "1"+ <> attr "stroke-dasharray" "3 4"+ <> "/>\n"+ | otherwise = ""++ -- Deterministic scatter fill, dot count per column ∝ curve height.+ nx = max 4 (widthChars cfg)+ cellPx = 14 :: Double+ hashI a = let b = a * 1103515245 + 12345 in b * 1103515245 + 12345+ frac k = fromIntegral (abs (hashI k) `mod` 1000) / 1000+ dots =+ T.concat+ [ let zc = zmin + (fromIntegral gx + 0.5) / fromIntegral nx * (zmax - zmin)+ cxc = mx zc+ yTop = densToY (dens zc)+ colHpx = baseY - yTop+ rowsHere = max 0 (floor (colHpx / cellPx)) :: Int+ in T.concat+ [ let kk = gx * 1000 + gy+ in if abs (hashI (kk * 31 + 7)) `mod` 100 >= 78+ then ""+ else+ let jx = (frac (kk * 3 + 1) - 0.5) * (plotW lay / fromIntegral nx)+ jy = (frac (kk * 5 + 2) - 0.5) * cellPx+ dx = cxc + jx+ dy = yTop + (fromIntegral gy + 0.5) / fromIntegral (max 1 rowsHere) * colHpx + jy+ in svgCircle dx dy 1.3 "#aeb4bb"+ | gy <- [0 .. rowsHere - 1]+ ]+ | gx <- [0 .. nx - 1]+ ]++ -- σ x-axis: a tick for each integer standard deviation in range.+ xBaseline = svgLine (plotX lay) baseY (plotX lay + plotW lay) baseY "#aaa" 1+ sigInts = [k | k <- [ceiling zmin .. floor zmax :: Int], k /= 0]+ xticks =+ T.concat+ [ let xx = mx (fromIntegral k)+ in svgLine xx baseY xx (baseY + 5) "#aaa" 1+ <> svgText xx (baseY + 18) "middle" "#777" labelFontSize (T.pack (show k) <> "σ")+ | k <- sigInts+ ]+ avgLbl+ | zmin <= 0 && zmax >= 0 =+ svgText (mx 0) (baseY + 18) "middle" "#999" labelFontSize "average"+ <> svgText (mx 0) (baseY + 32) "middle" "#bbb" (labelFontSize - 1) (T.pack (showFFloat (Just 2) mu ""))+ | otherwise = ""++ -- Lollipop annotations, stacked into lanes so labels never overlap.+ sigmaTxt zz = T.pack (showFFloat (Just 1) zz "") <> "σ"+ lblOf (name, zz) = name <> " " <> sigmaTxt zz+ wpx s = fromIntegral (T.length s) * 6.2+ sortedM = List.sortOn (\(_, zz) -> mx zz) zsMark+ updLane occ i v =+ let need = i + 1 - length occ+ occ' = if need > 0 then occ <> replicate need (-1 / 0) else occ+ in [if j == i then v else e | (j, e) <- zip [0 ..] occ']+ place _ [] = []+ place occ ((name, zz) : rest) =+ let s = lblOf (name, zz)+ cx = mx zz+ start = cx - wpx s / 2+ pick es i = case es of+ [] -> i+ (e : es') -> if start > e + 6 then i else pick es' (i + 1)+ row = pick occ 0+ in (row, name, zz, s) : place (updLane occ row (cx + wpx s / 2)) rest+ placed = place [] sortedM++ anchorFor cx+ | cx > plotX lay + plotW lay * 0.82 = "end"+ | cx < plotX lay + plotW lay * 0.18 = "start"+ | otherwise = "middle"++ markerEls =+ T.concat+ [ let cx = mx zz+ isHi = zz >= maxMarkerZ - eps+ col = if isHi then "#ff2e88" else "#3a86c8"+ labelY = plotY lay + 12 + fromIntegral row * 15+ fontSz = if isHi then labelFontSize + 2 else labelFontSize+ in svgLine cx baseY cx (labelY + 4) col (if isHi then 1.8 else 1)+ <> svgCircle cx baseY (if isHi then 6 else 3) col+ <> svgText cx labelY (anchorFor cx) col fontSz s+ | (row, _name, zz, s) <- placed+ ]++ title = drawTitle cfg lay+ in svgDoc+ (svgW lay)+ (svgH lay)+ (title <> fillPath <> meanLine <> dots <> curveStroke <> xBaseline <> xticks <> avgLbl <> markerEls)