haskell-chart
haskell-chart copied to clipboard
Rendering chart with a single data point seems to use huge amounts of memory.
We've noticed that if we create a chart from data which has a single data point (we think, we're confirming this and will know tomorrow), memory usage skyrockets, sometimes to the point where our app runs out of memory and crashes.
On a related note, we used to see similar behaviour when we attempted to chart data with no data points. I know this is quite vague so let me know if you need more information. I'll also try and find some time to narrow down the issue.
I'm unsure on this - if you can provide an example chart that illustrates the problem, I will take a look.
Yep will do, we're trying to track down the exact problem today after collecting the data the charts are produced from.
Sorry for taking so long, below are (hopefully) all the files you need to reproduce the bug. The only other thing that needs to be done before the app will run is to copy all the fonts from SGVFonts into ./fonts
so the app can read them.
To test, run stack init && stack build && stack exec charts-bug-exe
.
Main.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Diagrams.Backend.Rasterific as R
import Graphics.Rendering.Chart.Backend.Diagrams as C
import Graphics.Rendering.Chart.Easy as CE
import Diagrams.Core.Compile (renderDia)
import Diagrams.TwoD.Size (mkSizeSpec2D)
import Codec.Picture.Types
import Codec.Picture.Png (encodePng)
import Data.Time.Calendar as Cal
import Data.Time.LocalTime as Local
import qualified Graphics.SVGFonts.ReadFont as F
import qualified Data.Text as T
main :: IO ()
main = do
fontSelector <- loadFonts
let env = createEnv bitmapAlignmentFns 500 300 fontSelector
let day = fromGregorian 2015 11 26
time = TimeOfDay 5 1 0
time2 = TimeOfDay 5 2 0
now = LocalTime day time
now2 = LocalTime day time2
-- Works fine
imga <- renderImage env 500 300 $ wsChart ("foo",[(1.0 :: Double,0.0::Double)])
putStrLn (imga `seq` "No dates done")
let !_ = encodePng imga
-- Also works fine, there are two values to plot with different x values
imgb <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double), (now2,0.0)])
putStrLn (imgb `seq` "Dates and multiple values done")
let !_ = encodePng imgb
-- Never terminates and eventually runs out of memory
imgc <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double)])
putStrLn (imgc `seq` "Dates and single value done")
let !_ = encodePng imgc
-- Also never terminates if the above is uncommented
-- and eventually runs out of memory. Note that the two
-- x values are the same time.
imgd <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double), (now,0.0)])
putStrLn (imgd `seq` "Dates and single value done")
let !_ = encodePng imgd
return ()
wsChart
:: (PlotValue x, PlotValue y)
=> (T.Text,[(x,y)])
-> Renderable ()
wsChart (name,vs) = toRenderable $ do
plot . liftEC $ do
plot_lines_title .= (T.unpack name)
plot_lines_values .= [ vs ]
renderImage :: DEnv Double -> Double -> Double -> Renderable () -> IO (Image PixelRGBA8)
renderImage env w h r = do
let (!dia,_) = runBackendR env r
!img = renderDia Rasterific (RasterificOptions (mkSizeSpec2D (Just w) (Just h))) dia
return img
-- The code below is working fine
isFontFamily :: String -> DFont n -> Bool
isFontFamily n (fd, _) = n == F.fontDataFamily fd
alterFontFamily :: String -> DFont n -> DFont n
alterFontFamily n (fd, om) = (fd { F.fontDataFamily = n }, om)
loadFonts :: IO (FontSelector Double)
loadFonts = do
let fontPath = "fonts"
[
sansR
, sansRB
, sansRBI
, sansRI
] <- mapM (F.loadFont . (fontPath ++))
[ "/SourceSansPro_R.svg"
, "/SourceSansPro_RB.svg"
, "/SourceSansPro_RBI.svg"
, "/SourceSansPro_RI.svg"
]
putStrLn "loaded fonts"
let selectFont :: FontStyle -> F.PreparedFont Double
selectFont fs = alterFontFamily "sans-serif" $ case (_font_name fs, _font_slant fs, _font_weight fs) of
(_, FontSlantNormal , FontWeightNormal) -> sansR
(_, FontSlantNormal , FontWeightBold ) -> sansRB
(_, FontSlantItalic , FontWeightNormal) -> sansRI
(_, FontSlantOblique, FontWeightNormal) -> sansRI
(_, FontSlantItalic , FontWeightBold ) -> sansRBI
(_, FontSlantOblique, FontWeightBold ) -> sansRBI
return selectFont
charts-bug.cabal
name: charts-bug
version: 0.1.0.0
synopsis: Initial project template from stack
license: BSD3
author: Alex Mason
copyright: 2010 Author Here
category: Web
build-type: Simple
cabal-version: >=1.10
executable charts-bug-exe
main-is: Main.hs
-- ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, time
, JuicyPixels
, diagrams-rasterific
, Chart-diagrams
, Chart
, diagrams-core
, diagrams-lib
, SVGFonts
, text
default-language: Haskell2010
stack.yaml
resolver: lts-3.14
packages:
- '.'
extra-deps: []
flags: {}
extra-package-dbs: []
Might also need:
Setup.hs
import Distribution.Simple
main = defaultMain
I haven't delved into the Charts code, but I would guess the problem comes from trying to calculate the x-axis labels.
I was trying to clean up a few old issues and came back to this. From my tests, it seems specific to the rasterific diagrams backend (which I have not used before). The code below generates output for, cairo, diagrams-svg, before eating all of memory when using rasterific:
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Diagrams.Backend.Rasterific as R
import Graphics.Rendering.Chart.Backend.Diagrams as C
import Graphics.Rendering.Chart.Backend.Cairo as CX
import Graphics.Rendering.Chart.Easy as CE
import Diagrams.Core.Compile (renderDia)
import Diagrams.TwoD.Size (mkSizeSpec2D)
import Codec.Picture.Types
import Codec.Picture.Png (encodePng)
import Data.Time.Calendar as Cal
import Data.Time.LocalTime as Local
import qualified Graphics.SVGFonts.ReadFont as F
import qualified Data.Text as T
main :: IO ()
main = do
fontSelector <- loadFonts
let env = createEnv bitmapAlignmentFns 500 300 fontSelector
let day = fromGregorian 2015 11 26
time = TimeOfDay 5 1 0
time2 = TimeOfDay 5 2 0
now = LocalTime day time
now2 = LocalTime day time2
-- Works fine
imga <- renderImage env 500 300 $ wsChart ("foo",[(1.0 :: Double,0.0::Double)])
putStrLn (imga `seq` "No dates done")
let !_ = encodePng imga
-- Also works fine, there are two values to plot with different x values
imgb <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double), (now2,0.0)])
putStrLn (imgb `seq` "Dates and multiple values done")
let !_ = encodePng imgb
-- Works fine, writing png output via cairo
CX.renderableToFile def "chart-cairo.png" $ wsChart ("foo",[(now,0.0::Double)])
putStrLn "Dates and single value done via cairo to png"
-- Works fine, writing svg output via diagrams
C.renderableToFile def "chart-diagrams.svg" $ wsChart ("foo",[(now,0.0::Double)])
putStrLn "Dates and single value done via diagrams to svg"
-- Never terminates and eventually runs out of memory
imgc <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double)])
putStrLn (imgc `seq` "Dates and single value done")
let !_ = encodePng imgc
-- Also never terminates if the above is uncommented
-- and eventually runs out of memory. Note that the two
-- x values are the same time.
imgd <- renderImage env 500 300 $ wsChart ("foo",[(now,0.0::Double), (now,0.0)])
putStrLn (imgd `seq` "Dates and single value done")
let !_ = encodePng imgd
return ()
wsChart
:: (PlotValue x, PlotValue y)
=> (T.Text,[(x,y)])
-> Renderable ()
wsChart (name,vs) = toRenderable $ do
plot . liftEC $ do
plot_lines_title .= (T.unpack name)
plot_lines_values .= [ vs ]
renderImage :: DEnv Double -> Double -> Double -> Renderable () -> IO (Image PixelRGBA8)
renderImage env w h r = do
let (!dia,_) = runBackendR env r
!img = renderDia Rasterific (RasterificOptions (mkSizeSpec2D (Just w) (Just h))) dia
return img
-- The code below is working fine
isFontFamily :: String -> F.PreparedFont n -> Bool
isFontFamily n (fd, _) = n == F.fontDataFamily fd
alterFontFamily :: String -> F.PreparedFont n -> F.PreparedFont n
alterFontFamily n (fd, om) = (fd { F.fontDataFamily = n }, om)
loadFonts :: IO (FontSelector Double)
loadFonts = do
let fontPath = "chart-diagrams/fonts"
[
sansR
, sansRB
, sansRBI
, sansRI
] <- mapM (F.loadFont . (fontPath ++))
[ "/SourceSansPro_R.svg"
, "/SourceSansPro_RB.svg"
, "/SourceSansPro_RBI.svg"
, "/SourceSansPro_RI.svg"
]
putStrLn "loaded fonts"
let selectFont :: FontStyle -> F.PreparedFont Double
selectFont fs = alterFontFamily "sans-serif" $ case (_font_name fs, _font_slant fs, _font_weight fs) of
(_, FontSlantNormal , FontWeightNormal) -> sansR
(_, FontSlantNormal , FontWeightBold ) -> sansRB
(_, FontSlantItalic , FontWeightNormal) -> sansRI
(_, FontSlantOblique, FontWeightNormal) -> sansRI
(_, FontSlantItalic , FontWeightBold ) -> sansRBI
(_, FontSlantOblique, FontWeightBold ) -> sansRBI
return selectFont