granite 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+155/−60 lines, 4 filesdep ~granitedep ~randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: granite, random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• app/Main.hs +19/−19
• granite.cabal +10/−8
• src/Granite.hs +120/−33

@@ -1,5 +1,11 @@ # Revision history for granite +## 0.1.0.1 -- 2025-08-20++* Remove IO monad from plotting functions.+* Faster plotting after moving from lists as arrays to AVL trees.+* All functions are now strict by default.+ ## 0.1.0.0 -- 2025-08-18  * Support for pie charts, bar charts, heatmaps, line graphs, box plots, and histograms.

@@ -14,38 +14,38 @@   ptsA_y <- replicateM 600 (uniformRM range g)   ptsB_x <- replicateM 600 (uniformRM range g)   ptsB_y <- replicateM 600 (uniformRM range g)-  putStrLn =<< scatter "Random points" [series "A" (zip ptsA_x ptsA_y), series "B" (zip ptsB_x ptsB_y)] defPlot{widthChars=68,heightChars=22}+  putStrLn $ scatter "Random points" [series "A" (zip ptsA_x ptsA_y), series "B" (zip ptsB_x ptsB_y)] defPlot{widthChars=68,heightChars=22}    -- histogram   heights <- replicateM 5000 (uniformRM (160 :: Double, 190 :: Double) g)-  putStrLn =<< histogram "Heights (cm)" (bins 30 155 195) heights defPlot{widthChars=68,heightChars=18,legendPos=LegendBottom}+  putStrLn $ histogram "Heights (cm)" (bins 30 155 195) heights defPlot{widthChars=68,heightChars=18,legendPos=LegendBottom}    -- bars-  putStrLn =<< bars "Sales" [("Q1",12),("Q2",18),("Q3",9),("Q4",15)] defPlot+  putStrLn $ bars "Sales" [("Q1",12),("Q2",18),("Q3",9),("Q4",15)] defPlot    -- pie-  putStrLn =<< pie "Share" [("Alpha",0.35),("Beta",0.25),("Gamma",0.20),("Delta",0.20)]+  putStrLn $ pie "Share" [("Alpha",0.35),("Beta",0.25),("Gamma",0.20),("Delta",0.20)]                          defPlot{widthChars=46,heightChars=18,legendPos=LegendRight}    -- line graph-  putStrLn =<< lineGraph "Monthly Sales Trends" [ ("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+  putStrLn $ lineGraph "Monthly Sales Trends" [ ("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      -- box plot-  putStrLn =<< boxPlot "Test Score Distribution by Class" [ ("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+  putStrLn $ boxPlot "Test Score Distribution by Class" [ ("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      -- stacked bar chart-  putStrLn =<< stackedBars "Quarterly Revenue Breakdown" [ ("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+  putStrLn $ stackedBars "Quarterly Revenue Breakdown" [ ("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      -- heatmap   let matrix = [ [1.0,  0.8,  0.3, -0.2,  0.1]@@ -54,4 +54,4 @@                , [-0.2, -0.1, 0.6,  1.0,  0.7]                , [0.1,  0.2,  0.4,  0.7,  1.0]                ]-  putStrLn =<< heatmap "Correlation Matrix" matrix defPlot+  putStrLn $ heatmap "Correlation Matrix" matrix defPlot

@@ -1,18 +1,22 @@ cabal-version:      3.0 name:               granite-version:            0.1.0.0+version:            0.1.0.1 synopsis:           Easy terminal plotting. description:        A terminal plotting library for quick and easy visualisation. license:            MIT license-file:       LICENSE author:             Michael Chavinda maintainer:         mschavinda@gmail.com--- copyright:+copyright:          (c) 2024-2025 Michael Chavinda+bug-reports:        https://github.com/mchav/granite/issues category:           Graphics build-type:         Simple extra-doc-files:    CHANGELOG.md--- extra-source-files: +source-repository head+  type:     git+  location: https://github.com/mchav/granite+ common warnings     ghc-options: -Wall @@ -28,12 +32,10 @@ executable granite     import:           warnings     main-is:          Main.hs-    -- other-modules:-    -- other-extensions:     build-depends:         base >=4 && <5,-        granite,-        random+        granite ^>= 0.1,+        random >= 1.2 && <= 1.3     hs-source-dirs:   app     default-language: Haskell2010 @@ -45,5 +47,5 @@     main-is:          Main.hs     build-depends:         base ^>=4,-        granite+        granite ^>= 0.1 

@@ -1,4 +1,6 @@+-- TODO: Remove bang patterns now that strict is enabled. {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Strict #-}  module Granite   (@@ -97,18 +99,18 @@ palette :: [Pat] palette = [Solid, Checker, DiagA, DiagB, Sparse] -data Array2D a = A2D !Int !Int ![a]+data Array2D a = A2D !Int !Int !(Arr a)  getA2D :: Array2D a -> Int -> Int -> a-getA2D (A2D w _ xs) x y = xs !! (y*w + x)+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 (take i xs ++ v : drop (i+1) xs)+  in A2D w h (setA xs i v)  newA2D :: Int -> Int -> a -> Array2D a-newA2D w h v = A2D w h (replicate (w*h) v)+newA2D w h v = A2D w h (fromList (replicate (w*h) v))  toBit :: Int -> Int -> Int toBit ry rx = case (ry,rx) of@@ -216,7 +218,7 @@   in unlines (attachY ++ [xBar, xLine])  axisifyGrid :: Plot -> [[(Char, Maybe Color)]] -> (Double,Double) -> (Double,Double) -> String-axisifyGrid cfg grid (xmin,xmax) (ymin,ymax) =+axisifyGrid cfg grid (!xmin,!xmax) (!ymin,!ymax) =   let plotH = length grid       plotW = if null grid then 0 else length (head grid)       left  = leftMargin cfg@@ -284,8 +286,8 @@ series :: String -> [(Double,Double)] -> (String, [(Double,Double)]) series = (,) -scatter :: String -> [(String, [(Double,Double)])] -> Plot -> IO String-scatter title sers cfg = pure $+scatter :: String -> [(String, [(Double,Double)])] -> Plot -> String+scatter title sers cfg =   let wC = widthChars cfg; hC = heightChars cfg       plotC = newCanvas wC hC       (xmin,xmax,ymin,ymax) = boundsXY (concatMap snd sers)@@ -293,9 +295,9 @@       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 =-        foldl' (\c (x,y) -> let xd = sx x; yd = sy y+      withSty = zipWith3 (\(!n,!ps) p c -> (n,ps,p,c)) sers pats cols+      drawOne (!_name, !pts, !pat, !col) c0 =+        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 = foldl' (flip drawOne) plotC withSty@@ -342,8 +344,8 @@ bins :: Int -> Double -> Double -> Bins bins n a b = Bins (max 1 n) (min a b) (max a b) -histogram :: String -> Bins -> [Double] -> Plot -> IO String-histogram title (Bins n a b) xs cfg = pure $+histogram :: String -> Bins -> [Double] -> Plot -> String+histogram title (Bins n a b) xs cfg =   let step    = (b - a) / fromIntegral n       binIx x = clamp 0 (n-1) $ floor ((x - a) / step)       counts  = foldl' (\acc x ->@@ -374,8 +376,8 @@ addAt :: [Int] -> Int -> Int -> [Int] addAt xs i v = take i xs ++ [xs !! i + v] ++ drop (i+1) xs -bars :: String -> [(String, Double)] -> Plot -> IO String-bars title kvs cfg = pure $+bars :: String -> [(String, Double)] -> Plot -> String+bars title kvs cfg =   let wC   = widthChars cfg       hC   = heightChars cfg       vals = map snd kvs@@ -383,7 +385,7 @@        cats :: [(String, Double, Color)]       cats = [ (name, abs v / vmax, col)-             | ((name, v), col) <- zip kvs (cycle paletteColors) ]+             | (!(!name, !v), !col) <- zip kvs (cycle paletteColors) ]        nCats = length cats @@ -411,8 +413,8 @@       titled = if null title then "" else title   in drawFrame cfg titled ax legend -pie :: String -> [(String, Double)] -> Plot -> IO String-pie title parts0 cfg = pure $+pie :: String -> [(String, Double)] -> Plot -> String+pie title parts0 cfg =   let parts = normalize parts0       wC = widthChars cfg; hC = heightChars cfg       plotC = newCanvas wC hC@@ -421,13 +423,13 @@       cx    = wDots `div` 2       cy    = hDots `div` 2       toAng p = p * 2*pi-      wedges = scanl (\a (_,p) -> a + toAng p) 0 parts+      wedges = scanl (\a (_,!p) -> a + toAng p) 0 parts       angles = zip wedges (tail wedges)       names  = map fst parts       cols   = cycle pieColors       withP  = zipWith3 (\n ang col -> (n,ang,col)) names angles cols -      drawOne (_name,(a0,a1),col) c0 =+      drawOne (!_name,(!a0,!a1),!col) c0 =         let inside x y =               let dx  = fromIntegral (x - cx)                   dy  = fromIntegral (cy - y)@@ -447,7 +449,7 @@ normalize :: [(String, Double)] -> [(String, Double)] normalize xs =   let s = sum (map (abs . snd) xs) + 1e-12-  in [ (n, max 0 (v / s)) | (n,v) <- xs ]+  in [ (n, max 0 (v / s)) | (!n,!v) <- xs ]  angleWithin :: Double -> Double -> Double -> Bool angleWithin ang a0 a1@@ -455,7 +457,7 @@   | otherwise = ang >= a0 || ang <= a1  lineDotsC :: (Int,Int) -> (Int,Int) -> Maybe Color -> Canvas -> Canvas-lineDotsC (x0,y0) (x1,y1) mcol c0 =+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))@@ -464,13 +466,13 @@         | 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')+                (!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 -lineGraph :: String -> [(String, [(Double,Double)])] -> Plot -> IO String-lineGraph title sers cfg = pure $+lineGraph :: String -> [(String, [(Double,Double)])] -> Plot -> String+lineGraph title sers cfg =   let wC = widthChars cfg; hC = heightChars cfg       plotC = newCanvas wC hC       (xmin,xmax,ymin,ymax) = boundsXY (concatMap snd sers)@@ -490,7 +492,7 @@       cDone = foldl' (flip drawSeries) plotC withSty       ax = axisify cfg cDone (xmin,xmax) (ymin,ymax)       legend = legendBlock (legendPos cfg) (leftMargin cfg + widthChars cfg)-                 [(n, Solid, col) | ((n,_), col) <- withSty]+                 [(n, Solid, col) | (!(!n,_), !col) <- withSty]       titled = if null title then "" else title   in drawFrame cfg titled ax legend @@ -506,12 +508,12 @@      then let m = sum xs / fromIntegral n in (m,m,m,m,m)      else (head sorted, getIdx q1Idx, getIdx q2Idx, getIdx q3Idx, last sorted) -boxPlot :: String -> [(String, [Double])] -> Plot -> IO String-boxPlot title datasets cfg = pure $+boxPlot :: String -> [(String, [Double])] -> Plot -> String+boxPlot title datasets cfg =   let wC = widthChars cfg       hC = heightChars cfg -      stats = [(name, quartiles vals) | (name, vals) <- datasets]+      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@@ -577,8 +579,8 @@       else grid       where setAt row i v = take i row ++ [v] ++ drop (i+1) row -heatmap :: String -> [[Double]] -> Plot -> IO String-heatmap title matrix cfg = pure $+heatmap :: String -> [[Double]] -> Plot -> String+heatmap title matrix cfg =   let rows = length matrix       cols = if null matrix then 0 else length (head matrix) @@ -633,8 +635,8 @@       titled = if null title then "" else title   in drawFrame cfg titled ax gradientLegend -stackedBars :: String -> [(String, [(String, Double)])] -> Plot -> IO String-stackedBars title categories cfg = pure $+stackedBars :: String -> [(String, [(String, Double)])] -> Plot -> String+stackedBars title categories cfg =   let wC = widthChars cfg       hC = heightChars cfg @@ -681,3 +683,88 @@                  [(name, Solid, col) | (name, col) <- seriesColors]       titled = if null title then "" else title   in drawFrame cfg titled ax legend++-- 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 {-# UNPACK #-} !Int {-# UNPACK #-} !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)      = ys1+          (!r, !ys3)   = build (n - n `div` 2 - 1) ys2+      in (mk l x r, ys3)