Chart-0.11: tests/test.hs
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart
import Graphics.Rendering.Chart.Simple
import Graphics.Rendering.Chart.Gtk
import Graphics.Rendering.Chart.Grid
import System.Environment(getArgs)
import System.Time
import System.Random
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Accessor
import Data.Accessor.Tuple
import Data.Colour
import Data.Colour.Names
import Data.Colour.SRGB
import Data.List(sort,nub,scanl1)
import qualified Data.Map as Map
import Control.Monad
import Prices
data OutputType = Window | PNG | PS | PDF | SVG
chooseLineWidth Window = 1.0
chooseLineWidth PNG = 1.0
chooseLineWidth PDF = 0.25
chooseLineWidth PS = 0.25
chooseLineWidth SVG = 0.25
green1 = opaque $ sRGB 0.5 1 0.5
red1 = opaque $ sRGB 0.5 0.5 1
fwhite = solidFillStyle $ opaque white
fparchment = solidFillStyle $ opaque $ sRGB 1.0 0.99 0.90
----------------------------------------------------------------------
test1Layout otype = layout
where
am :: Double -> Double
am x = (sin (x*pi/45) + 1) / 2 * (sin (x*pi/5))
sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]]
$ plot_lines_style ^= solidLine lineWidth (opaque blue)
$ plot_lines_title ^="am"
$ defaultPlotLines
sinusoid2 = plot_points_style ^= filledCircles 2 (opaque red)
$ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]]
$ plot_points_title ^="am points"
$ defaultPlotPoints
layout = layout1_plots ^= [Left (toPlot sinusoid1),
Left (toPlot sinusoid2)]
$ layout1_background ^= fparchment
$ layout1_plot_background ^= Just fwhite
$ defaultLayout1
lineWidth = chooseLineWidth otype
test1 :: OutputType -> Renderable ()
test1 otype = toRenderable layout
where
layout = layout1_title ^= "Amplitude Modulation"
$ (test1Layout otype)
test1a :: OutputType -> Renderable ()
test1a otype = fillBackground fwhite $ (gridToRenderable t)
where
t = weights (1,1) $ aboveN [ besideN [rf g1, rf g2, rf g3],
besideN [rf g4, rf g5, rf g6] ]
g1 = layout1_title ^= "minimal"
$ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)
$ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)
$ test1Layout otype
g2 = layout1_title ^= "with borders"
$ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)
$ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)
$ layout1_top_axis ^: axisBorderOnly
$ layout1_right_axis ^: axisBorderOnly
$ test1Layout otype
g3 = layout1_title ^= "default"
$ test1Layout otype
g4 = layout1_title ^= "tight grid"
$ layout1_left_axis ^: laxis_generate ^= axis
$ layout1_left_axis ^: laxis_override ^= axisGridAtTicks
$ layout1_bottom_axis ^: laxis_generate ^= axis
$ layout1_bottom_axis ^: laxis_override ^= axisGridAtTicks
$ test1Layout otype
where
axis = autoScaledAxis (
la_nLabels ^= 5
$ la_nTicks ^= 20
$ defaultLinearAxis
)
g5 = layout1_title ^= "y linked"
$ layout1_yaxes_control ^= linkAxes
$ test1Layout otype
g6 = layout1_title ^= "everything"
$ layout1_yaxes_control ^= linkAxes
$ layout1_top_axis ^: laxis_visible ^= const True
$ test1Layout otype
rf = tval.toRenderable
axisBorderOnly = (laxis_visible ^= const True)
. (laxis_override ^= (axisGridHide.axisTicksHide.axisLabelsHide))
----------------------------------------------------------------------
test2 :: [(Int,Int,Int,Double,Double)] -> Bool -> OutputType -> Renderable ()
test2 prices showMinMax otype = toRenderable layout
where
lineStyle c = line_width ^= 3 * chooseLineWidth otype
$ line_color ^= c
$ defaultPlotLines ^. plot_lines_style
limitLineStyle c = line_width ^= chooseLineWidth otype
$ line_color ^= opaque c
$ line_dashes ^= [5,10]
$ defaultPlotLines ^. plot_lines_style
price1 = plot_lines_style ^= lineStyle (opaque blue)
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,v,_) <- prices]]
$ plot_lines_title ^= "price 1"
$ defaultPlotLines
price2 = plot_lines_style ^= lineStyle (opaque green)
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]]
$ plot_lines_title ^= "price 2"
$ defaultPlotLines
(min1,max1) = (minimum [v | (_,_,_,v,_) <- prices],maximum [v | (_,_,_,v,_) <- prices])
(min2,max2) = (minimum [v | (_,_,_,_,v) <- prices],maximum [v | (_,_,_,_,v) <- prices])
limits | showMinMax = [ Left $ hlinePlot "min/max" (limitLineStyle blue) min1,
Left $ hlinePlot "" (limitLineStyle blue) max1,
Right $ hlinePlot "min/max" (limitLineStyle green) min2,
Right $ hlinePlot "" (limitLineStyle green) max2 ]
| otherwise = []
bg = opaque $ sRGB 0 0 0.25
fg = opaque white
fg1 = opaque $ sRGB 0.0 0.0 0.15
layout = layout1_title ^="Price History"
$ layout1_background ^= solidFillStyle bg
$ updateAllAxesStyles (axis_grid_style ^= solidLine 1 fg1)
$ layout1_left_axis ^: laxis_override ^= axisGridHide
$ layout1_right_axis ^: laxis_override ^= axisGridHide
$ layout1_bottom_axis ^: laxis_override ^= axisGridHide
$ layout1_plots ^= ([Left (toPlot price1), Right (toPlot price2)] ++ limits)
$ layout1_grid_last ^= False
$ setLayout1Foreground fg
$ defaultLayout1
date dd mm yyyy = (LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight)
----------------------------------------------------------------------
test3 :: OutputType -> Renderable ()
test3 otype = toRenderable layout
where
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
price2 = plot_fillbetween_style ^= solidFillStyle red1
$ plot_fillbetween_values ^= [ (date d m y,(0,v1)) | (d,m,y,v1,v2) <- prices]
$ plot_fillbetween_title ^= "price 2"
$ defaultPlotFillBetween
layout = layout1_title ^= "Price History"
$ layout1_grid_last ^= True
$ layout1_plots ^= [Left (toPlot price1),
Left (toPlot price2)]
$ defaultLayout1
----------------------------------------------------------------------
test4 :: Bool -> Bool -> OutputType -> Renderable ()
test4 xrev yrev otype = toRenderable layout
where
points = plot_points_style ^= filledCircles 3 (opaque red)
$ plot_points_values ^= [ (x, LogValue (10**x)) | x <- [0.5,1,1.5,2,2.5] ]
$ plot_points_title ^= "values"
$ defaultPlotPoints
lines = plot_lines_values ^= [ [(x, LogValue (10**x)) | x <- [0,3]] ]
$ plot_lines_title ^= "values"
$ defaultPlotLines
layout = layout1_title ^= "Log/Linear Example"
$ layout1_bottom_axis ^: laxis_title ^= "horizontal"
$ layout1_bottom_axis ^: laxis_reverse ^= xrev
$ layout1_left_axis ^: laxis_title ^= "vertical"
$ layout1_left_axis ^: laxis_reverse ^= yrev
$ layout1_plots ^= [Left (toPlot points), Left (toPlot lines) ]
$ defaultLayout1
----------------------------------------------------------------------
-- Example thanks to Russell O'Connor
test5 :: OutputType -> Renderable ()
test5 otype = toRenderable (layout 1001 (trial bits) :: Layout1 Double LogValue)
where
bits = randoms $ mkStdGen 0
layout n t = layout1_title ^= "Simulation of betting on a biased coin"
$ layout1_plots ^= [
Left (toPlot (plot "f=0.05" s1 n 0 (t 0.05))),
Left (toPlot (plot "f=0.1" s2 n 0 (t 0.1)))
]
$ defaultLayout1
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]]
$ plot_lines_title ^= tt
$ defaultPlotLines
b = 0.1
trial bits frac = scanl (*) 1 (map f bits)
where
f True = (1+frac*(1+b))
f False = (1-frac)
s1 = solidLine lineWidth $ opaque green
s2 = solidLine lineWidth $ opaque blue
lineWidth = chooseLineWidth otype
----------------------------------------------------------------------
-- Test the Simple interface
test6 :: OutputType -> Renderable ()
test6 otype = toRenderable (plotLayout pp){layout1_title_="Graphics.Rendering.Chart.Simple example"}
where
pp = plot xs sin "sin"
cos "cos" "o"
(sin.sin.cos) "sin.sin.cos" "."
(/3) "- "
(const 0.5)
[0.1,0.7,0.5::Double] "+"
xs = [0,0.3..3] :: [Double]
----------------------------------------------------------------------
test7 :: OutputType -> Renderable ()
test7 otype = toRenderable layout
where
vals :: [(Double,Double,Double,Double)]
vals = [ (x,sin (exp x),sin x/2,cos x/10) | x <- [1..20]]
bars = plot_errbars_values ^= [symErrPoint x y dx dy | (x,y,dx,dy) <- vals]
$ plot_errbars_title ^="test"
$ defaultPlotErrBars
points = plot_points_style ^= filledCircles 2 (opaque red)
$ plot_points_values ^= [(x,y) | (x,y,dx,dy) <- vals]
$ plot_points_title ^= "test"
$ defaultPlotPoints
layout = layout1_title ^= "errorbars example"
$ layout1_plots ^= [Left (toPlot bars),
Left (toPlot points)]
$ defaultLayout1
----------------------------------------------------------------------
test8 :: OutputType -> Renderable ()
test8 otype = toRenderable layout
where
values = [ ("eggs",38,e), ("milk",45,e), ("bread",11,e1), ("salmon",8,e) ]
e = 0
e1 = 25
layout = pie_title ^= "Pie Chart Example"
$ 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)
where
t = weights (1,1) $ aboveN [ besideN [rf g0, rf g1, rf g2],
besideN [rf g3, rf g4, rf g5] ]
g0 = layout "clustered 1"
$ plot_bars_style ^= BarsClustered
$ plot_bars_spacing ^= BarsFixWidth 25
$ bars1
g1 = layout "clustered / fix width "
$ plot_bars_style ^= BarsClustered
$ plot_bars_spacing ^= BarsFixWidth 25
$ bars2
g2 = layout "clustered / fix gap "
$ plot_bars_style ^= BarsClustered
$ plot_bars_spacing ^= BarsFixGap 10
$ bars2
g3 = layout "stacked 1"
$ plot_bars_style ^= BarsStacked
$ plot_bars_spacing ^= BarsFixWidth 25
$ bars1
g4 = layout "stacked / fix width"
$ plot_bars_style ^= BarsStacked
$ plot_bars_spacing ^= BarsFixWidth 25
$ bars2
g5 = layout "stacked / fix gap"
$ plot_bars_style ^= BarsStacked
$ plot_bars_spacing ^= BarsFixGap 10
$ bars2
rf = tval.toRenderable
alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ]
layout title bars = layout1_title ^= title
$ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels
$ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)
$ layout1_plots ^= [ Left (plotBars bars) ]
$ defaultLayout1 :: Layout1 PlotIndex Double
bars1 = plot_bars_titles ^= ["Cash"]
$ plot_bars_values ^= addIndexes [[20],[45],[30],[70]]
$ defaultPlotBars
bars2 = plot_bars_titles ^= ["Cash","Equity"]
$ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]]
$ defaultPlotBars
-------------------------------------------------------------------------------
test10 :: [(Int,Int,Int,Double,Double)] -> OutputType -> Renderable ()
test10 prices otype = toRenderable layout
where
lineStyle c = line_width ^= 3 * chooseLineWidth otype
$ line_color ^= c
$ defaultPlotLines ^. plot_lines_style
price1 = plot_lines_style ^= lineStyle (opaque blue)
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,v,_) <- prices]]
$ plot_lines_title ^= "price 1"
$ defaultPlotLines
price1_area = plot_fillbetween_values ^= [((date d m y), (v * 0.95, v * 1.05)) | (d,m,y,v,_) <- prices]
$ plot_fillbetween_style ^= solidFillStyle (withOpacity blue 0.2)
$ defaultPlotFillBetween
price2 = plot_lines_style ^= lineStyle (opaque red)
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]]
$ plot_lines_title ^= "price 2"
$ defaultPlotLines
price2_area = plot_fillbetween_values ^= [((date d m y), (v * 0.95, v * 1.05)) | (d,m,y,_,v) <- prices]
$ plot_fillbetween_style ^= solidFillStyle (withOpacity red 0.2)
$ defaultPlotFillBetween
fg = opaque black
fg1 = opaque $ sRGB 0.0 0.0 0.15
layout = layout1_title ^="Price History"
$ layout1_background ^= solidFillStyle (opaque white)
$ layout1_right_axis ^: laxis_override ^= axisGridHide
$ layout1_plots ^= [ Left (toPlot price1_area), Right (toPlot price2_area)
, Left (toPlot price1), Right (toPlot price2)
]
$ setLayout1Foreground fg
$ defaultLayout1
----------------------------------------------------------------------
-- a quick test to display labels with all combinations
-- of anchors
misc1 rot otype = fillBackground fwhite $ (gridToRenderable t)
where
t = weights (1,1) $ aboveN [ besideN [tval (lb h v) | h <- hs] | v <- vs ]
lb h v = addMargins (20,20,20,20) $ fillBackground fblue $ crossHairs $ rlabel fs h v rot s
s = "Labelling"
hs = [HTA_Left, HTA_Centre, HTA_Right]
vs = [VTA_Top, VTA_Centre, VTA_Bottom]
fwhite = solidFillStyle $ opaque white
fblue = solidFillStyle $ opaque $ sRGB 0.8 0.8 1
fs = defaultFontStyle{font_size_=20,font_weight_=C.FontWeightBold}
crossHairs r =Renderable {
minsize = minsize r,
render = \sz@(w,h) -> do
let xa = w / 2
let ya = h / 2
strokeLines [Point 0 ya,Point w ya]
strokeLines [Point xa 0,Point xa h]
render r sz
}
----------------------------------------------------------------------
allTests :: [ (String, OutputType -> Renderable ()) ]
allTests =
[ ("test1", test1)
, ("test1a", test1a)
, ("test2a", test2 prices False)
, ("test2b", test2 (filterPrices (date 1 1 2005) (date 31 12 2005)) False)
, ("test2c", test2 (filterPrices (date 1 5 2005) (date 1 7 2005)) False)
, ("test2d", test2 (filterPrices (date 1 1 2006) (date 10 1 2006)) False)
, ("test2e", test2 (filterPrices (date 1 8 2005) (date 31 8 2005)) True)
, ("test3", test3)
, ("test4a", test4 False False)
, ("test4b", test4 True False)
, ("test4c", test4 False True)
, ("test5", test5)
, ("test6", test6)
, ("test7", test7)
, ("test8", test8)
, ("test9", test9)
, ("test10", test10 (filterPrices (date 1 1 2005) (date 31 12 2005)))
, ("misc1", misc1 0)
, ("misc1a", misc1 45)
]
filterPrices t1 t2 = [ v | v@(d,m,y,_,_) <- prices, let t = date d m y in t >= t1 && t <= t2]
main = do
args <- getArgs
main1 args
main1 :: [String] -> IO ()
main1 ("--png":tests) = showTests tests renderToPNG
main1 ("--pdf":tests) = showTests tests renderToPDF
main1 ("--svg":tests) = showTests tests renderToSVG
main1 ("--ps":tests) = showTests tests renderToPS
main1 tests = showTests tests renderToWindow
showTests :: [String] -> ((String,OutputType -> Renderable ()) -> IO()) -> IO ()
showTests tests ofn = mapM_ ofn (filter (match tests) allTests)
match :: [String] -> (String,a) -> Bool
match [] t = True
match ts t = (fst t) `elem` ts
renderToWindow (n,ir) = renderableToWindow (ir Window) 640 480
renderToPNG (n,ir) = renderableToPNGFile (ir PNG) 640 480 (n ++ ".png")
renderToPS (n,ir) = renderableToPSFile (ir PS) 640 480 (n ++ ".ps")
renderToPDF (n,ir) = renderableToPDFFile (ir PDF) 640 480 (n ++ ".pdf")
renderToSVG (n,ir) = renderableToSVGFile (ir SVG) 640 480 (n ++ ".svg")