diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,8 @@ # Revision history for granite +## 0.2.0.2 -- 2025-08-30 +* Add plot option to define the format of labels on both axes. + ## 0.2.0.1 -- 2025-08-26 * Loosen bounds for text diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ # Granite -A library for producing terminal plots. It depends only on Haskell's base and text (only for efficieny but it could use `String`) packages so it should be easy to use and install. +A library for producing terminal plots. It depends only on Haskell's base and text (only for efficieny 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. # Supported graph types @@ -18,12 +18,10 @@ ![Scatter Plot](https://github.com/mchav/granite/blob/main/static/scatter_plot.png) ```haskell -{-# LANGUAGE OverloadedStrings #-} import Control.Monad -import qualified Data.Text.IO as T import System.Random.Stateful -import Granite +import Granite.String main :: IO () main = do @@ -33,8 +31,8 @@ ptsA_y <- replicateM 600 (uniformRM range g) ptsB_x <- replicateM 600 (uniformRM range g) ptsB_y <- replicateM 600 (uniformRM range g) - T.putStrLn (scatter "Random points" [series "A" (zip ptsA_x ptsA_y), series "B" (zip ptsB_x ptsB_y)] - defPlot{widthChars=68,heightChars=22,plotTitle="Random points"}) + putStrLn (scatter "Random points" [series "A" (zip ptsA_x ptsA_y), series "B" (zip ptsB_x ptsB_y)] + defPlot{widthChars=68,heightChars=22,plotTitle="Random points"}) ``` ### Bar chart diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,59 +1,83 @@ {-# LANGUAGE OverloadedStrings #-} + module Main where import Control.Monad -import System.Random.Stateful +import Data.Text qualified as Text import Data.Text.IO qualified as Text +import System.Random.Stateful import Granite main :: IO () main = do - -- scatter - g <- newIOGenM =<< newStdGen - let range = (0 :: Double, 1 :: Double) - ptsA_x <- replicateM 600 (uniformRM range g) - ptsA_y <- replicateM 600 (uniformRM range g) - ptsB_x <- replicateM 600 (uniformRM range g) - ptsB_y <- replicateM 600 (uniformRM range g) - 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"} + -- scatter + g <- newIOGenM =<< newStdGen + let range = (0 :: Double, 1 :: Double) + ptsA_x <- replicateM 600 (uniformRM range g) + ptsA_y <- replicateM 600 (uniformRM range g) + ptsB_x <- replicateM 600 (uniformRM range g) + ptsB_y <- replicateM 600 (uniformRM range g) + 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"} - -- histogram - heights <- replicateM 5000 (uniformRM (160 :: Double, 190 :: Double) g) - Text.putStrLn $ histogram (bins 30 155 195) heights defPlot{widthChars=68,heightChars=18,legendPos=LegendBottom, plotTitle="Heights (cm)"} + -- histogram + heights <- replicateM 5000 (uniformRM (160 :: Double, 190 :: Double) g) + Text.putStrLn $ + histogram + (bins 30 155 195) + heights + defPlot + { widthChars = 68 + , heightChars = 18 + , legendPos = LegendBottom + , xFormatter = \_ v -> Text.pack (show (round v)) + , plotTitle = "Heights (cm)" + } - -- bars - Text.putStrLn $ bars [("Q1",12),("Q2",18),("Q3",9),("Q4",15)] defPlot { plotTitle = "Sales"} + -- bars + Text.putStrLn $ bars [("Q1", 12), ("Q2", 18), ("Q3", 9), ("Q4", 15)] defPlot{plotTitle = "Sales"} - -- pie - Text.putStrLn $ pie [("Alpha",0.35),("Beta",0.25),("Gamma",0.20),("Delta",0.20)] - defPlot{widthChars=46,heightChars=18,legendPos=LegendRight, plotTitle = "Share"} + -- pie + Text.putStrLn $ + pie + [("Alpha", 0.35), ("Beta", 0.25), ("Gamma", 0.20), ("Delta", 0.20)] + defPlot{widthChars = 46, heightChars = 18, legendPos = LegendRight, 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)]) - ] defPlot { plotTitle = "Monthly Sales Trends"} - - -- box plot - Text.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]) - , ("Class C", [88, 92, 95, 90, 93, 89, 91, 94, 96, 87, 90, 92]) - , ("Class D", [65, 70, 72, 68, 75, 80, 73, 71, 69, 74, 77, 76]) - ] 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)]) - ] defPlot { plotTitle = "Quarterly Revenue Breakdown"} - - -- 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] - ] - Text.putStrLn $ heatmap matrix defPlot { plotTitle = "Correlation Matrix" } + -- 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)]) + ] + defPlot{plotTitle = "Monthly Sales Trends"} + + -- box plot + Text.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]) + , ("Class C", [88, 92, 95, 90, 93, 89, 91, 94, 96, 87, 90, 92]) + , ("Class D", [65, 70, 72, 68, 75, 80, 73, 71, 69, 74, 77, 76]) + ] + 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)]) + ] + defPlot{plotTitle = "Quarterly Revenue Breakdown"} + + -- 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] + ] + Text.putStrLn $ heatmap matrix defPlot{plotTitle = "Correlation Matrix"} diff --git a/granite.cabal b/granite.cabal --- a/granite.cabal +++ b/granite.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: granite -version: 0.2.0.1 +version: 0.2.0.2 synopsis: Easy terminal plotting. description: A terminal plotting library for quick and easy visualisation. license: MIT @@ -35,7 +35,8 @@ library import: ghc-options - exposed-modules: Granite + exposed-modules: Granite, + Granite.String build-depends: base >=4 && <5, text >= 1 && < 3 diff --git a/src/Granite.hs b/src/Granite.hs --- a/src/Granite.hs +++ b/src/Granite.hs @@ -1,1026 +1,1231 @@ -{-# LANGUAGE StrictData #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} - --- | --- Module : Granite --- Copyright : (c) 2025 --- License : MIT --- Maintainer : mschavinda@gmail.com --- Stability : experimental --- Portability : POSIX --- --- A terminal-based plotting library that renders beautiful charts using Unicode --- Braille characters and ANSI colors. Granite provides a variety of chart types --- including scatter plots, line graphs, bar charts, pie charts, histograms, --- heatmaps, and box plots. --- --- = Basic Usage --- --- Create a simple scatter plot: --- --- @ --- {-# LANGUAGE OverloadedStrings #-} --- import Granite --- import Data.Text.IO as T --- --- main = do --- let points = [(x, sin x) | x <- [0, 0.1 .. 6.28]] --- chart = scatter [series "sin(x)" points] defPlot --- T.putStrLn chart --- @ --- --- = Customization --- --- Plots can be customized using record update syntax: --- --- @ --- let customPlot = defPlot --- { widthChars = 80 --- , heightChars = 30 --- , plotTitle = "My Chart" --- , legendPos = LegendBottom --- } --- @ --- --- = Terminal Requirements --- --- This library requires a terminal that supports: --- --- * Unicode (specifically Braille patterns U+2800-U+28FF) --- * ANSI color codes --- * Monospace font with proper Braille character rendering - -module Granite - ( - -- * Plot Configuration - Plot(..), defPlot, LegendPos(..) - -- * Data Preparation - , series - , bins - -- * Chart Types - , histogram - , bars - , scatter - , pie - , stackedBars - , heatmap - , lineGraph - , boxPlot - ) where - -import Data.Bits ((.&.), (.|.), xor) -import Data.Char (chr) -import Data.List qualified as List -import Data.Maybe -import Data.Text (Text) -import Data.Text qualified as Text -import Numeric (showFFloat, showEFloat) -import Text.Printf - --- | Position of the legend in the plot. -data LegendPos - = LegendRight -- ^ Display legend on the right side of the plot - | LegendBottom -- ^ Display legend below the plot - deriving (Eq, Show) - --- | Plot configuration parameters. --- --- Controls the appearance and layout of generated charts. -data Plot = Plot - { widthChars :: Int - -- ^ Width of the plot area in terminal characters (default: 60) - , heightChars :: Int - -- ^ Height of the plot area in terminal characters (default: 20) - , leftMargin :: Int - -- ^ Space reserved for y-axis labels (default: 6) - , bottomMargin :: Int - -- ^ Space reserved for x-axis labels (default: 2) - , titleMargin :: Int - -- ^ Space above the plot for the title (default: 1) - , xBounds :: (Maybe Double, Maybe Double) - -- ^ Optional manual x-axis bounds (min, max). - -- 'Nothing' uses automatic bounds with 5% padding. - , yBounds :: (Maybe Double, Maybe Double) - -- ^ Optional manual y-axis bounds (min, max). - -- 'Nothing' uses automatic bounds with 5% padding. - , plotTitle :: Text - -- ^ Title displayed above the plot (default: empty) - , legendPos :: LegendPos - -- ^ Position of the legend (default: 'LegendRight') - } deriving (Eq, Show) - --- | Default plot configuration. --- --- Creates a 60×20 character plot with reasonable defaults: --- --- @ --- defPlot = Plot --- { widthChars = 60 --- , heightChars = 20 --- , leftMargin = 6 --- , bottomMargin = 2 --- , titleMargin = 1 --- , xBounds = (Nothing, Nothing) --- , yBounds = (Nothing, Nothing) --- , plotTitle = "" --- , legendPos = LegendRight --- } --- @ -defPlot :: Plot -defPlot = Plot - { widthChars = 60 - , heightChars = 20 - , leftMargin = 6 - , bottomMargin = 2 - , titleMargin = 1 - , xBounds = (Nothing, Nothing) - , yBounds = (Nothing, Nothing) - , plotTitle = "" - , legendPos = LegendRight - } - --- | Create a named data series for multi-series plots. --- --- @ --- let s1 = series "Dataset A" [(1,2), (2,4), (3,6)] --- s2 = series "Dataset B" [(1,3), (2,5), (3,7)] --- chart = scatter [s1, s2] defPlot --- @ -series :: Text -- ^ Name of the series (appears in legend) - -> [(Double, Double)] -- ^ List of (x, y) data points - -> (Text, [(Double, Double)]) -series = (,) - --- | Create a scatter plot from multiple data series. --- --- Each series is rendered with a different color and pattern. --- Points are plotted using Braille characters for sub-character resolution. --- --- ==== __Example__ --- --- @ --- let points1 = [(x, x^2) | x <- [-3, -2.5 .. 3]] --- points2 = [(x, 2*x + 1) | x <- [-3, -2.5 .. 3]] --- chart = scatter [series "y = x²" points1, --- series "y = 2x + 1" points2] defPlot --- @ -scatter :: [(Text, [(Double, Double)])] -- ^ List of named data series - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -scatter sers cfg = - let wC = widthChars cfg; hC = heightChars cfg - plotC = newCanvas wC hC - (xmin,xmax,ymin,ymax) = boundsXY cfg (concatMap snd sers) - sx x = clamp 0 (wC*2-1) $ round ((x - xmin) / (xmax - xmin + eps) * fromIntegral (wC*2-1)) - sy y = clamp 0 (hC*4-1) $ round ((ymax - y) / (ymax - ymin + eps) * fromIntegral (hC*4-1)) - pats = cycle palette - cols = cycle paletteColors - withSty = zipWith3 (\(n,ps) p c -> (n,ps,p,c)) sers pats cols - drawOne (_name, pts, pat, col) c0 = - List.foldl' (\c (x,y) -> let xd = sx x; yd = sy y - in if ink pat xd yd then setDotC c xd yd (Just col) else c) - c0 pts - cDone = List.foldl' (flip drawOne) plotC withSty - ax = axisify cfg cDone (xmin,xmax) (ymin,ymax) - legend = legendBlock (legendPos cfg) (leftMargin cfg + widthChars cfg) - [ (n,p, col) | (n,_,p,col) <- withSty ] - in drawFrame cfg ax legend - --- | Create a line graph connecting data points. --- --- Similar to 'scatter' but connects consecutive points with lines. --- Points are automatically sorted by x-coordinate before connecting. --- --- ==== __Example__ --- --- @ --- let sine = [(x, sin x) | x <- [0, 0.1 .. 2*pi]] --- cosine = [(x, cos x) | x <- [0, 0.1 .. 2*pi]] --- chart = lineGraph [series "sin" sine, series "cos" cosine] defPlot --- @ -lineGraph :: [(Text, [(Double, Double)])] -- ^ List of named data series - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -lineGraph sers cfg = - let wC = widthChars cfg; hC = heightChars cfg - plotC = newCanvas wC hC - (xmin,xmax,ymin,ymax) = boundsXY cfg (concatMap snd sers) - sx x = clamp 0 (wC*2-1) $ round ((x - xmin) / (xmax - xmin + eps) * fromIntegral (wC*2-1)) - sy y = clamp 0 (hC*4-1) $ round ((ymax - y) / (ymax - ymin + eps) * fromIntegral (hC*4-1)) - - cols = cycle paletteColors - withSty = zip sers cols - - drawSeries ((_name, pts), col) c0 = - let sortedPts = List.sortOn fst pts - dotPairs = zip sortedPts (drop 1 sortedPts) - in List.foldl' (\c ((x1,y1), (x2,y2)) -> - lineDotsC (sx x1, sy y1) (sx x2, sy y2) (Just col) c) - c0 dotPairs - - cDone = List.foldl' (flip drawSeries) plotC withSty - ax :: Text - ax = axisify cfg cDone (xmin,xmax) (ymin,ymax) - legend :: Text - legend = legendBlock (legendPos cfg) (leftMargin cfg + widthChars cfg) - [(n, Solid, col) | ((n,_), col) <- withSty] - in drawFrame cfg ax legend - --- | Create a bar chart from categorical data. --- --- Each bar is colored differently and labeled with its category name. --- --- ==== __Example__ --- --- @ --- let data = [("Apple", 45.2), ("Banana", 38.1), ("Orange", 52.7)] --- chart = bars data defPlot { plotTitle = "Fruit Sales" } --- @ -bars :: [(Text, Double)] -- ^ List of (category, value) pairs - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -bars kvs cfg = - let wC = widthChars cfg - hC = heightChars cfg - vals = map snd kvs - vmax = maximum' (map abs vals) - - cats :: [(Text, Double, Color)] - cats = [ (name, abs v / vmax, col) - | ((name, v), col) <- zip kvs (cycle paletteColors) ] - - nCats = length cats - - (base, extra) = - if nCats == 0 then (0, 0) else (wC `div` nCats, wC - (wC `div` nCats) * nCats) - widths = [ base + (if i < extra then 1 else 0) | i <- [0..nCats-1] ] - - catGroups :: [[(String, Maybe Color)]] - catGroups = - [ replicate w (colGlyphs hC f, Just col) - | ((_, f, col), w) <- zip cats widths - ] - - gutterCol = (replicate hC ' ', Nothing) - columns = concat (List.intersperse [gutterCol] catGroups) - - grid :: [[(Char, Maybe Color)]] - grid = [ [ (glyphs !! y, mc) | (glyphs, mc) <- columns ] - | y <- [0 .. hC-1] ] - - ax = axisifyGrid cfg grid (0, fromIntegral (max 1 nCats)) (0, vmax) - legendWidth = leftMargin cfg + 1 + (gridWidth grid) - legend = legendBlock (legendPos cfg) legendWidth - [ (name, Checker, col) | (name, _, col) <- cats ] - in drawFrame cfg ax legend - --- | Create a stacked bar chart. --- --- Each category can have multiple stacked components. --- --- ==== __Example__ --- --- @ --- let data = [("Q1", [("Product A", 100), ("Product B", 150)]), --- ("Q2", [("Product A", 120), ("Product B", 180)])] --- chart = stackedBars data defPlot --- @ -stackedBars :: [(Text, [(Text, Double)])] -- ^ Categories with stacked components - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -stackedBars categories cfg = - let wC = widthChars cfg - hC = heightChars cfg - - seriesNames = case categories of - [] -> [] - (c:_) -> map fst (snd c) - - totals = [sum (map snd series') | (_, series') <- categories] - maxHeight = maximum (1e-12 : totals) - - nCats = length categories - (base, extra) = if nCats == 0 then (0, 0) - else (wC `div` nCats, wC - (wC `div` nCats) * nCats) - widths = [base + (if i < extra then 1 else 0) | i <- [0..nCats-1]] - - cols = cycle paletteColors - seriesColors = zip seriesNames cols - - - makeBar (_, series') width = - let cumHeights = scanl (+) 0 [v / maxHeight | (_, v) <- series'] - segments = zip3 (map fst series') cumHeights (drop 1 cumHeights) - - makeColumn :: [(Char, Maybe Color)] - makeColumn = - [ let heightFromBottom = fromIntegral (hC - y) / fromIntegral hC - findSegment [] = (' ', Nothing) - findSegment ((name, bottom, top):rest) = - if heightFromBottom > bottom && heightFromBottom <= top - then ('█', lookup name seriesColors) - else findSegment rest - in findSegment segments - | y <- [0..hC-1]] - in replicate width makeColumn - - gutterCol = replicate hC (' ', Nothing) - allBars = zipWith makeBar categories widths - columns = concat (List.intersperse [gutterCol] allBars) - - grid = [[col !! y | col <- columns] | y <- [0..hC-1]] - - ax :: Text - ax = axisifyGrid cfg grid (0, fromIntegral (max 1 nCats)) (0, maxHeight) - legend :: Text - legend = legendBlock (legendPos cfg) (leftMargin cfg + 1 + - (gridWidth grid)) - [(name, Solid, col) | (name, col) <- seriesColors] - in drawFrame cfg ax legend - -data Bins = Bins - { nBins :: Int - , lo :: Double - , hi :: Double - } deriving (Eq, Show) - --- | Create a bin configuration for histograms. --- --- @ --- bins 10 0 100 -- 10 bins from 0 to 100 --- bins 20 (-5) 5 -- 20 bins from -5 to 5 --- @ -bins :: Int -> Double -> Double -> Bins -bins n a b = Bins (max 1 n) (min a b) (max a b) - --- | Create a histogram from numerical data. --- --- Data is binned according to the provided 'Bins' configuration. --- --- ==== __Example__ --- --- @ --- import System.Random --- --- -- Generate random normal-like distribution --- let values = take 1000 $ randomRs (0, 100) gen --- chart = histogram (bins 20 0 100) values defPlot --- @ -histogram :: Bins -- ^ Binning configuration - -> [Double] -- ^ Raw data values to bin - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -histogram (Bins n a b) xs cfg = - let step = (b - a) / fromIntegral n - binIx x = clamp 0 (n-1) $ floor ((x - a) / step) - counts = List.foldl' (\acc x -> - if x < a || x > b then acc - else addAt acc (binIx x) 1) - (replicate n 0 :: [Int]) xs - maxC = fromIntegral (maximum (1:counts)) - fracs0 = [ fromIntegral c / maxC | c <- counts ] - - wData = widthChars cfg - hC = heightChars cfg - colsF = resampleToWidth wData fracs0 - - dataCols = [ (colGlyphs hC f, Just BrightCyan) | f <- colsF ] - gutterCol = (replicate hC ' ', Nothing) - columns = concat (List.intersperse [gutterCol] (map pure dataCols)) - - grid :: [[(Char, Maybe Color)]] - grid = [ [ (fst col !! y, snd col) | col <- columns ] - | y <- [0 .. hC-1] ] - - ax = axisifyGrid cfg grid (a,b) (0, fromIntegral (maximum (1:counts))) - legendWidth = leftMargin cfg + 1 + (gridWidth grid) - legend = legendBlock (legendPos cfg) legendWidth [("count", Solid, BrightCyan)] - in drawFrame cfg ax legend - --- | Create a pie chart showing proportions. --- --- Values are normalized to sum to 100%. Negative values are treated as zero. --- --- ==== __Example__ --- --- @ --- let data = [("Chrome", 65), ("Firefox", 20), ("Safari", 10), ("Other", 5)] --- chart = pie data defPlot { plotTitle = "Browser Market Share" } --- @ -pie :: [(Text, Double)] -- ^ List of (category, value) pairs - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -pie parts0 cfg = - let parts = normalize parts0 - wC = widthChars cfg; hC = heightChars cfg - plotC = newCanvas wC hC - wDots = wC*2; hDots = hC*4 - r = min (wDots `div` 2 - 2) (hDots `div` 2 - 2) - cx = wDots `div` 2 - cy = hDots `div` 2 - toAng p = p * 2*pi - wedges = scanl (\a (_,p) -> a + toAng p) 0 parts - angles = zip wedges (drop 1 wedges) - names = map fst parts - cols = cycle pieColors - withP :: [(Text, (Double, Double), Color)] - withP = zipWith3 (\n ang col -> (n,ang,col)) names angles cols - - drawOne (_name,(a0,a1),col) c0 = - let inside x y = - let dx = fromIntegral (x - cx) - dy = fromIntegral (cy - y) - rr2 = dx*dx + dy*dy - r2 = fromIntegral (r*r) - ang = atan2 dy dx `mod'` (2*pi) - in rr2 <= r2 && angleWithin ang a0 a1 - in fillDotsC (cx - r, cy - r) (cx + r, cy + r) (\x y -> inside x y) (Just col) c0 - - cDone = List.foldl' (flip drawOne) plotC withP - ax = axisify cfg cDone (0,1) (0,1) - legend = legendBlock (legendPos cfg) (leftMargin cfg + widthChars cfg) - [ (n, Solid, col) | (n,_,col) <- withP ] - in drawFrame cfg ax legend - --- | Create a heatmap visualization of a 2D matrix. --- --- Values are mapped to a color gradient from blue (low) to red (high). --- --- ==== __Example__ --- --- @ --- let matrix = [[x * y | x <- [1..10]] | y <- [1..10]] --- chart = heatmap matrix defPlot { plotTitle = "Multiplication Table" } --- @ -heatmap :: [[Double]] -- ^ 2D matrix of values (rows × columns) - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -heatmap matrix cfg = - let rows = length matrix - cols = gridWidth matrix - - allVals = concat matrix - vmin = if null allVals then 0 else minimum' allVals - vmax = if null allVals then 1 else maximum' allVals - vrange = vmax - vmin - - intensityColors = - [ Blue, BrightBlue, Cyan, BrightCyan, Green, BrightGreen, - Yellow, BrightYellow, Magenta, BrightRed, Red - ] - - colorForValue v = - if vrange < eps - then Green - else - let norm = clamp 0 1 ((v - vmin) / vrange) - idx = floor (norm * fromIntegral (length intensityColors - 1)) - idx' = clamp 0 (length intensityColors - 1) idx - in intensityColors !! idx' - - plotW = widthChars cfg - plotH = heightChars cfg - - displayGrid = - [ [ let - matrixRow = min (rows - 1) ((plotH - 1 - i) * rows `div` plotH) - matrixCol = min (cols - 1) (j * cols `div` plotW) - val = matrix !! matrixRow !! matrixCol - in ('█', Just (colorForValue val)) - | j <- [0..plotW-1]] - | i <- [0..plotH-1]] - - ax = axisifyGrid cfg displayGrid (0, fromIntegral cols - 1) (0, fromIntegral rows - 1) - - gradientLegend = (Text.pack $ printf "%.2f " vmin) <> - Text.concat (fmap (\col -> paint col '█') intensityColors) <> - (Text.pack $ printf " %.2f" vmax) - - in drawFrame cfg ax gradientLegend - --- | Create a box plot showing statistical distributions. --- --- Displays quartiles, median, and min/max values for each dataset. --- --- ==== __Example__ --- --- @ --- let data1 = [1.2, 2.3, 2.1, 3.4, 2.8, 4.1, 3.9] --- data2 = [5.1, 4.8, 6.2, 5.9, 7.1, 6.5, 5.5] --- chart = boxPlot [("Group A", data1), ("Group B", data2)] defPlot --- @ --- --- The box plot displays: --- --- * Box: First quartile (Q1) to third quartile (Q3) --- * Line inside box: Median (Q2) --- * Whiskers: Minimum and maximum values -boxPlot :: [(Text, [Double])] -- ^ Named datasets - -> Plot -- ^ Plot configuration - -> Text -- ^ Rendered chart as Text -boxPlot datasets cfg = - let wC = widthChars cfg - hC = heightChars cfg - - stats = [(name, quartiles vals) | (name, vals) <- datasets] - - allVals = concatMap snd datasets - ymin = if null allVals then 0 else minimum' allVals - abs (minimum' allVals) * 0.1 - ymax = if null allVals then 1 else maximum' allVals + abs (maximum' allVals) * 0.1 - - nBoxes = length datasets - boxWidth = if nBoxes == 0 then 1 else max 1 (wC `div` (nBoxes * 2)) - spacing = if nBoxes <= 1 then 0 else (wC - boxWidth * nBoxes) `div` (nBoxes - 1) - - scaleY v = clamp 0 (hC-1) $ round ((ymax - v) / (ymax - ymin + eps) * fromIntegral (hC-1)) - - emptyGrid = replicate hC (replicate wC (' ', Nothing)) - - drawBox grid (idx, (_name, (minV, q1, median, q3, maxV))) = - let xStart = idx * (boxWidth + spacing) - xMid = xStart + boxWidth `div` 2 - xEnd = xStart + boxWidth - 1 - - minRow = scaleY minV - q1Row = scaleY q1 - medRow = scaleY median - q3Row = scaleY q3 - maxRow = scaleY maxV - - col = pieColors !! (idx `mod` length pieColors) - - grid1 = drawVLine grid xMid minRow q1Row '│' (Just col) - grid2 = drawVLine grid1 xMid q3Row maxRow '│' (Just col) - - grid3 = drawHLine grid2 xStart xEnd q1Row '─' (Just col) - grid4 = drawHLine grid3 xStart xEnd q3Row '─' (Just col) - grid5 = drawVLine grid4 xStart q1Row q3Row '│' (Just col) - grid6 = drawVLine grid5 xEnd q1Row q3Row '│' (Just col) - - grid7 = drawHLine grid6 xStart xEnd medRow '═' (Just col) - - grid8 = setGridChar grid7 xMid minRow '┬' (Just col) - grid9 = setGridChar grid8 xMid maxRow '┴' (Just col) - in grid9 - - finalGrid = List.foldl' drawBox emptyGrid (zip [0..] stats) - - ax = axisifyGrid cfg finalGrid (0, fromIntegral nBoxes) (ymin, ymax) - legend = legendBlock (legendPos cfg) (leftMargin cfg + widthChars cfg) - [(name, Solid, pieColors !! (i `mod` length pieColors)) - | (i, (name, _)) <- zip [0..] stats] - in drawFrame cfg ax legend - where - drawVLine grid x y1 y2 ch col = - let yStart = min y1 y2 - yEnd = max y1 y2 - in List.foldl' (\g y -> setGridChar g x y ch col) grid [yStart..yEnd] - - drawHLine grid x1 x2 y ch col = - let xStart = min x1 x2 - xEnd = max x1 x2 - in List.foldl' (\g x -> setGridChar g x y ch col) grid [xStart..xEnd] - - setGridChar grid x y ch col = - if y >= 0 && y < length grid && x >= 0 && x < gridWidth grid - then take y grid <> [setAt (grid !! y) x (ch, col)] <> drop (y+1) grid - else grid - where setAt row i v = take i row <> [v] <> drop (i+1) row - -data Color - = Default | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White - | BrightBlack | BrightRed | BrightGreen | BrightYellow | BrightBlue - | BrightMagenta | BrightCyan | BrightWhite - deriving (Eq, Show) - -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 -ink Solid _ _ = True -ink Checker x y = ((x `xor` y) .&. 1) == 0 -ink DiagA x y = (x + y) `mod` 3 /= 1 -ink DiagB x y = (x - y) `mod` 3 /= 1 -ink Sparse x y = (x .&. 1 == 0) && (y `mod` 3 == 0) - -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 = xDot `div` 2 - cy = yDot `div` 4 - rx = xDot - 2*cx - ry = yDot - 4*cy - 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 = flip fmap [0..h-1] (\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) (\c -> paint c ch) mc) - 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 t = go 0 (Text.unpack t) - where - go acc [] = acc - go acc ('\ESC':'[':rest) = let rest' = dropWhile (\c -> c /= 'm') rest - in case rest' of - [] -> acc - (_:xs) -> go acc xs - go acc (_:xs) = go (acc+1) xs - -fmt :: Double -> Text -fmt v - | abs v >= 10000 || (abs v < 0.01 && v /= 0) = Text.pack (showEFloat (Just 1) v "") - | otherwise = Text.pack (showFFloat (Just 1) v "") - -drawFrame :: Plot -> Text -> Text -> Text -drawFrame _cfg contentWithAxes legendBlockStr = - Text.unlines $ filter (not . Text.null) - ( [plotTitle _cfg | not (Text.null (plotTitle _cfg))] - <> [contentWithAxes] - <> [legendBlockStr | not (Text.null legendBlockStr)] ) - -axisify :: Plot -> Canvas -> (Double,Double) -> (Double,Double) -> Text -axisify cfg c (xmin,xmax) (ymin,ymax) = - let plotW = cW c - plotH = cH c - left = leftMargin cfg - pad = Text.replicate left " " - - yTicks = [(0, ymax), (plotH `div` 2, (ymin+ymax)/2), (plotH-1, ymin)] - baseLbl = replicate plotH pad - - setAt :: [Text] -> Int -> Text -> [Text] - setAt xs i v | i < 0 || i >= length xs = xs - | otherwise = take i xs <> [v] <> drop (i+1) xs - - yLabels = List.foldl' (\acc (row,v) -> setAt acc row (justifyRight left (fmt v))) - baseLbl yTicks - - canvasLines = Text.lines (renderCanvas c) - attachY :: [Text] - attachY = zipWith (\lbl line -> lbl <> "│" <> line) yLabels canvasLines - - xBar = pad <> "│" <> Text.replicate plotW "─" - xLbls = [(0, xmin), (plotW `div` 2, (xmin+xmax)/2), (plotW-1, xmax)] - xLine = placeLabels (Text.replicate (left + 1 + plotW) " ") (left + 1) - [ (x, fmt v) | (x,v) <- xLbls ] - in Text.unlines (attachY <> [xBar, xLine]) - -axisifyGrid :: Plot -> [[(Char, Maybe Color)]] -> (Double,Double) -> (Double,Double) -> Text -axisifyGrid cfg grid (xmin,xmax) (ymin,ymax) = - let plotH = length grid - plotW = gridWidth grid - left = leftMargin cfg - pad = Text.replicate left " " - - yTicks :: [(Int, Double)] - yTicks = [(0, ymax), (plotH `div` 2, (ymin+ymax)/2), (plotH-1, ymin)] - - baseLbl :: [Text] - baseLbl = List.replicate plotH pad - - setAt :: [Text] -> Int -> Text -> [Text] - setAt xs i v | i < 0 || i >= length xs = xs - | otherwise = take i xs <> [v] <> drop (i+1) xs - - yLabels :: [Text] - yLabels = List.foldl' - (\acc (row,v) -> setAt acc row (justifyRight left (fmt v))) - baseLbl - yTicks - - renderRow :: [(Char, Maybe Color)] -> Text - renderRow cells = Text.concat $ - fmap (\(ch, mc) -> maybe (Text.singleton ch) (\c -> paint c ch) mc) cells - - attachY :: [Text] - attachY = zipWith (\lbl cells -> lbl <> "│" <> renderRow cells) yLabels grid - - xBar :: Text - xBar = pad <> "│" <> Text.replicate plotW "─" - xLbls = [(0, xmin), (plotW `div` 2, (xmin+xmax)/2), (plotW-1, xmax)] - xLine = placeLabels - (Text.replicate (left + 1 + plotW) " ") - (left + 1) - (fmap (\(x,v) -> (x, fmt v)) xLbls) - in Text.unlines (attachY <> [xBar, xLine]) - -placeLabels :: Text -> Int -> [(Int,Text)] -> Text -placeLabels base off xs = List.foldl' place base xs - where - place :: Text -> (Int, Text) -> Text - place acc (x,s) = - let i = off + x - in Text.take i acc <> s <> Text.drop (i + wcswidth s) acc - -legendBlock :: LegendPos -> Int -> [(Text, Pat, Color)] -> Text -legendBlock LegendBottom width entries = - let cells = [ sample pat col <> " " <> name | (name, pat, col) <- entries ] - line = Text.intercalate " " cells - pad = let vis = wcswidth line - in if vis < width then Text.replicate ((width - vis) `div` 2) " " else "" - in pad <> line -legendBlock LegendRight _ entries = - Text.unlines $ - fmap (\(name, pat, col) -> sample pat col <> " " <> name) entries - -sample :: Pat -> Color -> Text -sample p col = - let c = List.foldl' (\cv (dx,dy) -> if ink p dx dy then setDotC cv (dx `mod` 2) (dy `mod` 4) (Just col) else cv) - (newCanvas 1 1) - [(x,y) | y <- [0..3], x <- [0..1]] - 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 = map fst pts; ys = map snd pts - xmin = minimum' xs; xmax = maximum' xs - ymin = minimum' ys; ymax = maximum' ys - padx = (xmax - xmin) * 0.05 + 1e-9 - pady = (ymax - ymin) * 0.05 + 1e-9 - in (fromMaybe (xmin - padx) (fst (xBounds cfg)), - fromMaybe (xmax + padx) (snd (xBounds cfg)), - fromMaybe (ymin - pady) (fst (yBounds cfg)), - 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->' '; 1->'▁'; 2->'▂'; 3->'▃'; 4->'▄'; 5->'▅'; 6->'▆'; 7->'▇'; _->'█' - -colGlyphs :: Int -> Double -> String -colGlyphs hC frac = - let total = hC * 8 - ticks = clamp 0 total (round (frac * fromIntegral total)) - full = ticks `div` 8 - rem8 = ticks - full*8 - topPad = hC - full - (if rem8>0 then 1 else 0) - middle = [blockChar rem8 | rem8 > 0] - in replicate topPad ' ' <> middle <> replicate full '█' - -resampleToWidth :: Int -> [Double] -> [Double] -resampleToWidth w xs - | w <= 0 = [] - | null xs = replicate w 0 - | n == w = xs - | n > w = avgGroup (ceiling (fromIntegral n / (fromIntegral w :: Double))) - | otherwise = replicateOut - where - n = length xs - avgGroup g = - [ avg (take g (drop (i*g) xs)) | i <- [0..w-1] ] - where avg ys = if null ys then 0 else sum ys / fromIntegral (length ys) - replicateOut = - let base = w `div` n - extra = w - base * n - in concat [ replicate (base + (if i < extra then 1 else 0)) v - | (i,v) <- zip [0..] xs ] - -addAt :: [Int] -> Int -> Int -> [Int] -addAt xs i v = take i xs <> [xs !! i + v] <> drop (i+1) xs - -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 (fmap fst (List.uncons 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 + (if hl >= hr then hl else 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) - | 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 - -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) - -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)) - -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) +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} + +{- | +Module : Granite +Copyright : (c) 2025 +License : MIT +Maintainer : mschavinda@gmail.com +Stability : experimental +Portability : POSIX + +A terminal-based plotting library that renders beautiful charts using Unicode +Braille characters and ANSI colors. Granite provides a variety of chart types +including scatter plots, line graphs, bar charts, pie charts, histograms, +heatmaps, and box plots. + += Basic Usage + +Create a simple scatter plot: + +@ +{\-# LANGUAGE OverloadedStrings #-\} +import Granite +import Data.Text.IO as T + +main = do + let points = [(x, sin x) | x <- [0, 0.1 .. 6.28]] + chart = scatter [series "sin(x)" points] defPlot + T.putStrLn chart +@ + += Customization + +Plots can be customized using record update syntax: + +@ +let customPlot = defPlot + { widthChars = 80 + , heightChars = 30 + , plotTitle = "My Chart" + , legendPos = LegendBottom + } +@ + += Terminal Requirements + +This library requires a terminal that supports: + + * Unicode (specifically Braille patterns U+2800-U+28FF) + * ANSI color codes + * Monospace font with proper Braille character rendering +-} +module Granite ( + -- * Plot Configuration + Plot (..), + defPlot, + LegendPos (..), + + -- * Formatting + Color (..), + + -- * Data Preparation + series, + bins, + Bins (..), + + -- * Chart Types + histogram, + bars, + scatter, + pie, + stackedBars, + heatmap, + lineGraph, + boxPlot, +) where + +import Data.Bits (xor, (.&.), (.|.)) +import Data.Char (chr) +import Data.List qualified as List +import Data.Maybe +import Data.Text (Text) +import Data.Text qualified as Text +import Numeric (showEFloat, showFFloat) +import Text.Printf + +-- | Position of the legend in the plot. +data LegendPos + = -- | Display legend on the right side of the plot + LegendRight + | -- | Display legend below the plot + LegendBottom + deriving (Eq, Show) + +{- | Plot configuration parameters. + +Controls the appearance and layout of generated charts. +-} +data Plot = Plot + { widthChars :: Int + -- ^ Width of the plot area in terminal characters (default: 60) + , heightChars :: Int + -- ^ Height of the plot area in terminal characters (default: 20) + , leftMargin :: Int + -- ^ Space reserved for y-axis labels (default: 6) + , bottomMargin :: Int + -- ^ Space reserved for x-axis labels (default: 2) + , titleMargin :: Int + -- ^ Space above the plot for the title (default: 1) + , xBounds :: (Maybe Double, Maybe Double) + {- ^ Optional manual x-axis bounds (min, max). + 'Nothing' uses automatic bounds with 5% padding. + -} + , yBounds :: (Maybe Double, Maybe Double) + {- ^ Optional manual y-axis bounds (min, max). + 'Nothing' uses automatic bounds with 5% padding. + -} + , plotTitle :: Text + -- ^ Title displayed above the plot (default: empty) + , legendPos :: LegendPos + -- ^ Position of the legend (default: 'LegendRight') + , colorPalette :: [Color] + -- ^ Color palette that'll be used by the plot. + , xFormatter :: (Int -> Double -> Text) + -- ^ Formatter for x-axis labels. + , yFormatter :: (Int -> Double -> Text) + -- ^ Formatter for y-axis labels. + } + +{- | Default plot configuration. + +Creates a 60×20 character plot with reasonable defaults: + +@ +defPlot = Plot + { widthChars = 60 + , heightChars = 20 + , leftMargin = 6 + , bottomMargin = 2 + , titleMargin = 1 + , xBounds = (Nothing, Nothing) + , yBounds = (Nothing, Nothing) + , plotTitle = "" + , legendPos = LegendRight + } +@ +-} +defPlot :: Plot +defPlot = + Plot + { widthChars = 60 + , heightChars = 20 + , leftMargin = 6 + , bottomMargin = 2 + , titleMargin = 1 + , xBounds = (Nothing, Nothing) + , yBounds = (Nothing, Nothing) + , plotTitle = "" + , legendPos = LegendRight + , colorPalette = paletteColors + , xFormatter = \_ -> fmt + , yFormatter = \_ -> fmt + } + +-- | 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. + +@ +let s1 = series "Dataset A" [(1,2), (2,4), (3,6)] + s2 = series "Dataset B" [(1,3), (2,5), (3,7)] + chart = scatter [s1, s2] defPlot +@ +-} +series :: + -- | Name of the series (appears in legend) + Text -> + -- | List of (x, y) data points + [(Double, Double)] -> + (Text, [(Double, Double)]) +series = (,) + +{- | Create a scatter plot from multiple data series. + +Each series is rendered with a different color and pattern. +Points are plotted using Braille characters for sub-character resolution. + +==== __Example__ + +@ +let points1 = [(x, x^2) | x <- [-3, -2.5 .. 3]] + points2 = [(x, 2*x + 1) | x <- [-3, -2.5 .. 3]] + chart = scatter [series "y = x²" points1, + series "y = 2x + 1" points2] defPlot +@ +-} +scatter :: + -- | List of named data series + [(Text, [(Double, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +scatter sers cfg = + let wC = widthChars cfg + hC = heightChars cfg + plotC = newCanvas wC hC + (xmin, xmax, ymin, ymax) = boundsXY cfg (concatMap snd sers) + sx x = clamp 0 (wC * 2 - 1) $ round ((x - xmin) / (xmax - xmin + eps) * fromIntegral (wC * 2 - 1)) + sy y = clamp 0 (hC * 4 - 1) $ round ((ymax - y) / (ymax - ymin + eps) * fromIntegral (hC * 4 - 1)) + pats = cycle palette + cols = cycle paletteColors + withSty = zipWith3 (\(n, ps) p c -> (n, ps, p, c)) sers pats cols + drawOne (_name, pts, pat, col) c0 = + List.foldl' + ( \c (x, y) -> + let xd = sx x; yd = sy y + in if ink pat xd yd then setDotC c xd yd (Just col) else c + ) + c0 + pts + cDone = List.foldl' (flip drawOne) plotC withSty + ax = axisify cfg cDone (xmin, xmax) (ymin, ymax) + legend = + legendBlock + (legendPos cfg) + (leftMargin cfg + widthChars cfg) + [(n, p, col) | (n, _, p, col) <- withSty] + in drawFrame cfg ax legend + +{- | Create a line graph connecting data points. + +Similar to 'scatter' but connects consecutive points with lines. +Points are automatically sorted by x-coordinate before connecting. + +==== __Example__ + +@ +let sine = [(x, sin x) | x <- [0, 0.1 .. 2*pi]] + cosine = [(x, cos x) | x <- [0, 0.1 .. 2*pi]] + chart = lineGraph [series "sin" sine, series "cos" cosine] defPlot +@ +-} +lineGraph :: + -- | List of named data series + [(Text, [(Double, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +lineGraph sers cfg = + let wC = widthChars cfg + hC = heightChars cfg + plotC = newCanvas wC hC + (xmin, xmax, ymin, ymax) = boundsXY cfg (concatMap snd sers) + sx x = clamp 0 (wC * 2 - 1) $ round ((x - xmin) / (xmax - xmin + eps) * fromIntegral (wC * 2 - 1)) + sy y = clamp 0 (hC * 4 - 1) $ round ((ymax - y) / (ymax - ymin + eps) * fromIntegral (hC * 4 - 1)) + + cols = cycle paletteColors + withSty = zip sers cols + + drawSeries ((_name, pts), col) c0 = + let sortedPts = List.sortOn fst pts + dotPairs = zip sortedPts (drop 1 sortedPts) + in List.foldl' + ( \c ((x1, y1), (x2, y2)) -> + lineDotsC (sx x1, sy y1) (sx x2, sy y2) (Just col) c + ) + c0 + dotPairs + + cDone = List.foldl' (flip drawSeries) plotC withSty + ax :: Text + ax = axisify cfg cDone (xmin, xmax) (ymin, ymax) + legend :: Text + legend = + legendBlock + (legendPos cfg) + (leftMargin cfg + widthChars cfg) + [(n, Solid, col) | ((n, _), col) <- withSty] + in drawFrame cfg ax legend + +{- | Create a bar chart from categorical data. + +Each bar is colored differently and labeled with its category name. + +==== __Example__ + +@ +let data = [("Apple", 45.2), ("Banana", 38.1), ("Orange", 52.7)] + chart = bars data defPlot { plotTitle = "Fruit Sales" } +@ +-} +bars :: + -- | List of (category, value) pairs + [(Text, Double)] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +bars kvs cfg = + let wC = widthChars cfg + hC = heightChars cfg + vals = map snd kvs + vmax = maximum' (map abs vals) + + cats :: [(Text, Double, Color)] + cats = + [ (name, abs v / vmax, col) + | ((name, v), col) <- zip kvs (cycle paletteColors) + ] + + nCats = length cats + + (base, extra) = + if nCats == 0 then (0, 0) else (wC `div` nCats, wC - (wC `div` nCats) * nCats) + widths = [base + (if i < extra then 1 else 0) | i <- [0 .. nCats - 1]] + + catGroups :: [[(String, Maybe Color)]] + catGroups = + [ replicate w (colGlyphs hC f, Just col) + | ((_, f, col), w) <- zip cats widths + ] + + gutterCol = (replicate hC ' ', Nothing) + columns = concat (List.intersperse [gutterCol] catGroups) + + grid :: [[(Char, Maybe Color)]] + grid = + [ [(glyphs !! y, mc) | (glyphs, mc) <- columns] + | y <- [0 .. hC - 1] + ] + + ax = axisifyGrid cfg grid (0, fromIntegral (max 1 nCats)) (0, vmax) + legendWidth = leftMargin cfg + 1 + (gridWidth grid) + legend = + legendBlock + (legendPos cfg) + legendWidth + [(name, Checker, col) | (name, _, col) <- cats] + in drawFrame cfg ax legend + +{- | Create a stacked bar chart. + +Each category can have multiple stacked components. + +==== __Example__ + +@ +let data = [("Q1", [("Product A", 100), ("Product B", 150)]), + ("Q2", [("Product A", 120), ("Product B", 180)])] + chart = stackedBars data defPlot +@ +-} +stackedBars :: + -- | Categories with stacked components + [(Text, [(Text, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +stackedBars categories cfg = + let wC = widthChars cfg + hC = heightChars cfg + + seriesNames = case categories of + [] -> [] + (c : _) -> map fst (snd c) + + totals = [sum (map snd series') | (_, series') <- categories] + maxHeight = maximum (1e-12 : totals) + + nCats = length categories + (base, extra) = + if nCats == 0 + then (0, 0) + else (wC `div` nCats, wC - (wC `div` nCats) * nCats) + widths = [base + (if i < extra then 1 else 0) | i <- [0 .. nCats - 1]] + + cols = cycle paletteColors + seriesColors = zip seriesNames cols + + makeBar (_, series') width = + let cumHeights = scanl (+) 0 [v / maxHeight | (_, v) <- series'] + segments = zip3 (map fst series') cumHeights (drop 1 cumHeights) + + makeColumn :: [(Char, Maybe Color)] + makeColumn = + [ let heightFromBottom = fromIntegral (hC - y) / fromIntegral hC + findSegment [] = (' ', Nothing) + findSegment ((name, bottom, top) : rest) = + if heightFromBottom > bottom && heightFromBottom <= top + then ('█', lookup name seriesColors) + else findSegment rest + in findSegment segments + | y <- [0 .. hC - 1] + ] + in replicate width makeColumn + + gutterCol = replicate hC (' ', Nothing) + allBars = zipWith makeBar categories widths + columns = concat (List.intersperse [gutterCol] allBars) + + grid = [[col !! y | col <- columns] | y <- [0 .. hC - 1]] + + ax :: Text + ax = axisifyGrid cfg grid (0, fromIntegral (max 1 nCats)) (0, maxHeight) + legend :: Text + legend = + legendBlock + (legendPos cfg) + ( leftMargin cfg + + 1 + + (gridWidth grid) + ) + [(name, Solid, col) | (name, col) <- seriesColors] + in drawFrame cfg ax legend + +-- | Defines the binning parameters. +data Bins = Bins + { nBins :: Int + , lo :: Double + , hi :: Double + } + deriving (Eq, Show) + +{- | Create a bin configuration for histograms. + +@ +bins 10 0 100 -- 10 bins from 0 to 100 +bins 20 (-5) 5 -- 20 bins from -5 to 5 +@ +-} +bins :: Int -> Double -> Double -> Bins +bins n a b = Bins (max 1 n) (min a b) (max a b) + +{- | Create a histogram from numerical data. + +Data is binned according to the provided 'Bins' configuration. + +==== __Example__ + +@ +import System.Random + +-- Generate random normal-like distribution +let values = take 1000 $ randomRs (0, 100) gen + chart = histogram (bins 20 0 100) values defPlot +@ +-} +histogram :: + -- | Binning configuration + Bins -> + -- | Raw data values to bin + [Double] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +histogram (Bins n a b) xs cfg = + let step = (b - a) / fromIntegral n + binIx x = clamp 0 (n - 1) $ floor ((x - a) / step) + counts = + List.foldl' + ( \acc x -> + if x < a || x > b + then acc + else addAt acc (binIx x) 1 + ) + (replicate n 0 :: [Int]) + xs + maxC = fromIntegral (maximum (1 : counts)) + fracs0 = [fromIntegral c / maxC | c <- counts] + + wData = widthChars cfg + hC = heightChars cfg + colsF = resampleToWidth wData fracs0 + + dataCols = [(colGlyphs hC f, Just BrightCyan) | f <- colsF] + gutterCol = (replicate hC ' ', Nothing) + columns = concat (List.intersperse [gutterCol] (map pure dataCols)) + + grid :: [[(Char, Maybe Color)]] + grid = + [ [(fst col !! y, snd col) | col <- columns] + | y <- [0 .. hC - 1] + ] + + ax = axisifyGrid cfg grid (a, b) (0, fromIntegral (maximum (1 : counts))) + legendWidth = leftMargin cfg + 1 + (gridWidth grid) + legend = legendBlock (legendPos cfg) legendWidth [("count", Solid, BrightCyan)] + in drawFrame cfg ax legend + +{- | Create a pie chart showing proportions. + +Values are normalized to sum to 100%. Negative values are treated as zero. + +==== __Example__ + +@ +let data = [("Chrome", 65), ("Firefox", 20), ("Safari", 10), ("Other", 5)] + chart = pie data defPlot { plotTitle = "Browser Market Share" } +@ +-} +pie :: + -- | List of (category, value) pairs + [(Text, Double)] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +pie parts0 cfg = + let parts = normalize parts0 + wC = widthChars cfg + hC = heightChars cfg + plotC = newCanvas wC hC + wDots = wC * 2 + hDots = hC * 4 + r = min (wDots `div` 2 - 2) (hDots `div` 2 - 2) + cx = wDots `div` 2 + cy = hDots `div` 2 + toAng p = p * 2 * pi + wedges = scanl (\a (_, p) -> a + toAng p) 0 parts + angles = zip wedges (drop 1 wedges) + names = map fst parts + cols = cycle pieColors + withP :: [(Text, (Double, Double), Color)] + withP = zipWith3 (\n ang col -> (n, ang, col)) names angles cols + + drawOne (_name, (a0, a1), col) c0 = + let inside x y = + let dx = fromIntegral (x - cx) + dy = fromIntegral (cy - y) + rr2 = dx * dx + dy * dy + r2 = fromIntegral (r * r) + ang = atan2 dy dx `mod'` (2 * pi) + in rr2 <= r2 && angleWithin ang a0 a1 + in fillDotsC (cx - r, cy - r) (cx + r, cy + r) (\x y -> inside x y) (Just col) c0 + + cDone = List.foldl' (flip drawOne) plotC withP + ax = axisify cfg cDone (0, 1) (0, 1) + legend = + legendBlock + (legendPos cfg) + (leftMargin cfg + widthChars cfg) + [(n, Solid, col) | (n, _, col) <- withP] + in drawFrame cfg ax legend + +{- | Create a heatmap visualization of a 2D matrix. + +Values are mapped to a color gradient from blue (low) to red (high). + +==== __Example__ + +@ +let matrix = [[x * y | x <- [1..10]] | y <- [1..10]] + chart = heatmap matrix defPlot { plotTitle = "Multiplication Table" } +@ +-} +heatmap :: + -- | 2D matrix of values (rows × columns) + [[Double]] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +heatmap matrix cfg = + let rows = length matrix + cols = gridWidth matrix + + allVals = concat matrix + vmin = if null allVals then 0 else minimum' allVals + vmax = if null allVals then 1 else maximum' allVals + vrange = vmax - vmin + + intensityColors = + [ Blue + , BrightBlue + , Cyan + , BrightCyan + , Green + , BrightGreen + , Yellow + , BrightYellow + , Magenta + , BrightRed + , Red + ] + + colorForValue v = + if vrange < eps + then Green + else + let norm = clamp 0 1 ((v - vmin) / vrange) + idx = floor (norm * fromIntegral (length intensityColors - 1)) + idx' = clamp 0 (length intensityColors - 1) idx + in intensityColors !! idx' + + plotW = widthChars cfg + plotH = heightChars cfg + + displayGrid = + [ [ let + matrixRow = min (rows - 1) ((plotH - 1 - i) * rows `div` plotH) + matrixCol = min (cols - 1) (j * cols `div` plotW) + val = matrix !! matrixRow !! matrixCol + in + ('█', Just (colorForValue val)) + | j <- [0 .. plotW - 1] + ] + | i <- [0 .. plotH - 1] + ] + + ax = axisifyGrid cfg displayGrid (0, fromIntegral cols - 1) (0, fromIntegral rows - 1) + + gradientLegend = + (Text.pack $ printf "%.2f " vmin) + <> Text.concat (fmap (\col -> paint col '█') intensityColors) + <> (Text.pack $ printf " %.2f" vmax) + in drawFrame cfg ax gradientLegend + +{- | Create a box plot showing statistical distributions. + +Displays quartiles, median, and min/max values for each dataset. + +==== __Example__ + +@ +let data1 = [1.2, 2.3, 2.1, 3.4, 2.8, 4.1, 3.9] + data2 = [5.1, 4.8, 6.2, 5.9, 7.1, 6.5, 5.5] + chart = boxPlot [("Group A", data1), ("Group B", data2)] defPlot +@ + +The box plot displays: + + * Box: First quartile (Q1) to third quartile (Q3) + * Line inside box: Median (Q2) + * Whiskers: Minimum and maximum values +-} +boxPlot :: + -- | Named datasets + [(Text, [Double])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as Text + Text +boxPlot datasets cfg = + let wC = widthChars cfg + hC = heightChars cfg + + stats = [(name, quartiles vals) | (name, vals) <- datasets] + + allVals = concatMap snd datasets + ymin = if null allVals then 0 else minimum' allVals - abs (minimum' allVals) * 0.1 + ymax = if null allVals then 1 else maximum' allVals + abs (maximum' allVals) * 0.1 + + nBoxes = length datasets + boxWidth = if nBoxes == 0 then 1 else max 1 (wC `div` (nBoxes * 2)) + spacing = if nBoxes <= 1 then 0 else (wC - boxWidth * nBoxes) `div` (nBoxes - 1) + + scaleY v = clamp 0 (hC - 1) $ round ((ymax - v) / (ymax - ymin + eps) * fromIntegral (hC - 1)) + + emptyGrid = replicate hC (replicate wC (' ', Nothing)) + + drawBox grid (idx, (_name, (minV, q1, median, q3, maxV))) = + let xStart = idx * (boxWidth + spacing) + xMid = xStart + boxWidth `div` 2 + xEnd = xStart + boxWidth - 1 + + minRow = scaleY minV + q1Row = scaleY q1 + medRow = scaleY median + q3Row = scaleY q3 + maxRow = scaleY maxV + + col = pieColors !! (idx `mod` length pieColors) + + grid1 = drawVLine grid xMid minRow q1Row '│' (Just col) + grid2 = drawVLine grid1 xMid q3Row maxRow '│' (Just col) + + grid3 = drawHLine grid2 xStart xEnd q1Row '─' (Just col) + grid4 = drawHLine grid3 xStart xEnd q3Row '─' (Just col) + grid5 = drawVLine grid4 xStart q1Row q3Row '│' (Just col) + grid6 = drawVLine grid5 xEnd q1Row q3Row '│' (Just col) + + grid7 = drawHLine grid6 xStart xEnd medRow '═' (Just col) + + grid8 = setGridChar grid7 xMid minRow '┬' (Just col) + grid9 = setGridChar grid8 xMid maxRow '┴' (Just col) + in grid9 + + finalGrid = List.foldl' drawBox emptyGrid (zip [0 ..] stats) + + ax = axisifyGrid cfg finalGrid (0, fromIntegral nBoxes) (ymin, ymax) + legend = + legendBlock + (legendPos cfg) + (leftMargin cfg + widthChars cfg) + [ (name, Solid, pieColors !! (i `mod` length pieColors)) + | (i, (name, _)) <- zip [0 ..] stats + ] + in drawFrame cfg ax legend + where + drawVLine grid x y1 y2 ch col = + let yStart = min y1 y2 + yEnd = max y1 y2 + in List.foldl' (\g y -> setGridChar g x y ch col) grid [yStart .. yEnd] + + drawHLine grid x1 x2 y ch col = + let xStart = min x1 x2 + xEnd = max x1 x2 + in List.foldl' (\g x -> setGridChar g x y ch col) grid [xStart .. xEnd] + + setGridChar grid x y ch col = + if y >= 0 && y < length grid && x >= 0 && x < gridWidth grid + then take y grid <> [setAt (grid !! y) x (ch, col)] <> drop (y + 1) grid + else grid + where + setAt row i v = take i row <> [v] <> drop (i + 1) row + +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 +ink Solid _ _ = True +ink Checker x y = ((x `xor` y) .&. 1) == 0 +ink DiagA x y = (x + y) `mod` 3 /= 1 +ink DiagB x y = (x - y) `mod` 3 /= 1 +ink Sparse x y = (x .&. 1 == 0) && (y `mod` 3 == 0) + +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 = xDot `div` 2 + cy = yDot `div` 4 + rx = xDot - 2 * cx + ry = yDot - 4 * cy + 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 = + flip + fmap + [0 .. h - 1] + ( \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) (\c -> paint c ch) mc + ) + 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 t = go 0 t + where + go acc xs + | Text.null xs = acc + | Text.isPrefixOf "\ESC[" xs = + let + rest' = Text.dropWhile (\c -> c /= 'm') xs + in + if Text.null rest' then acc else go acc (Text.tail rest') + | otherwise = go (acc + 1) (Text.tail xs) + +fmt :: Double -> Text +fmt v + | abs v >= 10000 || (abs v < 0.01 && v /= 0) = Text.pack (showEFloat (Just 1) v "") + | otherwise = Text.pack (showFFloat (Just 1) v "") + +drawFrame :: Plot -> Text -> Text -> Text +drawFrame _cfg contentWithAxes legendBlockStr = + Text.unlines $ + filter + (not . Text.null) + ( [plotTitle _cfg | not (Text.null (plotTitle _cfg))] + <> [contentWithAxes] + <> [legendBlockStr | not (Text.null legendBlockStr)] + ) + +axisify :: Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text +axisify cfg c (xmin, xmax) (ymin, ymax) = + let plotW = cW c + plotH = cH c + left = leftMargin cfg + pad = Text.replicate left " " + + yTicks = [(0, ymax), (plotH `div` 2, (ymin + ymax) / 2), (plotH - 1, ymin)] + baseLbl = replicate plotH pad + + setAt :: [Text] -> Int -> Text -> [Text] + setAt xs i v + | i < 0 || i >= length xs = xs + | otherwise = take i xs <> [v] <> drop (i + 1) xs + + yLabels = + List.foldl' + (\acc (row, v) -> setAt acc row (justifyRight left (yFormatter cfg row v))) + baseLbl + yTicks + + canvasLines = Text.lines (renderCanvas c) + attachY :: [Text] + attachY = zipWith (\lbl line -> lbl <> "│" <> line) yLabels canvasLines + + xBar = pad <> "│" <> Text.replicate plotW "─" + xLbls = [(0, xmin), (plotW `div` 2, (xmin + xmax) / 2), (plotW - 1, xmax)] + xLine = + placeLabels + (Text.replicate (left + 1 + plotW) " ") + (left + 1) + [(x, xFormatter cfg x v) | (x, v) <- xLbls] + in Text.unlines (attachY <> [xBar, xLine]) + +axisifyGrid :: Plot -> [[(Char, Maybe Color)]] -> (Double, Double) -> (Double, Double) -> Text +axisifyGrid cfg grid (xmin, xmax) (ymin, ymax) = + let plotH = length grid + plotW = gridWidth grid + left = leftMargin cfg + pad = Text.replicate left " " + + yTicks :: [(Int, Double)] + yTicks = [(0, ymax), (plotH `div` 2, (ymin + ymax) / 2), (plotH - 1, ymin)] + + baseLbl :: [Text] + baseLbl = List.replicate plotH pad + + setAt :: [Text] -> Int -> Text -> [Text] + setAt xs i v + | i < 0 || i >= length xs = xs + | otherwise = take i xs <> [v] <> drop (i + 1) xs + + yLabels :: [Text] + yLabels = + List.foldl' + (\acc (row, v) -> setAt acc row (justifyRight left (yFormatter cfg row v))) + baseLbl + yTicks + + renderRow :: [(Char, Maybe Color)] -> Text + renderRow cells = + Text.concat $ + fmap (\(ch, mc) -> maybe (Text.singleton ch) (\c -> paint c ch) mc) cells + + attachY :: [Text] + attachY = zipWith (\lbl cells -> lbl <> "│" <> renderRow cells) yLabels grid + + xBar :: Text + xBar = pad <> "│" <> Text.replicate plotW "─" + xLbls = [(0, xmin), (plotW `div` 2, (xmin + xmax) / 2), (plotW - 1, xmax)] + xLine = + placeLabels + (Text.replicate (left + 1 + plotW) " ") + (left + 1) + (fmap (\(x, v) -> (x, xFormatter cfg x v)) xLbls) + in Text.unlines (attachY <> [xBar, xLine]) + +placeLabels :: Text -> Int -> [(Int, Text)] -> Text +placeLabels base off xs = List.foldl' place base xs + where + place :: Text -> (Int, Text) -> Text + place acc (x, s) = + let i = off + x + in Text.take i acc <> s <> Text.drop (i + wcswidth s) acc + +legendBlock :: LegendPos -> Int -> [(Text, Pat, Color)] -> Text +legendBlock LegendBottom width entries = + let cells = [sample pat col <> " " <> name | (name, pat, col) <- entries] + line = Text.intercalate " " cells + pad = + let vis = wcswidth line + in if vis < width then Text.replicate ((width - vis) `div` 2) " " else "" + in pad <> line +legendBlock LegendRight _ entries = + Text.unlines $ + fmap (\(name, pat, col) -> sample pat col <> " " <> name) entries + +sample :: Pat -> Color -> Text +sample p col = + let c = + List.foldl' + (\cv (dx, dy) -> if ink p dx dy then setDotC cv (dx `mod` 2) (dy `mod` 4) (Just col) else cv) + (newCanvas 1 1) + [(x, y) | y <- [0 .. 3], x <- [0 .. 1]] + 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 = map fst pts + ys = map snd pts + xmin = minimum' xs + xmax = maximum' xs + ymin = minimum' ys + ymax = maximum' ys + padx = (xmax - xmin) * 0.05 + 1e-9 + pady = (ymax - ymin) * 0.05 + 1e-9 + in ( fromMaybe (xmin - padx) (fst (xBounds cfg)) + , fromMaybe (xmax + padx) (snd (xBounds cfg)) + , fromMaybe (ymin - pady) (fst (yBounds cfg)) + , 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 -> ' ' + 1 -> '▁' + 2 -> '▂' + 3 -> '▃' + 4 -> '▄' + 5 -> '▅' + 6 -> '▆' + 7 -> '▇' + _ -> '█' + +colGlyphs :: Int -> Double -> String +colGlyphs hC frac = + let total = hC * 8 + ticks = clamp 0 total (round (frac * fromIntegral total)) + full = ticks `div` 8 + rem8 = ticks - full * 8 + topPad = hC - full - (if rem8 > 0 then 1 else 0) + middle = [blockChar rem8 | rem8 > 0] + in replicate topPad ' ' <> middle <> replicate full '█' + +resampleToWidth :: Int -> [Double] -> [Double] +resampleToWidth w xs + | w <= 0 = [] + | null xs = replicate w 0 + | n == w = xs + | n > w = avgGroup (ceiling (fromIntegral n / (fromIntegral w :: Double))) + | otherwise = replicateOut + where + n = length xs + avgGroup g = + [avg (take g (drop (i * g) xs)) | i <- [0 .. w - 1]] + where + avg ys = if null ys then 0 else sum ys / fromIntegral (length ys) + replicateOut = + let base = w `div` n + extra = w - base * n + in concat + [ replicate (base + (if i < extra then 1 else 0)) v + | (i, v) <- zip [0 ..] xs + ] + +addAt :: [Int] -> Int -> Int -> [Int] +addAt xs i v = take i xs <> [xs !! i + v] <> drop (i + 1) xs + +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 (fmap fst (List.uncons 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 + (if hl >= hr then hl else 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) + | 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 + +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) + +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)) + +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) diff --git a/src/Granite/String.hs b/src/Granite/String.hs new file mode 100644 --- /dev/null +++ b/src/Granite/String.hs @@ -0,0 +1,394 @@ +{-# LANGUAGE PatternSynonyms #-} + +{- | +Module : Granite.String +Copyright : (c) 2024 +License : BSD3 +Maintainer : your-email@example.com +Stability : experimental +Portability : POSIX + +A String-based interface to the Granite plotting library. This module provides +the same functionality as "Granite" but uses 'String' instead of 'Text' for +easier use in simple scripts and educational contexts. + += Basic Usage + +Create a simple scatter plot: + +@ +import Granite.String + +main = do + let points = [(x, sin x) | x <- [0, 0.1 .. 6.28]] + chart = scatter [series "sin(x)" points] defPlot + putStrLn chart +@ + += Note on Performance + +This module internally converts between 'String' and 'Text'. For performance-critical +applications with large datasets, consider using the "Granite" module directly which +works with 'Text' natively. + += Terminal Requirements + +This library requires a terminal that supports: + + * Unicode (specifically Braille patterns U+2800-U+28FF) + * ANSI color codes + * Monospace font with proper Braille character rendering +-} +module Granite.String ( + -- * Plot Configuration + Plot (..), + defPlot, + + -- * Data Preparation + series, + module RE, + bins, + + -- * Chart Types + scatter, + lineGraph, + bars, + stackedBars, + histogram, + pie, + heatmap, + boxPlot, +) where + +import Data.Text (Text) + +import Data.Text qualified as Text +import Granite qualified as G + +import Granite as RE (Bins, Color (..), LegendPos (..)) + +{- | Plot configuration parameters. + +Controls the appearance and layout of generated charts. +-} +data Plot = Plot + { widthChars :: Int + -- ^ Width of the plot area in terminal characters (default: 60) + , heightChars :: Int + -- ^ Height of the plot area in terminal characters (default: 20) + , leftMargin :: Int + -- ^ Space reserved for y-axis labels (default: 6) + , bottomMargin :: Int + -- ^ Space reserved for x-axis labels (default: 2) + , titleMargin :: Int + -- ^ Space above the plot for the title (default: 1) + , xBounds :: (Maybe Double, Maybe Double) + {- ^ Optional manual x-axis bounds (min, max). + 'Nothing' uses automatic bounds with 5% padding. + -} + , yBounds :: (Maybe Double, Maybe Double) + {- ^ Optional manual y-axis bounds (min, max). + 'Nothing' uses automatic bounds with 5% padding. + -} + , plotTitle :: String + -- ^ Title displayed above the plot (default: empty) + , legendPos :: G.LegendPos + -- ^ Position of the legend (default: 'LegendRight') + , colorPalette :: [G.Color] + -- ^ Color palette that'll be used by the plot. + , xFormatter :: (Int -> Double -> String) + -- ^ Formatter for x-axis labels. + , yFormatter :: (Int -> Double -> String) + -- ^ Formatter for y-axis labels. + } + +{- | Default plot configuration. + +Creates a 60×20 character plot with reasonable defaults: + +@ +defPlot = Plot + { widthChars = 60 + , heightChars = 20 + , leftMargin = 6 + , bottomMargin = 2 + , titleMargin = 1 + , xBounds = (Nothing, Nothing) + , yBounds = (Nothing, Nothing) + , plotTitle = "" + , legendPos = LegendRight + , colorPalette = [BrightBlue, BrightMagenta, BrightCyan, BrightGreen, BrightYellow, BrightRed, BrightWhite, BrightBlack] + , xFormatter = \_ d -> show d + , yFormatter = \_ d -> show d + } +@ +-} +defPlot :: Plot +defPlot = fromGranitePlot G.defPlot + +{- | Create a bin configuration for histograms. + +@ +bins 10 0 100 -- 10 bins from 0 to 100 +bins 20 (-5) 5 -- 20 bins from -5 to 5 +@ +-} +bins :: + -- | Number of bins (will be clamped to minimum 1) + Int -> + -- | Lower bound + Double -> + -- | Upper bound + Double -> + G.Bins +bins = G.bins + +{- | Create a named data series for multi-series plots. + +@ +let s1 = series "Dataset A" [(1,2), (2,4), (3,6)] + s2 = series "Dataset B" [(1,3), (2,5), (3,7)] + chart = scatter [s1, s2] defPlot +@ +-} +series :: + -- | Name of the series (appears in legend) + String -> + -- | List of (x, y) data points + [(Double, Double)] -> + (String, [(Double, Double)]) +series name points = (name, points) + +{- | Create a scatter plot from multiple data series. + +Each series is rendered with a different color and pattern. +Points are plotted using Braille characters for sub-character resolution. + +==== __Example__ + +@ +let points1 = [(x, x^2) | x <- [-3, -2.5 .. 3]] + points2 = [(x, 2*x + 1) | x <- [-3, -2.5 .. 3]] + chart = scatter [series "y = x²" points1, + series "y = 2x + 1" points2] defPlot +@ +-} +scatter :: + -- | List of named data series + [(String, [(Double, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +scatter seriesList plot = + Text.unpack $ G.scatter (map (mapFirst Text.pack) seriesList) (toGranitePlot plot) + +{- | Create a line graph connecting data points. + +Similar to 'scatter' but connects consecutive points with lines. +Points are automatically sorted by x-coordinate before connecting. + +==== __Example__ + +@ +let sine = [(x, sin x) | x <- [0, 0.1 .. 2*pi]] + cosine = [(x, cos x) | x <- [0, 0.1 .. 2*pi]] + chart = lineGraph [series "sin" sine, series "cos" cosine] defPlot +@ +-} +lineGraph :: + -- | List of named data series + [(String, [(Double, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +lineGraph seriesList plot = + Text.unpack $ G.lineGraph (map (mapFirst Text.pack) seriesList) (toGranitePlot plot) + +{- | Create a bar chart from categorical data. + +Each bar is colored differently and labeled with its category name. + +==== __Example__ + +@ +let data = [("Apple", 45.2), ("Banana", 38.1), ("Orange", 52.7)] + chart = bars data defPlot { plotTitle = "Fruit Sales" } +@ +-} +bars :: + -- | List of (category, value) pairs + [(String, Double)] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +bars categories plot = + Text.unpack $ G.bars (map (mapFirst Text.pack) categories) (toGranitePlot plot) + +{- | Create a stacked bar chart. + +Each category can have multiple stacked components. + +==== __Example__ + +@ +let data = [("Q1", [("Product A", 100), ("Product B", 150)]), + ("Q2", [("Product A", 120), ("Product B", 180)])] + chart = stackedBars data defPlot +@ +-} +stackedBars :: + -- | Categories with stacked components + [(String, [(String, Double)])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +stackedBars categories plot = + Text.unpack $ + G.stackedBars + (map (\(cat, items) -> (Text.pack cat, map (mapFirst Text.pack) items)) categories) + (toGranitePlot plot) + +{- | Create a histogram from numerical data. + +Data is binned according to the provided 'Bins' configuration. + +==== __Example__ + +@ +import System.Random + +-- Generate random normal-like distribution +let values = take 1000 $ randomRs (0, 100) gen + chart = histogram (bins 20 0 100) values defPlot +@ +-} +histogram :: + -- | Binning configuration + G.Bins -> + -- | Raw data values to bin + [Double] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +histogram binConfig values plot = + Text.unpack $ G.histogram binConfig values (toGranitePlot plot) + +{- | Create a pie chart showing proportions. + +Values are normalized to sum to 100%. Negative values are treated as zero. + +==== __Example__ + +@ +let data = [("Chrome", 65), ("Firefox", 20), ("Safari", 10), ("Other", 5)] + chart = pie data defPlot { plotTitle = "Browser Market Share" } +@ +-} +pie :: + -- | List of (category, value) pairs + [(String, Double)] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +pie slices plot = + Text.unpack $ G.pie (map (mapFirst Text.pack) slices) (toGranitePlot plot) + +{- | Create a heatmap visualization of a 2D matrix. + +Values are mapped to a color gradient from blue (low) to red (high). + +==== __Example__ + +@ +let matrix = [[x * y | x <- [1..10]] | y <- [1..10]] + chart = heatmap matrix defPlot { plotTitle = "Multiplication Table" } +@ +-} +heatmap :: + -- | 2D matrix of values (rows × columns) + [[Double]] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +heatmap matrix plot = + Text.unpack $ G.heatmap matrix (toGranitePlot plot) + +{- | Create a box plot showing statistical distributions. + +Displays quartiles, median, and min/max values for each dataset. + +==== __Example__ + +@ +let data1 = [1.2, 2.3, 2.1, 3.4, 2.8, 4.1, 3.9] + data2 = [5.1, 4.8, 6.2, 5.9, 7.1, 6.5, 5.5] + chart = boxPlot [("Group A", data1), ("Group B", data2)] defPlot +@ + +The box plot displays: + + * Box: First quartile (Q1) to third quartile (Q3) + * Line inside box: Median (Q2) + * Whiskers: Minimum and maximum values +-} +boxPlot :: + -- | Named datasets + [(String, [Double])] -> + -- | Plot configuration + Plot -> + -- | Rendered chart as String + String +boxPlot datasets plot = + Text.unpack $ G.boxPlot (map (mapFirst Text.pack) datasets) (toGranitePlot plot) + +-- | Convert our String-based Plot to Granite's Text-based Plot +toGranitePlot :: Plot -> G.Plot +toGranitePlot p = + G.Plot + { G.widthChars = widthChars p + , G.heightChars = heightChars p + , G.leftMargin = leftMargin p + , G.bottomMargin = bottomMargin p + , G.titleMargin = titleMargin p + , G.xBounds = xBounds p + , G.yBounds = yBounds p + , G.plotTitle = Text.pack (plotTitle p) + , G.legendPos = legendPos p + , G.colorPalette = colorPalette p + , G.xFormatter = formatWithText (xFormatter p) + , G.yFormatter = formatWithText (yFormatter p) + } + +-- | Convert Granite's Text-based Plot to our String-based Plot +fromGranitePlot :: G.Plot -> Plot +fromGranitePlot p = + Plot + { widthChars = G.widthChars p + , heightChars = G.heightChars p + , leftMargin = G.leftMargin p + , bottomMargin = G.bottomMargin p + , titleMargin = G.titleMargin p + , xBounds = G.xBounds p + , yBounds = G.yBounds p + , plotTitle = Text.unpack (G.plotTitle p) + , legendPos = G.legendPos p + , colorPalette = G.colorPalette p + , xFormatter = formatWithString (G.xFormatter p) + , yFormatter = formatWithString (G.yFormatter p) + } + +mapFirst :: (a -> b) -> (a, c) -> (b, c) +mapFirst f (a, c) = (f a, c) + +formatWithText :: (Int -> Double -> String) -> Int -> Double -> Text +formatWithText f i d = Text.pack (f i d) + +formatWithString :: (Int -> Double -> Text) -> Int -> Double -> String +formatWithString f i d = Text.unpack (f i d)