haskell-chart icon indicating copy to clipboard operation
haskell-chart copied to clipboard

Rendering chart with a single data point seems to use huge amounts of memory.

Open axman6 opened this issue 8 years ago • 6 comments

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.

axman6 avatar Nov 25 '15 04:11 axman6

I'm unsure on this - if you can provide an example chart that illustrates the problem, I will take a look.

timbod7 avatar Nov 25 '15 20:11 timbod7

Yep will do, we're trying to track down the exact problem today after collecting the data the charts are produced from.

axman6 avatar Nov 25 '15 23:11 axman6

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: []

axman6 avatar Nov 26 '15 05:11 axman6

Might also need:

Setup.hs

import Distribution.Simple
main = defaultMain

axman6 avatar Nov 26 '15 05:11 axman6

I haven't delved into the Charts code, but I would guess the problem comes from trying to calculate the x-axis labels.

axman6 avatar Nov 26 '15 05:11 axman6

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

timbod7 avatar Mar 02 '16 06:03 timbod7