Chart-0.10.1: 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.List(sort,nub,scanl1)
import qualified Data.Map as Map
import Debug.Trace
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 = (Color 0.5 1 0.5)
red1 = (Color 0.5 0.5 1)
fwhite = solidFillStyle white
fparchment = solidFillStyle (color 255 250 230)
----------------------------------------------------------------------
test1Layout otype = layout
where
am :: Double -> Double
am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))
sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]]
$ plot_lines_style ^= solidLine lineWidth blue
$ plot_lines_title ^="am"
$ defaultPlotLines
sinusoid2 = plot_points_style ^= filledCircles 2 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))
test1b :: OutputType -> Renderable ()
test1b otype = toRenderable layout
where
layout = layout1_title ^= "Amplitude Modulation"
$ layout1_legend ^= Just ( legend_vertical ^= True $ defaultLegendStyle)
$ (test1Layout otype)
----------------------------------------------------------------------
test2 :: [(Int,Int,Int,Double,Double)] -> OutputType -> Renderable ()
test2 prices otype = toRenderable layout
where
lineStyle c = line_width ^= 3 * chooseLineWidth otype
$ line_color ^= c
$ defaultPlotLines ^. plot_lines_style
price1 = plot_lines_style ^= lineStyle 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 green
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]]
$ plot_lines_title ^= "price 2"
$ defaultPlotLines
bg = Color 0 0 0.25
fg = Color 1 1 1
fg1 = Color 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)]
$ 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 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 green
s2 = solidLine lineWidth 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 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
----------------------------------------------------------------------
-- 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 white
fblue = solidFillStyle (Color 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)
, ("test1b", test1b)
, ("test2a", test2 prices)
, ("test2b", test2 (filterPrices (date 1 1 2005) (date 31 12 2005)))
, ("test2c", test2 (filterPrices (date 1 5 2005) (date 1 7 2005)))
, ("test2d", test2 (filterPrices (date 1 1 2006) (date 10 1 2006)))
, ("test3", test3)
, ("test4a", test4 False False)
, ("test4b", test4 True False)
, ("test4c", test4 False True)
, ("test5", test5)
, ("test6", test6)
, ("test7", test7)
, ("test8", test8)
, ("test9", test9)
, ("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")