Chart-0.9: 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 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)
----------------------------------------------------------------------
test1 :: OutputType -> Renderable ()
test1 otype = toRenderable 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
$ defaultPlotLines
sinusoid2 = plot_points_style ^= filledCircles 2 red
$ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]]
$ defaultPlotPoints
layout = layout1_title ^= "Amplitude Modulation"
$ layout1_plots ^= [("am",Left (toPlot sinusoid1)),
("am points", Left (toPlot sinusoid2))]
$ defaultLayout1
lineWidth = chooseLineWidth otype
test1a :: OutputType -> Renderable ()
test1a otype = toRenderable 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
$ defaultPlotLines
sinusoid2 = plot_points_style ^= filledCircles 2 red
$ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]]
$ defaultPlotPoints
axis = mAxis $ axisGridAtTicks.autoScaledAxis (
la_nLabels ^= 2
$ la_nTicks ^= 20
$ defaultLinearAxis
)
layout = layout1_title ^= "Amplitude Modulation"
$ updateXAxesData (const axis)
$ updateYAxesData (const axis)
$ layout1_plots ^= [("am",Left (toPlot sinusoid1)),
("am points", Left (toPlot sinusoid2))]
$ defaultLayout1
lineWidth = chooseLineWidth 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]]
$ defaultPlotLines
price2 = plot_lines_style ^= lineStyle green
$ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]]
$ defaultPlotLines
vaxis = mAxis $ axisGridNone.autoAxis
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_data ^= vaxis
$ layout1_right_axis ^: laxis_data ^= vaxis
$ layout1_plots ^= [("price 1", Left (toPlot price1)),
("price 2", Right (toPlot price2))]
$ layout1_grid_last ^= False
$ setForeground 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]
$ defaultPlotFillBetween
price2 = plot_fillbetween_style ^= solidFillStyle red1
$ plot_fillbetween_values ^= [ (date d m y,(0,v1)) | (d,m,y,v1,v2) <- prices]
$ defaultPlotFillBetween
layout = layout1_title ^= "Price History"
$ layout1_plots ^= [("price 1", Left (toPlot price1)),
("price 2", 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] ]
$ defaultPlotPoints
lines = plot_lines_values ^= [ [(x, LogValue (10**x)) | x <- [0,3]] ]
$ 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 ^= [("values",Left (toPlot points)),
("values",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 ^= [
("f=0.05", Left (toPlot (plot s1 n 0 (t 0.05)))),
("f=0.1", Left (toPlot (plot s2 n 0 (t 0.1))))]
$ defaultLayout1
plot 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]]
$ 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]
$ defaultPlotErrBars
points = plot_points_style ^= filledCircles 2 red
$ plot_points_values ^= [(x,y) | (x,y,dx,dy) <- vals]
$ defaultPlotPoints
layout = layout1_title ^= "errorbars example"
$ layout1_plots ^= [("test",Left (toPlot bars)),
("test",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
----------------------------------------------------------------------
-- 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)
, ("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)
, ("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")