Chart 0.11 → 0.12
raw patch · 7 files changed
+515/−176 lines, 7 files
Files
- Chart.cabal +4/−3
- Graphics/Rendering/Chart/Axis.hs +151/−33
- Graphics/Rendering/Chart/Grid.hs +103/−50
- Graphics/Rendering/Chart/Layout.hs +109/−42
- Graphics/Rendering/Chart/Pie.hs +1/−1
- Graphics/Rendering/Chart/Plot.hs +92/−29
- tests/test.hs +55/−18
Chart.cabal view
@@ -1,5 +1,5 @@ Name: Chart-Version: 0.11+Version: 0.12 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2009@@ -19,10 +19,11 @@ library if flag(splitbase)- Build-depends: base >= 3, old-locale, time, mtl, array+ Build-depends: base >= 3 && < 5, old-locale, time, mtl, array else Build-depends: base < 3- Build-depends: gtk >= 0.9.11, cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3, colour >= 2.2.1+ Build-depends: gtk >= 0.9.11, cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*, + data-accessor-template >= 0.2.1.1 && < 0.3, colour >= 2.2.1 Exposed-modules: Graphics.Rendering.Chart,
Graphics/Rendering/Chart/Axis.hs view
@@ -11,8 +11,6 @@ -- -- * 'AxisData' ----- * 'Axis'--- -- * 'AxisStyle' -- -- * 'LinearAxisParams'@@ -41,18 +39,22 @@ PlotIndex(..), AxisFn, - defaultAxisLineStyle, + defaultAxisLineStyle, defaultLinearAxis,+ defaultIntAxis, defaultLogAxis, defaultAxisStyle, autoScaledAxis, autoScaledLogAxis,+ unitAxis, timeAxis, autoTimeAxis, days, months, years, autoIndexAxis, addIndexes, + autoSteps,+ axisToRenderable, renderAxisGrid, axisOverhang,@@ -84,6 +86,7 @@ import qualified Graphics.Rendering.Cairo as C import Data.Time+import Data.Fixed import System.Locale (defaultTimeLocale) import Control.Monad import Data.List@@ -109,7 +112,7 @@ -- towards the plot area. axis_ticks_ :: [(x,Double)], - -- | The labels on an axis as pairs. The first element + -- | The labels on an axis as pairs. The first element -- is the position on the axis (in viewport units) and -- the second is the label text string. axis_labels_ :: [ (x, String) ],@@ -129,7 +132,6 @@ axis_label_gap_ :: Double } - -- | A function to generate the axis data given the data values -- to be plotted against it. type AxisFn x = [x] -> AxisData x@@ -221,12 +223,12 @@ where (sx,sy,ex,ey,tp,axisPoint) = axisMapping at sz - drawTick (value,length) = + drawTick (value,length) = let t1 = axisPoint value t2 = t1 `pvadd` (vscale length tp) in strokeLines [t1,t2] - (hta,vta,lp) = + (hta,vta,lp) = let g = axis_label_gap_ as in case et of E_Top -> (HTA_Centre,VTA_Bottom,(Vector 0 (-g)))@@ -239,7 +241,7 @@ axisMapping :: AxisT z -> RectSize -> (Double,Double,Double,Double,Vector,z->Point) axisMapping (AxisT et as rev ad) (x2,y2) = case et of- E_Top -> (x1,y2,x2,y2, (Vector 0 1), mapx (x1,x2) y2) + E_Top -> (x1,y2,x2,y2, (Vector 0 1), mapx (x1,x2) y2) E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx (x1,x2) y1) E_Left -> (x2,y2,x2,y1, (Vector (1) 0), mapy (y1,y2) x2) E_Right -> (x1,y2,x1,y1, (Vector (-1) 0), mapy (y1,y2) x1)@@ -270,8 +272,24 @@ in strokeLines [Point 0 v',Point w v'] +stepsInt :: Int -> Range -> [Int]+stepsInt nSteps range = bestSize (goodness alt0) alt0 alts+ where+ bestSize n a (a':as) = let n' = goodness a' in if n' < n then bestSize n' a' as else a -steps:: Double -> Range -> [Rational]+ goodness vs = abs (length vs - nSteps)++ (alt0:alts) = map (\n -> steps n range) sampleSteps++ sampleSteps = [1,2,5] ++ sampleSteps1+ sampleSteps1 = [10,20,25,50] ++ map (*10) sampleSteps1++ steps size (min,max) = takeWhile (<b) [a,a+size..] ++ [b]+ where+ a = (floor (min / fromIntegral size)) * size+ b = (ceiling (max / fromIntegral size)) * size++steps :: Double -> Range -> [Rational] steps nSteps (min,max) = [ (fromIntegral (min' + i)) * s | i <- [0..n] ] where min' = floor (min / fromRational s)@@ -287,6 +305,19 @@ steps' = sort [ (abs((max-min)/(fromRational s) - nsteps), s) | s <- steps ] s = snd (head steps') +-- | Given a target number of values, and a list of input points,+-- find evenly spaced values from the set {1*X, 2*X, 2.5*X, 5*X} (where+-- X is some power of ten) that evenly cover the input points.+autoSteps :: Int -> [Double] -> [Double]+autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r+ where+ range [] = (0,1)+ range _ | min == max = (min-0.5,min+0.5)+ | otherwise = (min,max)+ (min,max) = (minimum ps,maximum ps)+ ps = filter isValidNumber vs+ r = range ps+ makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x makeAxis labelf (labelvs, tickvs, gridvs) = AxisData { axis_viewport_=newViewport,@@ -296,16 +327,18 @@ } where newViewport = vmap (min',max')- newTicks = [ (v,2) | v <- tickvs ] ++ [ (v,5) | v <- labelvs ] + newTicks = [ (v,2) | v <- tickvs ] ++ [ (v,5) | v <- labelvs ] newLabels = [(v,labelf v) | v <- labelvs] min' = minimum labelvs max' = maximum labelvs ++ data GridMode = GridNone | GridAtMajor | GridAtMinor -data LinearAxisParams = LinearAxisParams {+data LinearAxisParams a = LinearAxisParams { -- | The function used to show the axes labels- la_labelf_ :: Double -> String,+ la_labelf_ :: a -> String, -- | The target number of labels to be shown la_nLabels_ :: Int,@@ -321,19 +354,25 @@ la_nTicks_ = 50 } +defaultIntAxis = LinearAxisParams {+ la_labelf_ = show,+ la_nLabels_ = 5,+ la_nTicks_ = 10+}+ -- | Generate a linear axis automatically. -- The supplied axis is used as a template, with the viewport, ticks, labels -- and grid set appropriately for the data displayed against that axies. -- The resulting axis will only show a grid if the template has some grid -- values.-autoScaledAxis :: LinearAxisParams -> AxisFn Double+autoScaledAxis :: LinearAxisParams Double -> AxisFn Double autoScaledAxis lap ps0 = makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs) where ps = filter isValidNumber ps0 (min,max) = (minimum ps,maximum ps) range [] = (0,1) range _ | min == max = (min-0.5,min+0.5)- | otherwise = (min,max)+ | otherwise = (min,max) labelvs = map fromRational $ steps (fromIntegral (la_nLabels_ lap)) r tickvs = map fromRational $ steps (fromIntegral (la_nTicks_ lap)) (minimum labelvs,maximum labelvs) gridvs = labelvs@@ -342,8 +381,22 @@ showD x = case reverse $ show x of '0':'.':r -> reverse r _ -> show x- +autoScaledIntAxis :: LinearAxisParams Int -> AxisFn Int+autoScaledIntAxis lap ps = makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs)+ where+ (min,max) = (minimum ps,maximum ps)+ range [] = (0,1)+ range _ | min == max = (fromIntegral $ min-1, fromIntegral $ min+1)+ | otherwise = (fromIntegral $ min, fromIntegral $ max)+ labelvs :: [Int]+ labelvs = stepsInt (la_nLabels_ lap) r+ tickvs = stepsInt (la_nTicks_ lap) $+ (fromIntegral $ minimum labelvs,fromIntegral $ maximum labelvs)+ gridvs = labelvs+ r = range ps++ log10 :: (Floating a) => a -> a log10 = logBase 10 @@ -352,11 +405,11 @@ where (a,b) = properFraction x -{- +{- Rules: Do no subdivide between powers of 10 until all powers of 10 get a major ticks. Do not subdivide between powers of ten as [1,2,4,6,8,10] when- 5 gets a major ticks + 5 gets a major ticks (ie the major ticks need to be a subset of the minor tick) -} logTicks :: Range -> ([Rational],[Rational],[Rational])@@ -369,7 +422,7 @@ (minimum (10:(filter (\x -> r <= log10 (fromRational x)) l)))*10^^i inRange (a,b) l x = (lower a l <= x) && (x <= upper b l) powers :: (Double,Double) -> [Rational] -> [Rational]- powers (x,y) l = [a*10^^p | p<-[(floor (log10 x))..(ceiling (log10 y))], a<-l]+ powers (x,y) l = [a*10^^p | p<- [(floor (log10 x))..(ceiling (log10 y))], a<- l] midselection r l = filter (inRange r l) (powers r l) major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $ steps (min 5 (log10 ratio)) (log10 low, log10 high)@@ -391,9 +444,9 @@ powers (dl', dh') [1,10] | 3 < log10 ratio' = filter (\x -> l'<=x && x <=h') $ powers (dl',dh') [1,5,10]- | 6 < ratio' = filter (\x -> l'<=x && x <=h') $ + | 6 < ratio' = filter (\x -> l'<=x && x <=h') $ powers (dl',dh') [1..10]- | 3 < ratio' = filter (\x -> l'<=x && x <=h') $ + | 3 < ratio' = filter (\x -> l'<=x && x <=h') $ powers (dl',dh') [1,1.2..10] | otherwise = steps 50 (dl', dh') @@ -441,12 +494,12 @@ -- | Map a LocalTime value to a plot cordinate doubleFromLocalTime :: LocalTime -> Double-doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt)) +doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt)) + fromRational (timeOfDayToDayFraction (localTimeOfDay lt)) -- | Map a plot cordinate to a LocalTime localTimeFromDouble :: Double -> LocalTime-localTimeFromDouble v = +localTimeFromDouble v = LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d)) where (i,d) = properFraction v@@ -501,6 +554,51 @@ m1' = doubleFromLocalTime m1 m2' = doubleFromLocalTime m2 +normalizeTimeOfDay :: LocalTime -> LocalTime+normalizeTimeOfDay t@(LocalTime day (TimeOfDay h m s))+ | s >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m+s`div'`60) (s`mod'`60)))+ | m >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay (h+m`div`60) (m`mod`60) s))+ | h >= 24 = LocalTime (addDays (fromIntegral (h`div`24)) day) (TimeOfDay (h`mod`24) m s)+ | otherwise = t++addTod :: Int -> Int -> Int -> LocalTime -> LocalTime+addTod dh dm ds (LocalTime day (TimeOfDay h m s)) = normalizeTimeOfDay t'+ where t' = LocalTime day (TimeOfDay (h+dh) (m+dm) (s+fromIntegral ds))+++-- | A 'TimeSeq' for hours+seconds :: TimeSeq+seconds t = (iterate rev t1, tail (iterate fwd t1))+ where h0 = todHour (localTimeOfDay t)+ m0 = todMin (localTimeOfDay t)+ s0 = todSec (localTimeOfDay t)+ t0 = LocalTime (localDay t) (TimeOfDay h0 m0 s0)+ t1 = if t0 < t then t0 else (rev t0)+ rev = addTod 0 0 (-1)+ fwd = addTod 0 0 1+ toTime h = LocalTime++-- | A 'TimeSeq' for hours+minutes :: TimeSeq+minutes t = (iterate rev t1, tail (iterate fwd t1))+ where h0 = todHour (localTimeOfDay t)+ m0 = todMin (localTimeOfDay t)+ t0 = LocalTime (localDay t) (TimeOfDay h0 m0 0)+ t1 = if t0 < t then t0 else (rev t0)+ rev = addTod 0 (-1)0+ fwd = addTod 0 1 0+ toTime h = LocalTime++-- | A 'TimeSeq' for hours+hours :: TimeSeq+hours t = (iterate rev t1, tail (iterate fwd t1))+ where h0 = todHour (localTimeOfDay t)+ t0 = LocalTime (localDay t) (TimeOfDay h0 0 0)+ t1 = if t0 < t then t0 else (rev t0)+ rev = addTod (-1) 0 0+ fwd = addTod 1 0 0+ toTime h = LocalTime+ -- | A 'TimeSeq' for calendar days days :: TimeSeq days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))@@ -532,22 +630,34 @@ -- The values to be plotted against this axis can be created with 'doubleFromLocalTime' autoTimeAxis :: AxisFn LocalTime autoTimeAxis [] = timeAxis days days (formatTime defaultTimeLocale "%d-%b") []-autoTimeAxis pts = - if tdiff < 15- then timeAxis days days (ft "%d-%b") pts- else if tdiff < 90- then timeAxis days months (ft "%b-%y") pts- else if tdiff < 450- then timeAxis months months (ft "%b-%y") pts- else if tdiff < 1800- then timeAxis months years (ft "%Y") pts- else timeAxis years years (ft "%Y") pts+autoTimeAxis pts+ | tdiff==0 && dsec<60 = timeAxis seconds seconds (ft "%H:%M:%S") pts+ | tdiff==0 && dsec<3600 = timeAxis minutes minutes (ft "%H:%M") pts+ | tdiff < 1 = timeAxis hours hours (ft "%H:%M") pts+ | tdiff < 2 = timeAxis days hours (ft "%d-%b") pts+ | tdiff < 15 = timeAxis days days (ft "%d-%b") pts+ | tdiff < 90 = timeAxis days months (ft "%b-%y") pts+ | tdiff < 450 = timeAxis months months (ft "%b-%y") pts+ | tdiff < 1800 = timeAxis months years (ft "%Y") pts+ | otherwise = timeAxis years years (ft "%Y") pts where tdiff = diffDays (localDay t1) (localDay t0)+ dsec = fromIntegral (3600*(h1-h0)+60*(m1-m0))+(s1-s0)+ where (TimeOfDay h0 m0 s0) = localTimeOfDay t0+ (TimeOfDay h1 m1 s1) = localTimeOfDay t1 t1 = maximum pts t0 = minimum pts ft = formatTime defaultTimeLocale ++unitAxis :: AxisData ()+unitAxis = AxisData {+ axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2,+ axis_ticks_ = [((), 0)],+ axis_labels_ = [((), "")],+ axis_grid_ = []+}+ ----------------------------------------------------------------------------- class Ord a => PlotValue a where@@ -568,6 +678,14 @@ toValue (LogValue x) = log x autoAxis = autoScaledLogAxis defaultLogAxis +instance PlotValue Int where+ toValue = fromIntegral+ autoAxis = autoScaledIntAxis defaultIntAxis++instance PlotValue () where+ toValue () = 0+ autoAxis = const unitAxis+ instance PlotValue LocalTime where toValue = doubleFromLocalTime autoAxis = autoTimeAxis@@ -583,7 +701,7 @@ toValue (PlotIndex i)= fromIntegral i autoAxis = autoIndexAxis [] --- | Create an axis for values indexed by position. The +-- | Create an axis for values indexed by position. The -- list of strings are the labels to be used. autoIndexAxis :: [String] -> [PlotIndex] -> AxisData PlotIndex autoIndexAxis labels vs = AxisData {
Graphics/Rendering/Chart/Grid.hs view
@@ -1,5 +1,5 @@ module Graphics.Rendering.Chart.Grid (- Grid,+ Grid, Span, tval, tspan, empty, nullt, (.|.), (./.),@@ -8,31 +8,45 @@ overlay, width, height, gridToRenderable,- weights+ weights,+ fullRowAbove,+ fullRowBelow,+ fullColLeft,+ fullColRight,+ fullOverlayUnder,+ fullOverlayOver ) where import Data.List import Data.Array--- import qualified Data.Map as Map import Control.Monad+import Control.Monad.Trans import Numeric import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Types---import Graphics.Rendering.Chart.Gtk import qualified Graphics.Rendering.Cairo as C +import Data.Colour+import Data.Colour.Names+ type Span = (Int,Int) type Size = (Int,Int)+-- | When more space is available for an item than the total width of items,+-- extra added space is proportional to 'space weight'. type SpaceWeight = (Double,Double) type Cell a = (a,Span,SpaceWeight) -data Grid a = Value (a,Span,SpaceWeight)- | Above (Grid a) (Grid a) Size - | Beside (Grid a) (Grid a) Size- | Overlay (Grid a) (Grid a) Size- | Empty- | Null+-- | Abstract datatype representing a grid.+data Grid a = Value (a,Span,SpaceWeight) -- ^ A singleton grid item "a" spanning a given+ -- rectangle (measured in grid cells), with+ -- given space weight.+ | Above (Grid a) (Grid a) Size -- ^ One grid above the other. "Size" is their cached+ -- total size (so it is NOT specified manually).+ | Beside (Grid a) (Grid a) Size -- ^ One grid horizontally beside the other+ | Overlay (Grid a) (Grid a) Size -- ^ Two grids positioned one over the other+ | Empty -- ^ An empty 1x1 grid cell+ | Null -- ^ An empty 0x0 grid cell deriving (Show) width :: Grid a -> Int@@ -51,14 +65,20 @@ height (Above _ _ (w,h)) = h height (Overlay _ _ (w,h)) = h +-- | A 1x1 grid from a given value, with no extra space. tval :: a -> Grid a tval a = Value (a,(1,1),(0,0)) +-- | A WxH (measured in cells) grid from a given value, with space weight (1,1). tspan :: a -> Span -> Grid a tspan a span = Value (a,span,(1,1)) -empty, nullt :: Grid a+-- | A 1x1 empty grid.+empty :: Grid a empty = Empty++-- | A 0x0 empty grid.+nullt :: Grid a nullt = Null above, beside :: Grid a -> Grid a -> Grid a@@ -66,7 +86,31 @@ above t Null = t above t1 t2 = Above t1 t2 size where size = (max (width t1) (width t2), height t1 + height t2)- ++-- | A value placed above the grid, occupying 1 row with the same horizontal span as the grid.+fullRowAbove :: a -> Double -> Grid a -> Grid a+fullRowAbove a w g = (weights (0,w) $ tspan a (width g,1)) `above` g++-- | A value placed below the grid, occupying 1 row with the same horizontal span as the grid.+fullRowBelow :: a -> Double -> Grid a -> Grid a+fullRowBelow a w g = g `above` (weights (0,w) $ tspan a (width g,1))++-- | A value placed to the left of the grid, occupying 1 column with the same vertical span as the grid.+fullColLeft :: a -> Double -> Grid a -> Grid a+fullColLeft a w g = (weights (w,0) $ tspan a (1,height g)) `beside` g++-- | A value placed to the right of the grid, occupying 1 column with the same vertical span as the grid.+fullColRight :: a -> Double -> Grid a -> Grid a+fullColRight a w g = g `beside` (weights (w,0) $ tspan a (1,height g))++-- | A value placed under a grid, with the same span as the grid.+fullOverlayUnder :: a -> Grid a -> Grid a+fullOverlayUnder a g = g `overlay` (tspan a (width g,height g))++-- | A value placed over a grid, with the same span as the grid.+fullOverlayOver :: a -> Grid a -> Grid a+fullOverlayOver a g = (tspan a (width g,height g)) `overlay` g+ beside Null t = t beside t Null = t beside t1 t2 = Beside t1 t2 size@@ -76,6 +120,8 @@ aboveN = foldl above nullt besideN = foldl beside nullt +-- | One grid over the other. The first argument is shallow, the second is deep.+overlay :: Grid a -> Grid a -> Grid a overlay Null t = t overlay t Null = t overlay t1 t2 = Overlay t1 t2 size@@ -84,6 +130,7 @@ (.|.) = beside (./.) = above +-- | Sets the space weight of *every* cell of the grid to given value. weights :: SpaceWeight -> Grid a -> Grid a weights sw Null = Null weights sw Empty = Empty@@ -104,7 +151,7 @@ fmap f Null = Null mapGridM :: Monad m => (a -> m b) -> Grid a -> m (Grid b)-mapGridM f (Value (a,span,ew)) = do +mapGridM f (Value (a,span,ew)) = do b <- f a return (Value (b,span,ew)) mapGridM f (Above t1 t2 s) = do@@ -154,83 +201,88 @@ foldT :: ((Int,Int) -> Cell a -> r -> r) -> r -> FlatGrid a -> r foldT f iv ft = foldr f' iv (assocs ft) where- f' (i,vs) r = foldr (\cell -> f i cell) r vs + f' (i,vs) r = foldr (\cell -> f i cell) r vs ---------------------------------------------------------------------- type DArray = Array Int Double -gridToRenderable :: Grid (Renderable a) -> Renderable a-gridToRenderable t = Renderable minsizef renderf+getSizes :: Grid (Renderable a) -> CRender (DArray, DArray, DArray, DArray)+getSizes t = do+ szs <- mapGridM minsize t :: CRender (Grid RectSize)+ let szs' = flatten szs+ let widths = accumArray max 0 (0, width t - 1) (foldT (ef wf fst) [] szs')+ let heights = accumArray max 0 (0, height t - 1) (foldT (ef hf snd) [] szs')+ let xweights = accumArray max 0 (0, width t - 1) (foldT (ef xwf fst) [] szs')+ let yweights = accumArray max 0 (0, height t - 1) (foldT (ef ywf snd) [] szs')+ return (widths,heights,xweights,yweights) where- getSizes :: CRender (DArray, DArray, DArray, DArray)- getSizes = do- szs <- mapGridM minsize t :: CRender (Grid RectSize)- let szs' = flatten szs- let widths = accumArray max 0 (0, width t - 1) (foldT (ef wf) [] szs')- let heights = accumArray max 0 (0, height t - 1) (foldT (ef hf) [] szs')- let xweights = accumArray max 0 (0, width t - 1) (foldT (ef xwf) [] szs')- let yweights = accumArray max 0 (0, height t - 1) (foldT (ef ywf) [] szs')- return (widths,heights,xweights,yweights)+ wf (x,y) (w,h) (ww,wh) = (x,w)+ hf (x,y) (w,h) (ww,wh) = (y,h)+ xwf (x,y) (w,h) (xw,yw) = (x,xw)+ ywf (x,y) (w,h) (xw,yw) = (y,yw) - wf (x,y) (w,h) (ww,wh) = (x,w)- hf (x,y) (w,h) (ww,wh) = (y,h)- xwf (x,y) (w,h) (xw,yw) = (x,xw)- ywf (x,y) (w,h) (xw,yw) = (y,yw)+ ef f ds loc (size,span,ew) r | ds span == 1 = (f loc size ew:r)+ | otherwise = r - ef f loc (size,span,ew) | span == (1,1) = (f loc size ew:)- | otherwise = id- +gridToRenderable :: Grid (Renderable a) -> Renderable a+gridToRenderable t = Renderable minsizef renderf+ where+ minsizef :: CRender RectSize minsizef = do- (widths, heights, xweights, yweights) <- getSizes+ (widths, heights, xweights, yweights) <- getSizes t return (sum (elems widths), sum (elems heights)) renderf (w,h) = do- (widths, heights, xweights, yweights) <- getSizes+ (widths, heights, xweights, yweights) <- getSizes t let widths' = addExtraSpace w widths xweights let heights' = addExtraSpace h heights yweights- let csizes = (ctotal widths',ctotal heights')- rf1 csizes (0,0) t+ let borders = (ctotal widths',ctotal heights')+ rf1 borders (0,0) t - rf1 csizes loc@(i,j) t = case t of+ -- (x borders, y borders) -> (x,y) -> grid -> drawing+ rf1 borders loc@(i,j) t = case t of Null -> return nullPickFn Empty -> return nullPickFn (Value (r,span,_)) -> do- let (Rect p0 p1) = mkRect csizes loc span+ let (Rect p0 p1) = mkRect borders loc span p0'@(Point x0 y0) <- alignc p0 p1'@(Point x1 y1) <- alignc p1 preserveCState $ do c $ C.translate x0 y0 render r (x1-x0,y1-y0) (Above t1 t2 _) -> do- pf1 <- rf1 csizes (i,j) t1- pf2 <- rf1 csizes (i,j+height t1) t2- let pf p@(Point x y) = if y < (snd csizes ! (j + height t1)) then pf1 p- else pf2 p+ pf1 <- rf1 borders (i,j) t1+ pf2 <- rf1 borders (i,j+height t1) t2+ let pf p@(Point x y) = if y < (snd borders ! (j + height t1)) then pf1 p+ else pf2 p return pf (Beside t1 t2 _) -> do- pf1 <- rf1 csizes (i,j) t1- pf2 <- rf1 csizes (i+width t1,j) t2- let pf p@(Point x y) = if x < (fst csizes ! (i + width t1)) then pf1 p- else pf2 p+ pf1 <- rf1 borders (i,j) t1+ pf2 <- rf1 borders (i+width t1,j) t2+ let pf p@(Point x y) = if x < (fst borders ! (i + width t1)) then pf1 p+ else pf2 p return pf (Overlay t1 t2 _) -> do- pf2 <- rf1 csizes (i,j) t2- pf1 <- rf1 csizes (i,j) t1+ pf2 <- rf1 borders (i,j) t2+ pf1 <- rf1 borders (i,j) t1 let pf p = pf1 p `mplus` pf2 p return pf + -- (x borders, y borders) -> (x,y) -> (w,h) -> rectangle of grid[x..x+w, y..y+h] mkRect :: (DArray, DArray) -> (Int,Int) -> (Int,Int) -> Rect mkRect (cwidths,cheights) (x,y) (w,h) = Rect (Point x1 y1) (Point x2 y2) where x1 = cwidths ! x y1 = cheights ! y- x2 = cwidths ! min (x+w) (snd $ bounds cwidths) + x2 = cwidths ! min (x+w) (snd $ bounds cwidths) y2 = cheights ! min (y+h) (snd $ bounds cheights) mx = fst (bounds cwidths) my = fst (bounds cheights) + -- total size -> item sizes -> item weights -> new item sizes such that+ -- their sum == total size, and added size is proportional to weight addExtraSpace :: Double -> DArray -> DArray -> DArray- addExtraSpace size sizes weights = + addExtraSpace size sizes weights = if totalws == 0 then sizes else listArray (bounds sizes) sizes' where@@ -240,5 +292,6 @@ extras = map (*(extra/totalws)) ws sizes' = zipWith (+) extras (elems sizes) + -- [1,2,3] -> [0,1,3,6]. ctotal :: DArray -> DArray ctotal a = listArray (let (i,j) = bounds a in (i,j+1)) (scanl (+) 0 (elems a))
Graphics/Rendering/Chart/Layout.hs view
@@ -58,7 +58,11 @@ layout1_margin, layout1_plots, layout1_legend,- layout1_grid_last+ layout1_grid_last,++ renderLayout1sStacked,+ AnyLayout1(),+ withAnyOrdinate ) where import qualified Graphics.Rendering.Cairo as C@@ -142,19 +146,97 @@ instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where toRenderable = setPickFn nullPickFn.layout1ToRenderable +-- | Encapsulates a 'Layout1' with a fixed abscissa type but arbitrary ordinate type.+data AnyLayout1 x = AnyLayout1 {+ background :: CairoFillStyle,+ titleRenderable :: Renderable (),+ plotAreaGrid :: Grid (Renderable ()),+ legendRenderable :: Renderable (),+ margin :: Double+ }++withAnyOrdinate :: (Ord x,Ord y) => Layout1 x y -> AnyLayout1 x+withAnyOrdinate l = AnyLayout1 {+ background = layout1_background_ l,+ titleRenderable = mapPickFn (const ()) $ layout1TitleToRenderable l,+ plotAreaGrid = fmap (mapPickFn (const ())) $ layout1PlotAreaToGrid l,+ legendRenderable = mapPickFn (const ()) $ layout1LegendsToRenderable l,+ margin = layout1_margin_ l+ }+++-- | Render several layouts with the same abscissa type stacked so that their+-- origins and axis titles are aligned horizontally with respect to each other.+-- The exterior margins and background are taken from the first element.+renderLayout1sStacked :: (Ord x) => [AnyLayout1 x] -> Renderable ()+renderLayout1sStacked [] = emptyRenderable+renderLayout1sStacked ls@(l1:_) = gridToRenderable g+ where+ g = fullOverlayUnder (fillBackground (background l1) emptyRenderable)+ $ addMarginsToGrid (lm,lm,lm,lm)+ $ aboveN [+ fullRowAbove (titleRenderable l) 0 (+ fullRowBelow (legendRenderable l) 0+ (plotAreaGrid l))+ | l <- ls]++ lm = margin l1++addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a) -> Grid (Renderable a)+addMarginsToGrid (t,b,l,r) g = aboveN [+ besideN [er, ts, er],+ besideN [ls, g, rs],+ besideN [er, bs, er]+ ]+ where+ er = empty+ ts = tval $ spacer (0,t)+ ls = tval $ spacer (l,0)+ bs = tval $ spacer (0,b)+ rs = tval $ spacer (r,0)+ layout1ToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable (Layout1Pick x y) layout1ToRenderable l =- fillBackground (layout1_background_ l) (- gridToRenderable $ aboveN [- tval $ addMargins (lm/2,0,0,0) title,- weights (1,1) $ tval $ addMargins (lm,lm,lm,lm) plotArea,- tval $ legends- ] )+ fillBackground (layout1_background_ l) $ gridToRenderable (layout1ToGrid l)++layout1ToGrid :: (Ord x, Ord y) => Layout1 x y -> Grid (Renderable (Layout1Pick x y))+layout1ToGrid l = aboveN [+ tval $ layout1TitleToRenderable l,+ weights (1,1) $ tval $ gridToRenderable $+ addMarginsToGrid (lm,lm,lm,lm) (layout1PlotAreaToGrid l),+ tval $ layout1LegendsToRenderable l+ ] where+ lm = layout1_margin_ l++layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable a+layout1TitleToRenderable l = addMargins (lm/2,0,0,0) title+ where title = label (layout1_title_style_ l) HTA_Centre VTA_Centre (layout1_title_ l)+ lm = layout1_margin_ l - plotArea = gridToRenderable (layer2 `overlay` layer1)+layout1LegendsToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable (Layout1Pick x y)+layout1LegendsToRenderable l = gridToRenderable g+ where+ g = besideN [ tval $ mkLegend lefts,+ weights (1,1) $ tval $ emptyRenderable,+ tval $ mkLegend rights ]+ lefts = concat [ plot_legend_ p | (Left p ) <- (layout1_plots_ l) ]+ rights = concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ] + lm = layout1_margin_ l++ mkLegend vals = case (layout1_legend_ l) of+ Nothing -> emptyRenderable+ (Just ls) -> case filter ((/="").fst) vals of {+ [] -> emptyRenderable ;+ lvs -> addMargins (0,lm,lm,lm)+ (mapPickFn L1P_Legend $ legendToRenderable (Legend True ls lvs))+ }++layout1PlotAreaToGrid :: (Ord x, Ord y) => Layout1 x y -> Grid (Renderable (Layout1Pick x y))+layout1PlotAreaToGrid l = layer2 `overlay` layer1+ where layer1 = aboveN [ besideN [er, er, er ], besideN [er, er, er ],@@ -169,10 +251,10 @@ besideN [er, er, btitle, er, er ] ] - ttitle = atitle HTA_Centre VTA_Bottom 0 layout1_top_axis_- btitle = atitle HTA_Centre VTA_Top 0 layout1_bottom_axis_- ltitle = atitle HTA_Right VTA_Centre 90 layout1_left_axis_- rtitle = atitle HTA_Left VTA_Centre 90 layout1_right_axis_+ ttitle = atitle HTA_Centre VTA_Bottom 0 layout1_top_axis_+ btitle = atitle HTA_Centre VTA_Top 0 layout1_bottom_axis_+ ltitle = atitle HTA_Right VTA_Centre 270 layout1_left_axis_+ rtitle = atitle HTA_Left VTA_Centre 270 layout1_right_axis_ er = tval $ emptyRenderable @@ -197,25 +279,10 @@ tr = tval $ axesSpacer snd ta fst ra br = tval $ axesSpacer snd ba snd ra - legends = gridToRenderable (besideN [ tval $ mkLegend lefts,- weights (1,1) $ tval $ emptyRenderable,- tval $ mkLegend rights ])- lefts = concat [ plot_legend_ p | (Left p) <- (layout1_plots_ l) ] - rights = concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ] -- mkLegend vals = case (layout1_legend_ l) of- Nothing -> emptyRenderable- (Just ls) -> case filter ((/="").fst) vals of- [] -> emptyRenderable- lvs -> addMargins (0,lm,lm,lm)- (mapPickFn L1P_Legend $ legendToRenderable (Legend True ls lvs))-- lm = layout1_margin_ l- plotsToRenderable :: Layout1 x y -> Renderable (Layout1Pick x y) plotsToRenderable l = Renderable { minsize=return (0,0),- render= renderPlots l+ render =renderPlots l } renderPlots :: Layout1 x y -> RectSize -> CRender (PickFn (Layout1Pick x y))@@ -231,18 +298,18 @@ where (bAxis,lAxis,tAxis,rAxis) = getAxes l - rPlot (Left p) = rPlot1 bAxis lAxis p+ rPlot (Left p) = rPlot1 bAxis lAxis p rPlot (Right p) = rPlot1 bAxis rAxis p - rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p = - let xrange = if xrev then (w, 0) else (0,w)- yrange = if yrev then (0, h) else (h, 0)- pmfn (x,y) = Point (mapv xrange (axis_viewport_ xaxis xrange) x)- (mapv yrange (axis_viewport_ yaxis yrange) y)- mapv (min,max) _ LMin = min- mapv (min,max) _ LMax = max- mapv _ f (LValue v) = f v- in plot_render_ p pmfn+ rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p =+ let xrange = if xrev then (w, 0) else (0, w)+ yrange = if yrev then (0, h) else (h, 0)+ pmfn (x,y) = Point (mapv xrange (axis_viewport_ xaxis xrange) x)+ (mapv yrange (axis_viewport_ yaxis yrange) y)+ mapv (min,max) _ LMin = min+ mapv (min,max) _ LMax = max+ mapv _ f (LValue v) = f v+ in plot_render_ p pmfn rPlot1 _ _ _ = return () renderGrids = do@@ -258,7 +325,7 @@ getAxes :: Layout1 x y -> (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x), Maybe (AxisT y)) getAxes l = (bAxis,lAxis,tAxis,rAxis)- where + where (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (layout1_plots_ l) xvals = xvals0 ++ xvals1 (yvals0',yvals1') = layout1_yaxes_control_ l (yvals0,yvals1)@@ -270,7 +337,7 @@ mkAxis t laxis vals = case laxis_visible_ laxis vals of False -> Nothing- True -> Just (AxisT t style rev adata) + True -> Just (AxisT t style rev adata) where style = laxis_style_ laxis rev = laxis_reverse_ laxis@@ -293,7 +360,7 @@ layout1_title_style_ = defaultFontStyle{font_size_=15, font_weight_=C.FontWeightBold}, layout1_top_axis_ = defaultLayoutAxis {- laxis_visible_ = const False + laxis_visible_ = const False }, layout1_bottom_axis_ = defaultLayoutAxis, layout1_left_axis_ = defaultLayoutAxis,@@ -312,7 +379,7 @@ laxis_title_style_ = defaultFontStyle{font_size_=10}, laxis_title_ = "", laxis_style_ = defaultAxisStyle,- laxis_visible_ = not.null, + laxis_visible_ = not.null, laxis_generate_ = autoAxis, laxis_override_ = id, laxis_reverse_ = False
Graphics/Rendering/Chart/Pie.hs view
@@ -134,7 +134,7 @@ (extraw,extrah) <- extraSpace p return (extraw * 2, extrah * 2) -renderPie p (w,h) = do +renderPie p (w,h) = do (extraw,extrah) <- extraSpace p let (w,h) = (p_x p2 - p_x p1, p_y p2 - p_y p1) let center = Point (p_x p1 + w/2) (p_y p1 + h/2)
Graphics/Rendering/Chart/Plot.hs view
@@ -18,8 +18,10 @@ -- * 'PlotFillBetween' -- -- * 'PlotErrBars'--- +-- -- * 'PlotBars'+-- +-- * 'PlotHidden' -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the trailing underscore@@ -44,6 +46,9 @@ PlotBars(..), PlotBarsStyle(..), PlotBarsSpacing(..),+ PlotBarsAlignment(..),+ BarsPlotValue(..),+ PlotHidden(..), symErrPoint, @@ -85,13 +90,15 @@ plot_bars_item_styles, plot_bars_titles, plot_bars_spacing,+ plot_bars_alignment, plot_bars_reference,- plot_bars_values,+ plot_bars_values ) where import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Axis import Control.Monad import Data.List@@ -141,8 +148,8 @@ instance ToPlot PlotLines where toPlot p = Plot { plot_render_ = renderPlotLines p,- plot_legend_ = [(plot_lines_title_ p, renderPlotLegendLines p)],- plot_all_points_ = (map fst pts ++ xs , map snd pts ++ ys)+ plot_legend_ = [(plot_lines_title_ p, renderPlotLegendLines p)],+ plot_all_points_ = (map fst pts ++ xs , map snd pts ++ ys) } where pts = concat (plot_lines_values_ p)@@ -210,8 +217,8 @@ instance ToPlot PlotPoints where toPlot p = Plot { plot_render_ = renderPlotPoints p,- plot_legend_ = [(plot_points_title_ p, renderPlotLegendPoints p)],- plot_all_points_ = (map fst pts, map snd pts)+ plot_legend_ = [(plot_points_title_ p, renderPlotLegendPoints p)],+ plot_all_points_ = (map fst pts, map snd pts) } where pts = plot_points_values_ p@@ -252,14 +259,14 @@ instance ToPlot PlotFillBetween where toPlot p = Plot { plot_render_ = renderPlotFillBetween p,- plot_legend_ = [(plot_fillbetween_title_ p, renderPlotLegendFill p)],- plot_all_points_ = plotAllPointsFillBetween p+ plot_legend_ = [(plot_fillbetween_title_ p, renderPlotLegendFill p)],+ plot_all_points_ = plotAllPointsFillBetween p } renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> CRender () renderPlotFillBetween p pmap = renderPlotFillBetween' p (plot_fillbetween_values_ p) pmap -renderPlotFillBetween' p [] _ = return ()+renderPlotFillBetween' p [] _ = return () renderPlotFillBetween' p vs pmap = preserveCState $ do setFillStyle (plot_fillbetween_style_ p) moveTo p0@@ -324,9 +331,9 @@ instance ToPlot PlotErrBars where toPlot p = Plot { plot_render_ = renderPlotErrBars p,- plot_legend_ = [(plot_errbars_title_ p,renderPlotLegendErrBars p)],- plot_all_points_ = ( concat [[ev_low x,ev_high x] |ErrPoint x _ <-pts ],- concat [[ev_low y,ev_high y] |ErrPoint _ y <-pts ] )+ plot_legend_ = [(plot_errbars_title_ p,renderPlotLegendErrBars p)],+ plot_all_points_ = ( concat [[ev_low x,ev_high x] |ErrPoint x _ <- pts ],+ concat [[ev_low y,ev_high y] |ErrPoint _ y <- pts ] ) } where pts = plot_errbars_values_ p@@ -389,11 +396,28 @@ instance BarsPlotValue Double where barsReference = 0 barsAdd = (+)+instance BarsPlotValue Int where+ barsReference = 0+ barsAdd = (+) -data PlotBarsStyle = BarsStacked | BarsClustered-data PlotBarsSpacing = BarsFixWidth Double- | BarsFixGap Double+data PlotBarsStyle = BarsStacked -- ^ Bars for a fixed x are stacked vertically+ -- on top of each other+ | BarsClustered -- ^ Bars for a fixed x are put horizontally+ -- beside each other+ deriving (Show) +data PlotBarsSpacing = BarsFixWidth Double -- ^ All bars have the same width in pixels+ | BarsFixGap Double -- ^ There is the same interval in pixels+ -- between adjacent bars+ deriving (Show)++-- | How bars for a given (x,[y]) are aligned with respect to screen+-- coordinate corresponding to x (deviceX)+data PlotBarsAlignment = BarsLeft -- ^ The left edge of bars is at deviceX+ | BarsCentered -- ^ The right edge of bars is at deviceX+ | BarsRight -- ^ Bars are centered around deviceX+ deriving (Show)+ -- | Value describing how to plot a set of bars. -- Note that the input data is typed [(x,[y])], ie for each x value -- we plot several y values. Typically the size of each [y] list would@@ -417,9 +441,15 @@ -- them can be fixed. plot_bars_spacing_ :: PlotBarsSpacing, + -- | This value controls how bars for a fixed x are aligned with+ -- respect to the device coordinate corresponding to x+ plot_bars_alignment_ :: PlotBarsAlignment,+ -- | The starting level for the chart (normally 0). plot_bars_reference_ :: y, + plot_bars_singleton_width_ :: Double,+ -- | The actual points to be plotted plot_bars_values_ :: [ (x,[y]) ] }@@ -430,7 +460,9 @@ plot_bars_item_styles_ = cycle istyles, plot_bars_titles_ = [], plot_bars_spacing_ = BarsFixGap 10,+ plot_bars_alignment_ = BarsCentered, plot_bars_values_ = [],+ plot_bars_singleton_width_ = 20, plot_bars_reference_ = barsReference } where@@ -440,14 +472,14 @@ plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y plotBars p = Plot { plot_render_ = renderPlotBars p,- plot_legend_ = zip (plot_bars_titles_ p) (map renderPlotLegendBars (plot_bars_item_styles_ p)),- plot_all_points_ = allBarPoints p+ plot_legend_ = zip (plot_bars_titles_ p) (map renderPlotLegendBars (plot_bars_item_styles_ p)),+ plot_all_points_ = allBarPoints p } -renderPlotBars :: BarsPlotValue y => PlotBars x y -> PointMapFn x y -> CRender ()+renderPlotBars :: (BarsPlotValue y) => PlotBars x y -> PointMapFn x y -> CRender () renderPlotBars p pmap = case (plot_bars_style_ p) of- BarsClustered -> do forM_ vals clusteredBars- BarsStacked -> forM_ vals stackedBars+ BarsClustered -> forM_ vals clusteredBars+ BarsStacked -> forM_ vals stackedBars where clusteredBars (x,ys) = preserveCState $ do forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> do@@ -460,18 +492,26 @@ barPath (offset i) x yref0 y c $ C.stroke - offset i = fromIntegral (2*i-nys) * width/2+ offset = case (plot_bars_alignment_ p) of+ BarsLeft -> \i -> fromIntegral i * width+ BarsRight -> \i -> fromIntegral (i-nys) * width+ BarsCentered -> \i -> fromIntegral (2*i-nys) * width/2 stackedBars (x,ys) = preserveCState $ do let y2s = zip (yref0:stack ys) (stack ys)+ let ofs = case (plot_bars_alignment_ p) of {+ BarsLeft -> 0 ;+ BarsRight -> (-width) ;+ BarsCentered -> (-width/2)+ } forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do setFillStyle fstyle- barPath (-width/2) x y0 y1+ barPath ofs x y0 y1 c $ C.fill forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do whenJust mlstyle $ \lstyle -> do setLineStyle lstyle- barPath (-width/2) x y0 y1+ barPath ofs x y0 y1 c $ C.stroke barPath xos x y0 y1 = do@@ -480,7 +520,7 @@ rectPath (Rect (Point (x'+xos) y0') (Point (x'+xos+width) y')) yref0 = plot_bars_reference_ p- vals = plot_bars_values_ p+ vals = plot_bars_values_ p width = case plot_bars_spacing_ p of BarsFixGap gap -> case (plot_bars_style_ p) of BarsClustered -> (minXInterval - gap) / fromIntegral nys@@ -488,13 +528,18 @@ BarsFixWidth width -> width styles = plot_bars_item_styles_ p - minXInterval = minimum $ zipWith (-) (tail xs) xs- where - xs = nub $ sort $ map (\x-> p_x (pmap' (x,barsReference))) (fst (allBarPoints p))+ minXInterval = let diffs = zipWith (-) (tail mxs) mxs+ in if null diffs+ then plot_bars_singleton_width_ p+ else minimum diffs+ where+ xs = fst (allBarPoints p)+ mxs = nub $ sort $ map mapX xs nys = maximum [ length ys | (x,ys) <- vals ]- + pmap' = mapXY pmap+ mapX x = p_x (pmap' (x,barsReference)) whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m () whenJust (Just a) f = f a@@ -510,8 +555,8 @@ stack :: (BarsPlotValue y) => [y] -> [y] stack ys = scanl1 barsAdd ys- + renderPlotLegendBars :: (CairoFillStyle,Maybe CairoLineStyle) -> Rect -> CRender () renderPlotLegendBars (fstyle,mlstyle) r@(Rect p1 p2) = do setFillStyle fstyle@@ -519,6 +564,23 @@ c $ C.fill ----------------------------------------------------------------------++-- | Value defining some hidden x and y values. The values don't+-- get displayed, but still affect axis scaling.++data PlotHidden x y = PlotHidden {+ plot_hidden_x_values_ :: [x],+ plot_hidden_y_values_ :: [y]+}++instance ToPlot PlotHidden where+ toPlot ph = Plot {+ plot_render_ = \_ -> return (),+ plot_legend_ = [],+ plot_all_points_ = (plot_hidden_x_values_ ph, plot_hidden_y_values_ ph)+ }++---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor for each field $( deriveAccessors ''Plot ) $( deriveAccessors ''PlotLines )@@ -526,3 +588,4 @@ $( deriveAccessors ''PlotFillBetween ) $( deriveAccessors ''PlotErrBars ) $( deriveAccessors ''PlotBars )+$( deriveAccessors ''PlotHidden )
tests/test.hs view
@@ -65,7 +65,7 @@ test1a :: OutputType -> Renderable () test1a otype = fillBackground fwhite $ (gridToRenderable t) where- t = weights (1,1) $ aboveN [ besideN [rf g1, rf g2, rf g3], + t = weights (1,1) $ aboveN [ besideN [rf g1, rf g2, rf g3], besideN [rf g4, rf g5, rf g6] ] g1 = layout1_title ^= "minimal"@@ -91,7 +91,7 @@ $ test1Layout otype where axis = autoScaledAxis (- la_nLabels ^= 5 + la_nLabels ^= 5 $ la_nTicks ^= 20 $ defaultLinearAxis )@@ -167,7 +167,7 @@ price1 = plot_fillbetween_style ^= solidFillStyle green1 $ plot_fillbetween_values ^= [ (date d m y,(0,v2)) | (d,m,y,v1,v2) <- prices] $ plot_fillbetween_title ^= "price 1"- $ defaultPlotFillBetween + $ defaultPlotFillBetween price2 = plot_fillbetween_style ^= solidFillStyle red1 $ plot_fillbetween_values ^= [ (date d m y,(0,v1)) | (d,m,y,v1,v2) <- prices]@@ -180,7 +180,7 @@ Left (toPlot price2)] $ defaultLayout1 ----------------------------------------------------------------------- +---------------------------------------------------------------------- test4 :: Bool -> Bool -> OutputType -> Renderable () test4 xrev yrev otype = toRenderable layout where@@ -220,14 +220,14 @@ plot tt s n m t = plot_lines_style ^= s $ plot_lines_values ^= [[(fromIntegral x, LogValue y) | (x,y) <-- filter (\(x,_)->x `mod` (m+1)==0) $ take n $ zip [0..] t]]+ filter (\(x,_)-> x `mod` (m+1)==0) $ take n $ zip [0..] t]] $ plot_lines_title ^= tt- $ defaultPlotLines + $ defaultPlotLines b = 0.1 trial bits frac = scanl (*) 1 (map f bits)- where + where f True = (1+frac*(1+b)) f False = (1-frac) @@ -237,7 +237,7 @@ lineWidth = chooseLineWidth otype ----------------------------------------------------------------------- +---------------------------------------------------------------------- -- Test the Simple interface test6 :: OutputType -> Renderable ()@@ -280,15 +280,15 @@ e = 0 e1 = 25 layout = pie_title ^= "Pie Chart Example"- $ pie_plot ^: pie_data ^= [ defaultPieItem{pitem_value_=v,pitem_label_=s,pitem_offset_=o} + $ pie_plot ^: pie_data ^= [ defaultPieItem{pitem_value_=v,pitem_label_=s,pitem_offset_=o} | (s,v,o) <- values ] $ defaultPieLayout ---------------------------------------------------------------------- -test9 :: OutputType -> Renderable ()-test9 otype = fillBackground fwhite $ (gridToRenderable t)+test9 :: PlotBarsAlignment -> OutputType -> Renderable ()+test9 alignment otype = fillBackground fwhite $ (gridToRenderable t) where t = weights (1,1) $ aboveN [ besideN [rf g0, rf g1, rf g2], besideN [rf g3, rf g4, rf g5] ]@@ -298,12 +298,12 @@ $ plot_bars_spacing ^= BarsFixWidth 25 $ bars1 - g1 = layout "clustered / fix width "+ g1 = layout "clustered/fix width " $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixWidth 25 $ bars2 - g2 = layout "clustered / fix gap "+ g2 = layout "clustered/fix gap " $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixGap 10 $ bars2@@ -313,12 +313,12 @@ $ plot_bars_spacing ^= BarsFixWidth 25 $ bars1 - g4 = layout "stacked / fix width"+ g4 = layout "stacked/fix width" $ plot_bars_style ^= BarsStacked $ plot_bars_spacing ^= BarsFixWidth 25 $ bars2 - g5 = layout "stacked / fix gap"+ g5 = layout "stacked/fix gap" $ plot_bars_style ^= BarsStacked $ plot_bars_spacing ^= BarsFixGap 10 $ bars2@@ -328,7 +328,9 @@ alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ] - layout title bars = layout1_title ^= title+ layout title bars =+ layout1_title ^= (show alignment ++ "/" ++ title)+ $ layout1_title_style ^: font_size ^= 10 $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_plots ^= [ Left (plotBars bars) ]@@ -336,10 +338,12 @@ bars1 = plot_bars_titles ^= ["Cash"] $ plot_bars_values ^= addIndexes [[20],[45],[30],[70]]+ $ plot_bars_alignment ^= alignment $ defaultPlotBars bars2 = plot_bars_titles ^= ["Cash","Equity"] $ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]]+ $ plot_bars_alignment ^= alignment $ defaultPlotBars -------------------------------------------------------------------------------@@ -382,6 +386,36 @@ $ setLayout1Foreground fg $ defaultLayout1 +-------------------------------------------------------------------------------+-- A quick test of stacked layouts++test11 :: OutputType -> Renderable ()+test11 otype = renderLayout1sStacked [withAnyOrdinate layout1, withAnyOrdinate layout2]+ where+ vs1 :: [(Int,Int)]+ vs1 = [ (2,2), (3,40), (8,400), (12,60) ]++ vs2 :: [(Int,Double)]+ vs2 = [ (0,0.7), (3,0.35), (4,0.25), (7, 0.6), (10,0.4) ]++ allx = map fst vs1 ++ map fst vs2+ extendRange = PlotHidden allx []++ plot1 = plot_points_style ^= filledCircles 5 (opaque red)+ $ plot_points_values ^= vs1+ $ defaultPlotPoints++ layout1 = layout1_title ^= "Integer Axis"+ $ layout1_plots ^= [Left (toPlot plot1), Left (toPlot extendRange)]+ $ defaultLayout1++ plot2 = plot_lines_values ^= [vs2]+ $ defaultPlotLines++ layout2 = layout1_title ^= "Float Axis"+ $ layout1_plots ^= [Left (toPlot plot2), Left (toPlot extendRange)]+ $ defaultLayout1+ ---------------------------------------------------------------------- -- a quick test to display labels with all combinations -- of anchors@@ -405,7 +439,7 @@ render r sz } ----------------------------------------------------------------------- +---------------------------------------------------------------------- allTests :: [ (String, OutputType -> Renderable ()) ] allTests = [ ("test1", test1)@@ -423,8 +457,11 @@ , ("test6", test6) , ("test7", test7) , ("test8", test8)- , ("test9", test9)+ , ("test9c", test9 BarsCentered)+ , ("test9l", test9 BarsLeft)+ , ("test9r", test9 BarsRight) , ("test10", test10 (filterPrices (date 1 1 2005) (date 31 12 2005)))+ , ("test11", test11) , ("misc1", misc1 0) , ("misc1a", misc1 45) ]