Skip to content

Commit 65fc6e0

Browse files
clayratclayrat
committed
add test20, refactor
1 parent 1300c28 commit 65fc6e0

File tree

3 files changed

+147
-65
lines changed

3 files changed

+147
-65
lines changed

‎chart-tests/Chart-tests.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,7 @@ Executable chart-harness
7373
Test15
7474
Test17
7575
Test19
76+
Test20
7677
TestParametric
7778
Tests
7879
TestSparkLines

‎chart-tests/tests/Test20.hs‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
module Test20 where
2+
3+
import Text.Printf
4+
import Graphics.Rendering.Chart
5+
import Data.Colour
6+
import Data.Colour.Names
7+
import Control.Lens
8+
import Data.Default.Class
9+
10+
import Utils
11+
import Test.QuickCheck (Result(Failure))
12+
13+
dat :: [[Double]]
14+
dat = [[662.2192174833207, 508.5424119528999]
15+
,[18.507408294149144, 29.94826136042779]
16+
,[371.34564215397256, 582.0060747629345]
17+
,[0.33308595521927825, 0.25399999403605966]
18+
,[8.418936013584233, 5.144029932796894]
19+
,[671.9053209933879, 625.5976275368557]
20+
,[0.20500418021076805, 0.7397264674905577]
21+
,[93.52395426151023, 96.01214737959424]
22+
,[486.5332691543843, 333.4124444949074]
23+
,[151.27192832718126, 317.4545157262858]
24+
,[42.246424931587924, 56.89305428360467]
25+
,[8.812241283978576, 3.0449891300138225]
26+
,[41.763424901388305, 23.924663084356638]
27+
,[50.77174917622324, 91.54897286917759]
28+
,[0.743806669182276, 0.14540395376496337]
29+
,[3.152519452338129, 3.76835741734118]
30+
,[557.5637240640731, 665.350935501769]
31+
,[0.9546959351374888, 0.6673023316342984]
32+
,[588.1299411301322, 416.766677808916]
33+
,[7.496126744615885, 1.4640493059283133]]
34+
35+
chart :: Renderable (LayoutPick PlotIndex LogValue LogValue)
36+
chart = layoutToRenderable layout
37+
where
38+
layout =
39+
-- title
40+
layout_title .~ "Sample Log Bars"
41+
$ layout_title_style . font_size .~ 10
42+
43+
-- X
44+
$ layout_x_axis . laxis_generate .~ autoIndexTicksAxis alabels
45+
$ layout_x_axis . laxis_override .~ axisGridAtTicks
46+
$ layout_x_axis . laxis_style . axis_grid_style .~ solidLine 0.3 (opaque lightgrey)
47+
$ layout_bottom_axis_visibility . axis_show_ticks .~ False
48+
49+
-- Y
50+
$ layout_y_axis . laxis_style . axis_grid_style .~ solidLine 0.15 (opaque lightgrey)
51+
$ layout_y_axis . laxis_override .~ axisGridAtBigTicks
52+
$ layout_left_axis_visibility . axis_show_ticks .~ True
53+
$ layout_right_axis_visibility . axis_show_line .~ True
54+
$ layout_right_axis_visibility . axis_show_ticks .~ True
55+
56+
-- data
57+
$ layout_plots .~ [ plotBars bars2 ]
58+
$ def :: Layout PlotIndex LogValue
59+
60+
bars2 = plot_bars_titles .~ ["","after","before"]
61+
$ plot_bars_values_with_labels .~ addIndexes dat'
62+
$ plot_bars_style .~ BarsStacked
63+
$ plot_bars_spacing .~ BarsFixGap 20 5
64+
$ plot_bars_item_styles .~ map (\c -> (solidFillStyle $ withOpacity c 0.7, Nothing)) [grey, red, green]
65+
$ def
66+
67+
dat' = map (\[a,b] -> [ (LogValue (min a b), "")
68+
, if a < b then
69+
let v = b - a in
70+
(LogValue v, printf "%0.2f" v)
71+
else (LogValue 0, "")
72+
, if b < a then
73+
let v = a - b in
74+
(LogValue v, printf "%0.2f" (-v))
75+
else (LogValue 0, "")
76+
]) dat
77+
78+
alabels = map (\n -> "#" ++ show n) $ take (length dat) [1..]
79+

‎chart-tests/tests/Tests.hs‎

Lines changed: 67 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -19,18 +19,19 @@ import Prices
1919
import System.Random
2020
import System.Time
2121
import qualified Test1
22-
import qualified Test14
23-
import qualified Test14a
24-
import qualified Test15
25-
import qualified Test17
26-
import qualified Test19
2722
import qualified Test2
2823
import qualified Test3
2924
import qualified Test4
3025
import qualified Test5
3126
import qualified Test7
3227
import qualified Test8
3328
import qualified Test9
29+
import qualified Test14
30+
import qualified Test14a
31+
import qualified Test15
32+
import qualified Test17
33+
import qualified Test19
34+
import qualified Test20
3435
import qualified TestParametric
3536
import qualified TestSparkLines
3637

@@ -39,7 +40,7 @@ type LineWidth = Double
3940
fwhite = solidFillStyle $ opaque white
4041

4142
test1a :: Double -> Renderable (LayoutPick Double Double Double)
42-
test1a lwidth = fillBackground fwhite $ (gridToRenderable t)
43+
test1a lwidth = fillBackground fwhite $ gridToRenderable t
4344
where
4445
t = aboveN [ besideN [layoutToGrid l1, layoutToGrid l2, layoutToGrid l3],
4546
besideN [layoutToGrid l4, layoutToGrid l5, layoutToGrid l6] ]
@@ -117,7 +118,7 @@ test4d lw = layoutToRenderable layout
117118
----------------------------------------------------------------------
118119

119120
test9 :: PlotBarsAlignment -> LineWidth -> Renderable (LayoutPick PlotIndex Double Double)
120-
test9 alignment lw = fillBackground fwhite $ (gridToRenderable t)
121+
test9 alignment lw = fillBackground fwhite (gridToRenderable t)
121122
where
122123
t = weights (1,1) $ aboveN [ besideN [rf g0, rf g1, rf g2],
123124
besideN [rf g3, rf g4, rf g5] ]
@@ -256,8 +257,8 @@ test11_ f = f layout1 layout2
256257
$ layout_y_axis . laxis_title .~ "double values"
257258
$ def
258259

259-
mkStack ls f =
260-
renderStackedLayouts
260+
mkStack ls f =
261+
renderStackedLayouts
261262
$ slayouts_layouts .~ ls
262263
$ slayouts_compress_legend .~ f
263264
$ def
@@ -266,7 +267,7 @@ test11a :: LineWidth -> Renderable ()
266267
test11a lw = test11_ f
267268
where
268269
f l1 l2 = mkStack [StackedLayout l1, StackedLayout l2] False
269-
270+
270271
test11b :: LineWidth -> Renderable ()
271272
test11b lw = test11_ f
272273
where
@@ -277,22 +278,22 @@ test11b lw = test11_ f
277278

278279
-- should produce the same output as test10
279280
test11c :: LineWidth -> Renderable ()
280-
test11c lw =
281+
test11c lw =
281282
mkStack [ StackedLayoutLR (test10LR prices1 lw)] True
282283

283284
test11d :: LineWidth -> Renderable ()
284-
test11d lw =
285+
test11d lw =
285286
mkStack [ StackedLayoutLR (Test2.chartLR prices1 False lw)
286287
, StackedLayoutLR (test10LR prices1 lw)
287288
] False
288289

289290
test11e :: LineWidth -> Renderable ()
290-
test11e lw =
291+
test11e lw =
291292
let l2 = Test2.chartLR prices1 False lw
292293
b = opaque black
293294
-- how to use lens to get inside the maybe?
294295
l2' = -- layoutlr_legend . Just . legend_label_style . font_color .~ b
295-
layoutlr_legend .~ Just ((legend_label_style . font_color .~ b) $ def)
296+
layoutlr_legend ?~ (legend_label_style . font_color .~ b) def
296297
$ (layoutlr_axes_styles %~ c) l2
297298
c as = axis_line_style .~ solidLine 1 b
298299
$ axis_label_style . font_color .~ b
@@ -318,7 +319,7 @@ test12 lw = layoutToRenderable layout
318319
_axis_ticks = [(v,3) | v <- [0,1..15]],
319320
_axis_grid = [0,5..15],
320321
_axis_labels = [[(v,show v) | v <- [0,5..15]]]
321-
}
322+
}
322323

323324
laxis = AxisData {
324325
_axis_visibility = def,
@@ -327,7 +328,7 @@ test12 lw = layoutToRenderable layout
327328
_axis_ticks = [(v,3) | v <- [0,25..500]],
328329
_axis_grid = [0,100..500],
329330
_axis_labels = [[(v,show v) | v <- [0,100..500]]]
330-
}
331+
}
331332

332333
plot = plot_lines_values .~ [vs1]
333334
$ def
@@ -342,7 +343,7 @@ test12 lw = layoutToRenderable layout
342343
-------------------------------------------------------------------------------
343344
-- Plot annotations test
344345

345-
test13 lw = fillBackground fwhite $ (gridToRenderable t)
346+
test13 lw = fillBackground fwhite (gridToRenderable t)
346347
where
347348
t = weights (1,1) $ aboveN [ besideN [tval (annotated h v) | h <- hs] | v <- vs ]
348349
hs = [HTA_Left, HTA_Centre, HTA_Right]
@@ -359,7 +360,7 @@ test13 lw = fillBackground fwhite $ (gridToRenderable t)
359360
$ plot_annotation_values .~ [(x,x,"Hello World\n(plain)")|x<-points]
360361
$ def
361362
rotPlot = plot_annotation_angle .~ -45.0
362-
$ plot_annotation_style .~ def {_font_size=10, _font_weight=FontWeightBold, _font_color=(opaque blue) }
363+
$ plot_annotation_style .~ def {_font_size=10, _font_weight=FontWeightBold, _font_color=opaque blue }
363364
$ plot_annotation_values .~ [(x,x,"Hello World\n(fancy)")|x<-points]
364365
$ labelPlot
365366

@@ -372,7 +373,7 @@ test18 = layoutToRenderable layout
372373
where
373374
grid = [(x,y) | x <- range, y <- range] where range = [-5,-4..5]
374375

375-
proj1 = plot_vectors_style . vector_head_style . point_color .~ (opaque green)
376+
proj1 = plot_vectors_style . vector_head_style . point_color .~ opaque green
376377
$ plot_vectors_mapf .~ (\(x,y) -> (-x,-y))
377378
$ plot_vectors_grid .~ grid
378379
$ plot_vectors_title .~ "Projection1"
@@ -384,13 +385,13 @@ test18 = layoutToRenderable layout
384385
$ def
385386

386387
layout = layout_title .~ "Vector Plot: Abyss"
387-
$ layout_plots .~ plotVectorField `liftM` [proj1,proj2]
388+
$ layout_plots .~ map plotVectorField [proj1,proj2]
388389
$ def
389390

390391
----------------------------------------------------------------------
391392
-- a quick test to display labels with all combinations
392393
-- of anchors
393-
misc1 fsz rot lw = fillBackground fwhite $ (gridToRenderable t)
394+
misc1 fsz rot lw = fillBackground fwhite (gridToRenderable t)
394395
where
395396
t = weights (1,1) $ aboveN [ besideN [tval (lb h v) | h <- hs] | v <- vs ]
396397
lb h v = addMargins (20,20,20,20) $ fillBackground fblue $ crossHairs $ rlabel fs h v rot s
@@ -407,8 +408,8 @@ misc1 fsz rot lw = fillBackground fwhite $ (gridToRenderable t)
407408
render = \sz@(w,h) -> do
408409
let xa = w / 2
409410
let ya = h / 2
410-
alignStrokePoints [Point 0 ya,Point w ya] >>= strokePointPath
411-
alignStrokePoints [Point xa 0,Point xa h] >>= strokePointPath
411+
alignStrokePoints [Point 0 ya,Point w ya] >>= strokePointPath
412+
alignStrokePoints [Point xa 0,Point xa h] >>= strokePointPath
412413
render r sz
413414
}
414415

@@ -417,62 +418,63 @@ stdSize = (640,480)
417418

418419
allTests :: [ (String, (Int,Int), LineWidth -> Renderable ()) ]
419420
allTests =
420-
[ ("test1", stdSize, \lw -> simple $ Test1.chart lw )
421-
, ("test1a", stdSize, \lw -> simple $ test1a lw )
422-
, ("test2a", stdSize, \lw -> simple $ Test2.chart prices False lw)
423-
, ("test2b", stdSize, \lw -> simple $ Test2.chart prices1 False lw)
424-
, ("test2c", stdSize, \lw -> simple $ Test2.chart prices2 False lw)
425-
, ("test2d", stdSize, \lw -> simple $ Test2.chart prices5 True lw)
426-
, ("test2e", stdSize, \lw -> simple $ Test2.chart prices6 True lw)
427-
, ("test2f", stdSize, \lw -> simple $ Test2.chart prices7 True lw)
428-
, ("test2g", stdSize, \lw -> simple $ Test2.chart prices3 False lw)
429-
, ("test2h", stdSize, \lw -> simple $ Test2.chart prices8 True lw)
430-
, ("test2i", stdSize, \lw -> simple $ Test2.chart prices9 True lw)
431-
, ("test2j", stdSize, \lw -> simple $ Test2.chart prices10 True lw)
432-
, ("test2k", stdSize, \lw -> simple $ Test2.chart prices10a True lw)
433-
, ("test2m", stdSize, \lw -> simple $ Test2.chart prices11 True lw)
434-
, ("test2n", stdSize, \lw -> simple $ Test2.chart prices10b True lw)
435-
, ("test2o", stdSize, \lw -> simple $ Test2.chart prices12 True lw)
436-
, ("test2p", stdSize, \lw -> simple $ Test2.chart prices13 True lw)
437-
, ("test2q", stdSize, \lw -> simple $ Test2.chart prices13a True lw)
438-
, ("test2r", stdSize, \lw -> simple $ Test2.chart prices13b True lw)
439-
, ("test2s", stdSize, \lw -> simple $ Test2.chart prices14 True lw)
440-
, ("test2t", stdSize, \lw -> simple $ Test2.chart prices14a True lw)
441-
, ("test2u", stdSize, \lw -> simple $ Test2.chart prices14b True lw)
442-
, ("test2v", stdSize, \lw -> simple $ Test2.chart prices14c True lw)
443-
, ("test2w", stdSize, \lw -> simple $ Test2.chart prices14d True lw)
421+
[ ("test1", stdSize, simple . Test1.chart)
422+
, ("test1a", stdSize, simple . test1a)
423+
, ("test2a", stdSize, simple . Test2.chart prices False)
424+
, ("test2b", stdSize, simple . Test2.chart prices1 False)
425+
, ("test2c", stdSize, simple . Test2.chart prices2 False)
426+
, ("test2d", stdSize, simple . Test2.chart prices5 True )
427+
, ("test2e", stdSize, simple . Test2.chart prices6 True )
428+
, ("test2f", stdSize, simple . Test2.chart prices7 True )
429+
, ("test2g", stdSize, simple . Test2.chart prices3 False)
430+
, ("test2h", stdSize, simple . Test2.chart prices8 True )
431+
, ("test2i", stdSize, simple . Test2.chart prices9 True )
432+
, ("test2j", stdSize, simple . Test2.chart prices10 True )
433+
, ("test2k", stdSize, simple . Test2.chart prices10a True )
434+
, ("test2m", stdSize, simple . Test2.chart prices11 True )
435+
, ("test2n", stdSize, simple . Test2.chart prices10b True )
436+
, ("test2o", stdSize, simple . Test2.chart prices12 True )
437+
, ("test2p", stdSize, simple . Test2.chart prices13 True )
438+
, ("test2q", stdSize, simple . Test2.chart prices13a True )
439+
, ("test2r", stdSize, simple . Test2.chart prices13b True )
440+
, ("test2s", stdSize, simple . Test2.chart prices14 True )
441+
, ("test2t", stdSize, simple . Test2.chart prices14a True )
442+
, ("test2u", stdSize, simple . Test2.chart prices14b True )
443+
, ("test2v", stdSize, simple . Test2.chart prices14c True )
444+
, ("test2w", stdSize, simple . Test2.chart prices14d True )
444445
, ("test3", stdSize, const $ simple Test3.chart)
445446
, ("test4a", stdSize, const $ simple (Test4.chart False False))
446447
, ("test4b", stdSize, const $ simple (Test4.chart True False))
447448
, ("test4c", stdSize, const $ simple (Test4.chart False True))
448-
, ("test4d", stdSize, \lw -> simple $ test4d lw)
449-
, ("test5", stdSize, \lw -> simple $ Test5.chart lw)
449+
, ("test4d", stdSize, simple . test4d)
450+
, ("test5", stdSize, simple . Test5.chart)
450451
, ("test7", stdSize, const $ simple Test7.chart)
451452
, ("test8", stdSize, const $ simple Test8.chart)
452453
, ("test9", stdSize, const $ simple (Test9.chart True))
453454
, ("test9b", stdSize, const $ simple (Test9.chart False))
454-
, ("test9c", stdSize, \lw -> simple $ test9 BarsCentered lw)
455-
, ("test9l", stdSize, \lw -> simple $ test9 BarsLeft lw)
456-
, ("test9r", stdSize, \lw -> simple $ test9 BarsRight lw)
457-
, ("test10", stdSize, \lw -> simple $ test10 prices1 lw)
458-
, ("test11a", stdSize, \lw -> simple $ test11a lw)
459-
, ("test11b", stdSize, \lw -> simple $ test11b lw)
460-
, ("test11c", stdSize, \lw -> simple $ test11c lw)
461-
, ("test11d", stdSize, \lw -> simple $ test11d lw)
462-
, ("test11e", stdSize, \lw -> simple $ test11e lw)
463-
, ("test12", stdSize, \lw -> simple $ test12 lw)
464-
, ("test13", stdSize, \lw -> simple $ test13 lw)
465-
, ("test14", stdSize, \lw -> simple $ Test14.chart lw )
466-
, ("test14a", stdSize, \lw -> simple $ Test14a.chart lw )
455+
, ("test9c", stdSize, simple . test9 BarsCentered)
456+
, ("test9l", stdSize, simple . test9 BarsLeft)
457+
, ("test9r", stdSize, simple . test9 BarsRight)
458+
, ("test10", stdSize, simple . test10 prices1)
459+
, ("test11a", stdSize, simple . test11a)
460+
, ("test11b", stdSize, simple . test11b)
461+
, ("test11c", stdSize, simple . test11c)
462+
, ("test11d", stdSize, simple . test11d)
463+
, ("test11e", stdSize, simple . test11e)
464+
, ("test12", stdSize, simple . test12)
465+
, ("test13", stdSize, simple . test13)
466+
, ("test14", stdSize, simple . Test14.chart)
467+
, ("test14a", stdSize, simple . Test14a.chart)
467468
, ("test15a", stdSize, const $ simple (Test15.chart (LORows 2) LegendBelow))
468469
, ("test15b", stdSize, const $ simple (Test15.chart (LOCols 2) LegendBelow))
469470
, ("test15c", stdSize, const $ simple (Test15.chart (LORows 2) LegendLeft))
470471
, ("test15d", stdSize, const $ simple (Test15.chart (LORows 2) LegendRight))
471472
, ("test15e", stdSize, const $ simple (Test15.chart (LOCols 2) LegendAbove))
472-
, ("test17", stdSize, \lw -> simple $ Test17.chart lw)
473+
, ("test17", stdSize, simple . Test17.chart)
473474
, ("test18", stdSize, const $ simple test18)
474475
, ("test19", stdSize, const $ simple Test19.chart)
475476
, ("test19b", stdSize, const $ simple Test19.chart2)
477+
, ("test20", stdSize, const $ simple Test20.chart)
476478
, ("misc1", stdSize, setPickFn nullPickFn . misc1 20 0)
477479
-- perhaps a bit excessive
478480
, ("misc1a", stdSize, setPickFn nullPickFn . misc1 12 45)
@@ -482,7 +484,7 @@ allTests =
482484
, ("misc1e", stdSize, setPickFn nullPickFn . misc1 12 205)
483485
, ("misc1f", stdSize, setPickFn nullPickFn . misc1 12 270)
484486
, ("misc1g", stdSize, setPickFn nullPickFn . misc1 12 315)
485-
, ("parametric", stdSize, \lw -> simple $ TestParametric.chart lw )
487+
, ("parametric", stdSize, simple . TestParametric.chart)
486488
, ("sparklines", TestSparkLines.chartSize, const $ simple TestSparkLines.chart )
487489
]
488490
where simple :: Renderable a -> Renderable ()
@@ -496,7 +498,7 @@ showTests tests ofn = mapM_ doTest (filter (match tests) allTests)
496498
doTest (s,size,f) = do
497499
putStrLn (s ++ "... ")
498500
ofn (s,size,f)
499-
501+
500502

501503
getTests :: [String] -> [(String,(Int,Int),LineWidth -> Renderable ())]
502504
getTests names = filter (match names) allTests

0 commit comments

Comments
 (0)