diff --git a/Chart.cabal b/Chart.cabal --- a/Chart.cabal +++ b/Chart.cabal @@ -1,5 +1,5 @@ Name: Chart -Version: 1.7.1 +Version: 1.8 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2014 @@ -21,7 +21,7 @@ , time, mtl, array , lens >= 3.9 && < 4.15 , colour >= 2.2.1 && < 2.4 - , data-default-class < 0.1 + , data-default-class < 0.2 , mtl >= 2.0 && < 2.3 , operational >= 0.2.2 && < 0.3 , vector >=0.9 && <0.12 diff --git a/Graphics/Rendering/Chart/Axis/Floating.hs b/Graphics/Rendering/Chart/Axis/Floating.hs --- a/Graphics/Rendering/Chart/Axis/Floating.hs +++ b/Graphics/Rendering/Chart/Axis/Floating.hs @@ -10,6 +10,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ScopedTypeVariables #-} module Graphics.Rendering.Chart.Axis.Floating( Percent(..), @@ -31,7 +32,7 @@ import Data.List(minimumBy) import Data.Ord (comparing) import Data.Default.Class -import Numeric (showFFloat) +import Numeric (showEFloat, showFFloat) import Control.Lens import Graphics.Rendering.Chart.Geometry @@ -77,6 +78,96 @@ fromValue d = LogValue (exp d) autoAxis = autoScaledLogAxis def +-- | Show a list of axis labels. +-- If some are too big or all are too small, switch to scientific notation for all. +-- If the range is much smaller than the mean, use an offset. +-- TODO: show this offset only once, not on every label. +-- When thinking about improving this function, +-- https://github.com/matplotlib/matplotlib/blob/master/lib/matplotlib/ticker.py +-- is a good read. +-- +-- >>> showDs [0, 1, 2 :: Double] +-- ["0","1","2"] +-- +-- >>> showDs [0, 1000000, 2000000 :: Double] +-- ["0.0e0","1.0e6","2.0e6"] +-- +-- >>> showDs [0, 0.001, 0.002 :: Double] +-- ["0","0.001","0.002"] +-- +-- >>> showDs [-10000000, -1000000, 9000000 :: Double] +-- ["-1.0e7","-1.0e6","9.0e6"] +-- +-- >>> showDs [10, 11, 12 :: Double] +-- ["10","11","12"] +-- +-- >>> showDs [100, 101, 102 :: Double] +-- ["100","101","102"] +-- +-- >>> showDs [100000, 100001, 100002 :: Double] +-- ["100000","100001","100002"] +-- +-- >>> showDs [1000000, 1000001, 1000002 :: Double] +-- ["1.0e6 + 0","1.0e6 + 1","1.0e6 + 2"] +-- +-- >>> showDs [10000000, 10000001, 10000002 :: Double] +-- ["1.0e7 + 0","1.0e7 + 1","1.0e7 + 2"] +-- +-- >>> showDs [-10000000, -10000001, -10000002 :: Double] +-- ["-1.0e7 + 2","-1.0e7 + 1","-1.0e7 + 0"] +-- +-- prop> let [s0, s1] = showDs [x, x + 1.0 :: Double] in s0 /= s1 +showDs :: forall d . (RealFloat d) => [d] -> [String] +showDs xs = case showWithoutOffset xs of + (s0:others) + | anyEqualNeighbor s0 others -> map addShownOffset $ showWithoutOffset (map (\x -> x - offset) xs) + s -> s + where + anyEqualNeighbor z0 (z1:others) + | z0 == z1 = True + | otherwise = anyEqualNeighbor z1 others + anyEqualNeighbor _ [] = False + + -- Use the min for offset. Another good choice could be the mean. + offset :: d + offset = minimum xs + shownOffset = case showWithoutOffset [offset] of + [r] -> r + rs -> error $ "showDs: shownOffset expected 1 element, got " ++ show (length rs) + + addShownOffset :: String -> String + addShownOffset ('-':x) = shownOffset ++ " - " ++ x + addShownOffset x = shownOffset ++ " + " ++ x + +showWithoutOffset :: RealFloat d => [d] -> [String] +showWithoutOffset xs + | useScientificNotation = map (\x -> showEFloat' (Just 1) x) xs + | otherwise = map showD xs + where + -- use scientific notation if max value is too big or too small + useScientificNotation = maxAbs >= 1e6 || maxAbs <= 1e-6 + maxAbs = maximum (map abs xs) + + +-- | Changes the behavior of showEFloat to drop more than one trailings 0. +-- Instead of 1.000e4 you get 1.0e4 +showEFloat' :: forall d . RealFloat d => Maybe Int -> d -> String +showEFloat' mdigits x = reverse $ cleanup0 (reverse shown0) + where + shown0 = showEFloat mdigits x "" + + -- wait until we get the "e" + cleanup0 :: String -> String + cleanup0 (e@'e':ys) = e:cleanup1 ys + cleanup0 (y:ys) = y : cleanup0 ys + cleanup0 [] = reverse shown0 -- something went wrong, just return the original + + -- get rid of redundant 0s before the '.' + cleanup1 :: String -> String + cleanup1 ('0':ys@('0':_)) = cleanup1 ys + cleanup1 y = y + + showD :: (RealFloat d) => d -> String showD x = case reverse $ showFFloat Nothing x "" of '0':'.':r -> reverse r @@ -84,7 +175,7 @@ data LinearAxisParams a = LinearAxisParams { -- | The function used to show the axes labels. - _la_labelf :: a -> String, + _la_labelf :: [a] -> [String], -- | The target number of labels to be shown. _la_nLabels :: Int, @@ -95,7 +186,7 @@ instance (Show a, RealFloat a) => Default (LinearAxisParams a) where def = LinearAxisParams - { _la_labelf = showD + { _la_labelf = showDs , _la_nLabels = 5 , _la_nTicks = 50 } @@ -136,7 +227,8 @@ chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) stepVals where delta = x2 - x1 - mult = 10 ^^ ((floor $ log10 $ delta / nsteps)::Integer) + mult | delta == 0 = 1 -- Otherwise the case below will use all of memory + | otherwise = 10 ^^ ((floor $ log10 $ delta / nsteps)::Integer) stepVals = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50] proximity x = abs $ delta / realToFrac x - nsteps @@ -157,7 +249,7 @@ instance (Show a, RealFloat a) => Default (LogAxisParams a) where def = LogAxisParams - { _loga_labelf = showD + { _loga_labelf = showDs } -- | Generate a log axis automatically, scaled appropriate for the @@ -178,7 +270,7 @@ data LogAxisParams a = LogAxisParams { -- | The function used to show the axes labels. - _loga_labelf :: a -> String + _loga_labelf :: [a] -> [String] } {- @@ -249,4 +341,3 @@ $( makeLenses ''LinearAxisParams ) $( makeLenses ''LogAxisParams ) - diff --git a/Graphics/Rendering/Chart/Axis/Int.hs b/Graphics/Rendering/Chart/Axis/Int.hs --- a/Graphics/Rendering/Chart/Axis/Int.hs +++ b/Graphics/Rendering/Chart/Axis/Int.hs @@ -29,7 +29,7 @@ defaultIntAxis :: (Show a) => LinearAxisParams a defaultIntAxis = LinearAxisParams { - _la_labelf = show, + _la_labelf = map show, _la_nLabels = 5, _la_nTicks = 10 } diff --git a/Graphics/Rendering/Chart/Axis/Types.hs b/Graphics/Rendering/Chart/Axis/Types.hs --- a/Graphics/Rendering/Chart/Axis/Types.hs +++ b/Graphics/Rendering/Chart/Axis/Types.hs @@ -196,10 +196,10 @@ let vh = maximum0 (map (maximum0.map snd) labelSizes) let sz = case at of - E_Top -> (hw,hh) - E_Bottom -> (hw,hh) - E_Left -> (vw,vh) - E_Right -> (vw,vh) + E_Top -> (hw,hh) + E_Bottom -> (hw,hh) + E_Left -> (vw,vh) + E_Right -> (vw,vh) return sz labelTexts :: AxisData a -> [[String]] @@ -354,7 +354,7 @@ -- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the labelling function -makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x +makeAxis :: PlotValue x => ([x] -> [String]) -> ([x],[x],[x]) -> AxisData x makeAxis labelf (labelvs, tickvs, gridvs) = AxisData { _axis_visibility = def, _axis_viewport = newViewport, @@ -367,13 +367,19 @@ newViewport = vmap (min',max') newTropweiv = invmap (min',max') newTicks = [ (v,2) | v <- tickvs ] ++ [ (v,5) | v <- labelvs ] - newLabels = [ (v,labelf v) | v <- labelvs ] + newLabels = zipWithLengthCheck labelvs (labelf labelvs) + where + zipWithLengthCheck (x:xs) (y:ys) = (x,y) : zipWithLengthCheck xs ys + zipWithLengthCheck [] [] = [] + zipWithLengthCheck _ _ = + error "makeAxis: label function returned the wrong number of labels" + min' = minimum labelvs max' = maximum labelvs -- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the positioning and labelling functions -makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> (x -> String) +makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> ([x] -> [String]) -> ([x],[x],[x]) -> AxisData x makeAxis' t f labelf (labelvs, tickvs, gridvs) = AxisData { _axis_visibility = def, @@ -381,7 +387,12 @@ _axis_tropweiv = invLinMap f t (minimum labelvs, maximum labelvs), _axis_ticks = zip tickvs (repeat 2) ++ zip labelvs (repeat 5), _axis_grid = gridvs, - _axis_labels = [[ (v,labelf v) | v <- labelvs ]] + _axis_labels = + let zipWithLengthCheck (x:xs) (y:ys) = (x,y) : zipWithLengthCheck xs ys + zipWithLengthCheck [] [] = [] + zipWithLengthCheck _ _ = + error "makeAxis': label function returned the wrong number of labels" + in [zipWithLengthCheck labelvs (labelf labelvs)] } diff --git a/Graphics/Rendering/Chart/Legend.hs b/Graphics/Rendering/Chart/Legend.hs --- a/Graphics/Rendering/Chart/Legend.hs +++ b/Graphics/Rendering/Chart/Legend.hs @@ -53,23 +53,34 @@ legendToRenderable :: Legend x y -> Renderable String legendToRenderable (Legend ls lvs) = gridToRenderable grid where + grid :: Grid (Renderable String) grid = case _legend_orientation ls of LORows n -> mkGrid n aboveG besideG LOCols n -> mkGrid n besideG aboveG + aboveG, besideG :: [Grid (Renderable String)] -> Grid (Renderable String) aboveG = aboveN.intersperse ggap1 besideG = besideN.intersperse ggap1 + mkGrid :: Int + -> ([Grid (Renderable String)] -> Grid (Renderable String)) + -> ([Grid (Renderable String)] -> Grid (Renderable String)) + -> Grid (Renderable String) mkGrid n join1 join2 = join1 [ join2 (map rf ps1) | ps1 <- groups n ps ] ps :: [(String, [Rect -> BackendProgram ()])] ps = join_nub lvs - rf :: (String,[Rect -> BackendProgram ()]) -> Grid (Renderable String) + rf :: (String, [Rect -> BackendProgram ()]) -> Grid (Renderable String) rf (title,rfs) = besideN [gpic,ggap2,gtitle] where + gpic :: Grid (Renderable String) gpic = besideN $ intersperse ggap2 (map rp rfs) + + gtitle :: Grid (Renderable String) gtitle = tval $ lbl title + + rp :: (Rect -> BackendProgram ()) -> Grid (Renderable String) rp rfn = tval Renderable { minsize = return (_legend_plot_size ls, 0), render = \(w,h) -> do @@ -77,8 +88,11 @@ return (\_-> Just title) } + ggap1, ggap2 :: Grid (Renderable String) ggap1 = tval $ spacer (_legend_margin ls,_legend_margin ls / 2) ggap2 = tval $ spacer1 (lbl "X") + + lbl :: String -> Renderable String lbl = label (_legend_label_style ls) HTA_Left VTA_Centre groups :: Int -> [a] -> [[a]] diff --git a/Graphics/Rendering/Chart/Plot/Annotation.hs b/Graphics/Rendering/Chart/Plot/Annotation.hs --- a/Graphics/Rendering/Chart/Plot/Annotation.hs +++ b/Graphics/Rendering/Chart/Plot/Annotation.hs @@ -40,9 +40,9 @@ instance ToPlot PlotAnnotation where toPlot p = Plot { - _plot_render = renderAnnotation p, - _plot_legend = [], - _plot_all_points = (map (^._1) vs , map (^._2) vs) + _plot_render = renderAnnotation p, + _plot_legend = [], + _plot_all_points = (map (^._1) vs , map (^._2) vs) } where vs = _plot_annotation_values p diff --git a/Graphics/Rendering/Chart/Plot/AreaSpots.hs b/Graphics/Rendering/Chart/Plot/AreaSpots.hs --- a/Graphics/Rendering/Chart/Plot/AreaSpots.hs +++ b/Graphics/Rendering/Chart/Plot/AreaSpots.hs @@ -49,7 +49,7 @@ , _area_spots_linecolour :: AlphaColour Double , _area_spots_fillcolour :: Colour Double , _area_spots_opacity :: Double - , _area_spots_max_radius :: Double -- ^ the largest size of spot + , _area_spots_max_radius :: Double -- ^ the largest size of spot , _area_spots_values :: [(x,y,z)] } @@ -118,7 +118,7 @@ , _area_spots_4d_linethick :: Double , _area_spots_4d_palette :: [Colour Double] , _area_spots_4d_opacity :: Double - , _area_spots_4d_max_radius :: Double -- ^ the largest size of spot + , _area_spots_4d_max_radius :: Double -- ^ the largest size of spot , _area_spots_4d_values :: [(x,y,z,t)] }