context("(deprecated) Chart")
types <- c("Area", "Stacked Area", "100% Stacked Area",
"Bar", "Stacked Bar", "100% Stacked Bar",
"Column", "Stacked Column", "100% Stacked Column",
"Line", "Pie", "Donut", "Radar")
stacked.types <- c("Stacked Area", "100% Stacked Area",
"Stacked Bar", "100% Stacked Bar",
"Stacked Column", "100% Stacked Column")
hundred.percent.stacked.types <- c("100% Stacked Area", "100% Stacked Bar", "100% Stacked Column")
area.or.line.charts <- c("Area", "Stacked Area", "100% Stacked Area", "Line")
unnamed.vector <- c(5, 6, 2, 1.5, 9, 2.2)
named.vector <- structure(c(5, 6, 2, 1.5, 9, 2.2), .Names = c("A", "B", "C", "D", "E", "F"))
unnamed.matrix <- structure(c(1.59, 0.44, 2.52, 0.19, 0.71, 0.18, 0.18, 0.61, 0.08,
1.07, 1.31, 0.45, 0.17, 2.87, 2.08, 0.53, 2.62, 1.88, 1.73, 0.12),
.Dim = c(5L, 4L))
named.matrix <- structure(c(1.59, 0.44, 2.52, 0.19, 0.71, 0.18, 0.18, 0.61, 0.08,
1.07, 1.31, 0.45, 0.17, 2.87, 2.08, 0.53, 2.62, 1.88, 1.73, 0.12),
.Dim = c(5L, 4L), .Dimnames = list(c("Row 1", "Row 2", "Row 3", "Row 4", "Row 5"),
c("Column 1", "Column 2", "Column 3", "Column 4")))
missing <- structure(c(NA, NA, NA, NA, 0.71, NA, 0.18, 0.61, 0.08,
1.07, NA, 0.45, 0.17, 2.87, NaN, 0.53, 2.62, 1.88, 1.73, 0.12),
.Dim = c(5L, 4L), .Dimnames = list(c("Row 1", "Row 2", "Row 3", "Row 4", "Row 5"),
c("Column 1", "Column 2", "Column 3", "Column 4")))
row.sum.zero <- structure(c(0, 0.44, 2.52, 0.19, 0.71, 0, 0.18, 0.61, 0.08,
1.07, 0, 0.45, 0.17, 2.87, 2.08, 0, 2.62, 1.88, 1.73, 0.12),
.Dim = c(5L, 4L))
duplicate.rows <- structure(c(1.59, 0.44, 2.52, 0.19, 0.71, 0.18, 0.18, 0.61, 0.08,
1.07, 1.31, 0.45, 0.17, 2.87, 2.08, 0.53, 2.62, 1.88, 1.73, 0.12),
.Dim = c(5L, 4L), .Dimnames = list(c("Row", "Row 2", "Row", "Row 4", "Row 5"),
c("Column 1", "Column 2", "Column 3", "Column 4")))
dat <- data.frame(named.matrix)
three.dimensional <- structure(1:60, .Dim = 3:5)
table.with.statistic <- structure(c(1.59, 0.44, 2.52, 0.19, 0.71, 0.18, 0.18, 0.61, 0.08,
1.07, 1.31, 0.45, 0.17, 2.87, 2.08, 0.53, 2.62, 1.88, 1.73, 0.12), .Dim = c(5L, 4L),
.Dimnames = list(c("Row 1", "Row 2", "Row 3", "Row 4", "Row 5"),
c("Column 1", "Column 2", "Column 3", "Column 4")),
statistic = "%", questions = "Q1")
monthly <- structure(c(7.34177215189873, 9.36708860759494, 9.36708860759494,
7.84810126582278, 8.60759493670886, 8.86075949367089, 10.6329113924051,
5.31645569620253, 8.35443037974684, 7.84810126582278, 9.11392405063291,
7.34177215189873, 7.40740740740741, 6.91358024691358, 9.62962962962963,
10.8641975308642, 6.41975308641975, 7.40740740740741, 8.64197530864197,
8.39506172839506, 8.64197530864197, 8.88888888888889, 8.64197530864197,
8.14814814814815, 7.375, 8.125, 9.5, 9.375, 7.5, 8.125, 9.625,
6.875, 8.5, 8.375, 8.875, 7.75), .Dim = c(12L, 3L),
statistic = "Column %", .Dimnames = list(
c("January 2012", "February 2012", "March 2012", "April 2012",
"May 2012", "June 2012", "July 2012", "August 2012", "September 2012",
"October 2012", "November 2012", "December 2012"), c("Male", "Female", "NET")),
name = "Interview Date by Gender",
questions = c("Interview Date", "Gender [Cola Tracking - January to December.sav]"))
arr <- structure(c(13.4556574923547, 11.9266055045872, 10.0917431192661,
11.0091743119266, 10.7033639143731, 8.25688073394496, 12.2324159021407,
15.5963302752294, 6.72782874617737, 100), .Dim = 10L, statistic = "%", .Dimnames = list(
c("18 to 24", "25 to 29", "30 to 34", "35 to 39", "40 to 44",
"45 to 49", "50 to 54", "55 to 64", "65 or more", "NET")),
name = "Q3. Age", questions = c("Q3. Age", "SUMMARY"))
date.with.gap <- structure(c(0.414763916575021, 2.0711222190476, 1.86615883632686,
2.73274539424782, 3.76705083360367, 0.393770872527476, 9.84321542017505,
4.53164907368953, 8.14473341079688, 5.63350810049821, 27.2610331276821,
22.4746584132118, 9.38304940157972, 21.1757437410639, 14.3059312070915,
9.546186174272, 11.5315834290657, 25.2422379009045, 9.3591064099846,
7.04261623098657), .Names = c("01/07/2017", "02/07/2017", "03/07/2017",
"04/07/2017", "05/07/2017", "06/07/2017", "07/07/2017", "08/07/2017",
"09/07/2017", "10/07/2017", "12/07/2017", "13/07/2017", "14/07/2017",
"15/07/2017", "16/07/2017", "17/07/2017", "18/07/2017", "19/07/2017",
"20/07/2017", "21/07/2017"))
search.share <- structure(c(1.47058823529412, 14.2857142857143, 22.2222222222222,
6.25, 60, 41.6666666666667, 26.3157894736842, 53.8461538461538,
42.8571428571429, 45, 57.1428571428571, 55.5555555555556, 78.5714285714286,
77.7777777777778, 66.6666666666667, 59.2592592592593, 60, 90,
100, 78.9473684210526, 80, 83.3333333333333, 100, NaN, 85.7142857142857,
NaN, 50, 100, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN,
NaN, NaN), .Names = c("Week 1 n:136", "2 n:21", "3 n:18", "4 n:16",
"5 n:5", "6 n:12", "7 n:19", "8 n:13", "9 n:21", "10 n:20", "11 n:7",
"12 n:9", "13 n:14", "14 n:18", "15 n:9", "16 n:27", "17 n:10",
"18 n:10", "19 n:6", "20 n:19", "21 n:10", "22 n:6", "23 n:4",
"24 n:0", "25 n:7", "26 n:0", "27 n:2", "28 n:1", "29 n:0", "30 n:0",
"31 n:0", "32 n:0", "33 n:0", "34 n:0", "35 n:0", "36 n:0", "37 n:0",
"38 n:0", "39 n:0", "40 n:0"))
missing2 <- cbind(A=search.share, B=1:length(search.share))
acquisitions <- structure(c(2155.87723461478, 2155.87723461478, 10024.8141116912,
6467.63170384433, 2155.87723461478, 0, 3233.81585192216, 14875.5260243632,
4732.81585192216, 14013.1703844328, 14120.9776934029, 1077.93861730739,
2155.87723461478, 6467.62379370353, 3341.60734061066, 1077.93861730739,
7545.57032115172, 8623.5089384591, 9162.4663819016, 6359.75320360702,
4311.74655908875, 4530.35912039234, 6795.53077044771, 0, 4530.35912039234,
8966.32653061224, 5662.94890049043, 10193.300110742, 5096.65401044139,
13591.0536307546, 7588.34045246005, 4530.35912039234, 4530.35912039234,
3397.76934029426, 6795.53077044771, 2265.17956019617, 9319.09507989242,
11325.8898908401, 5662.94890049043, 6795.53077044771, 2265.17956019617,
22085.4690713495, 5996.60654959658, 7270.13921847809, 0, 0, 3870.11746559089,
1290.03915519696, 2580.07831039393, 1290.03915519696, 2580.07831039393,
1290.03915519696, 7740.23493118178, 0, 0, 10320.3132415757, 6445.77942572378,
10320.3132415757, 20640.6264831514, 0, 3762.39467647524, 1290.03915519696,
2580.07831039393, 9675.29366397722, 10707.3249881348, 2580.07831039393,
6450.19577598481, 16125.489439962, 9030.27408637874, 10320.3132415757,
11610.3523967727, 7740.23493118178, 16254.4933554817, 3870.11746559089,
3870.11746559089, 11756.9184068976, 6449.31767125455, 10198.4762102515,
8256.25059326056, 0, 10335.9994462901, 15738.4776934029, 7740.23493118178,
20640.6264831514, 19350.5873279544, 26333.1340966619, 2838.34440753045,
10147.0812569214, 1305.72535991141, 4197.2, 1499, 0, 4076.6294494542,
4047.3, 4823.43133997785, 2804.72535991141, 2554.064831514, 6920.94091124822,
3882.66397721879, 0, 4303.72535991141, 8244.5, 8800.72535991141,
1499, 4497, 5500.9851289353, 127415, 2998, 4303.72535991141,
7301.72535991141, 4293.80398671096, 1305.72535991141, 4497, 4197.2,
1499, 2611.45071982281, 11798.7253599114, 6136.90919158361, 7500.764831514,
8618.98038285082, 4309.49019142541, 1499, 2998, 4374.514831514,
11354.7901914254, 4497, 9265.03311184939, 2611.45071982281, 1499,
6905.25470653378, 11018.535674735, 10395.14269894, 5996, 1499,
7495, 4497, 5996, 8994, 4497, 2998, 0, 7495, 10493, 21967.07,
17088.6, 49017.3, 8994, 2998, 4497, 17238.5, 4497, 6745.5, 4497,
5424.96566998893, 17688.2, 4497, 7495, 15289.8, 26982, 7495,
7495, 5996, 8994, 8994, 11992, 7869.76, 9593.6, 1499, 1199.2,
7495, 24161.61, 20986, 9553.19031798766, 20863.81, 32598.1, 39743.88
), .Dim = c(44L, 4L), .Dimnames = list(c("2014-01", "2014-02",
"2014-03", "2014-04", "2014-05", "2014-06", "2014-07", "2014-08",
"2014-09", "2014-10", "2014-11", "2014-12", "2015-01", "2015-02",
"2015-03", "2015-04", "2015-05", "2015-06", "2015-07", "2015-08",
"2015-09", "2015-10", "2015-11", "2015-12", "2016-01", "2016-02",
"2016-03", "2016-04", "2016-05", "2016-06", "2016-07", "2016-08",
"2016-09", "2016-10", "2016-11", "2016-12", "2017-01", "2017-02",
"2017-03", "2017-04", "2017-05", "2017-06", "2017-07", "2017-08"
), c("Australia", "United Kingdom", "Other", "United States")))
# Input types
for (t in types)
{
outcome <- if (t %in% stacked.types) "requires more than one series" else NA
test_that(paste(t, "- unnamed vector input"), {
expect_error(print(Chart(unnamed.vector, type = t)), outcome)
})
test_that(paste(t, "- named vector input"), {
expect_error(print(Chart(named.vector, type = t)), outcome)
})
outcome <- if (t == "Donut")
"The table supplied is two-dimensional and cannot be displayed as a donut chart"
else
NA
test_that(paste(t, "- unnamed matrix input"), {
expect_error(print(Chart(unnamed.matrix, type = t)), outcome)
})
test_that(paste(t, "- named matrix input"), {
expect_error(print(Chart(named.matrix, type = t)), outcome)
})
test_that(paste(t, "- data frame input"), {
expect_error(print(Chart(dat, type = t)), outcome)
})
test_that(paste(t, "- transpose"), {
expect_error(print(Chart(dat, type = t, transpose = TRUE)), outcome)
})
}
# Missing values
test_that("Area - missing", {
expect_warning(print(Chart(missing, type = "Area")), "Missing values have been interpolated or omitted.")
})
test_that("Bar - missing", {
expect_warning(print(Chart(missing, type = "Bar")), "Missing values have been set to zero.")
})
test_that("Column - missing", {
expect_warning(print(Chart(missing, type = "Column")), "Missing values have been set to zero.")
})
test_that("Pie - missing", {
expect_warning(print(Chart(missing, type = "Pie")), "Missing and negative values have been omitted.")
})
for (t in stacked.types)
{
test_that(paste(t, "- single series"), {
expect_error(print(Chart(named.vector, type = t)), "requires more than one series.")
})
}
for (t in stacked.types)
{
test_that(paste(t, "- missing"), {
expect_error(print(suppressWarnings(Chart(missing, type = t)),
"Stacked charts cannot be produced with missing or negative values."))
})
}
for (t in hundred.percent.stacked.types)
{
test_that(paste(t, "- row sum zero"), {
expect_error(print(Chart(row.sum.zero, type = t)),
"100% stacked charts cannot be produced with rows that do not contain positive values.")
})
}
for (t in types)
{
test_that(paste(t, "- duplicate rows"), {
expect_error(print(Chart(duplicate.rows, type = t)),
"Row names of the input table must be unique.")
})
}
for (t in area.or.line.charts)
{
test_that(paste(t, "- numeric labels"), {
expect_error(print(Chart(unnamed.matrix, type = t)), NA)
})
}
test_that("Area - opacity", {
expect_warning(print(Chart(unnamed.matrix, type = "Area", opacity = 1)),
"Displaying this chart with opacity set to 1 will make it difficult to read as some data series may be obscured.")
})
for (t in c("Line", "Pie", "Donut"))
{
test_that(paste(t, "- opacity"), {
expect_warning(print(Chart(named.vector, type = t, opacity = 1)),
"The opacity parameter is only valid for area, bar and column charts.")
})
}
test_that("3D data", {
expect_warning(print(Chart(three.dimensional, type = "Column")),
"The input has more than 2 dimensions, only the first 2 have been displayed.")
})
test_that("Percentage statistics", {
expect_warning(print(Chart(table.with.statistic, type = "Pie")),
paste("The percentage values in the table do not sum to 100%.",
"Consider choosing a different statistic for the table."))
})
test_that("Chart type check", {
expect_error(print(Chart(unnamed.matrix, type = "invalid type")), "The input chart type is not supported.")
})
for (t in c("Line", "Bar", "Column"))
{
test_that(paste(t, "- dates"), {
expect_error(print(Chart(monthly, t)), NA)
})
}
test_that("Array", {
expect_error(Chart(y = arr, type = "Area"), NA)
})
tab6 <- structure(c(14, 51, 46, 34, 62, 45, 21, 96, 61, 45, 85, 60, 46,
62, 66, 101, 89, 81, 137, 75, 80, 120, 40, 78, 108, 40, 58, 25,
17, 50, 1, 3, 16, 2, 34, 13, 327, 327, 327, 327, 327, 327), .Dim = 6:7, statistic = "n", .Dimnames = list(
c("Coca Cola", "Diet Coke", "Coke Zero", "Pepsi", "Pepsi Light",
"Pepsi Max"), c("Hate", "Dislike", "Neither like nor dislike",
"Like", "Love", "Don t Know", "NET")), name = "Q6. Brand Attitude", questions = c("Q6. Brand Attitude",
"SUMMARY"))
test_that("X-axis reversed", {
expect_error(Chart(tab6, type="Line", x.data.reversed = T), NA)
})
test_that("Line of best fit", {
expect_error(print(Chart(acquisitions[,1], fit.type="Smooth", fit.ignore.last=F)), NA)
print(Chart(acquisitions[,1], fit.type="Smooth", fit.ignore.last=T))
xx <- c(1:200 * abs(rnorm(200)),0)
print(Chart(xx, fit.type="Smooth", fit.ignore.last=F))
print(Chart(xx, fit.type="Smooth", fit.ignore.last=T))
})
test_that("Color palette warnings", {
expect_warning(Chart(named.vector, type="Pie", colors="Custom color",
colors.custom.color = "red"), "Only a single color specified")
expect_warning(Chart(named.vector[1:4], type="Pie", colors="Custom palette", colors.custom.palette = "red,orange,abc,blue"), "Invalid color 'abc'")
})
test_that("Annotations", {
a1 <- letters[1:length(named.vector)]
a2 <- matrix(NA, nrow(named.matrix), ncol(named.matrix))
a2[1,1] <- "first entry"
a2[2,3] <- "random"
a2[1,4] <- "etc"
for (type in c("Line", "Area", "Bar", "Column"))
{
expect_error(Chart(named.vector, type=type, annotations=a1), NA)
expect_error(Chart(named.matrix, type=type, annotations=a2), NA)
expect_error(Chart(named.matrix, type=type, annotations=t(a2)))
}
})
test_that("No data", {
z = matrix(1:4,2)[-1:-2, , drop = FALSE]
expect_error(Area(z))
z = matrix(1:4,2)[-1:-4, drop = FALSE]
expect_error(Area(z))
expect_error(Area(list(z)))
z = as.data.frame(matrix(1:4,2))[-1:-2, , drop = FALSE]
expect_error(Area(list(z)))
})
test_that("Data not 'tidy'",
{
Other.List <- list(Normal = rnorm(1000), "Poisson with unit lamda" = rpois(1000, 1), Exponential = rexp(1000))
Other.ListUnequal <- list(Normal = rnorm(20), "Poisson with unit lamda" = rpois(1000, 1))
expect_error(Bar(Other.List), "The data is not in an appropriate format.")
expect_error(Bar(Other.ListUnequal), "The data is not in an appropriate format.")
})
test_that("Ignore rows",
{
xx <- c(A = 1, B = 2, C = 3, Total = 6)
expect_error(Chart(xx, rows.to.ignore = "Total, C"), NA)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.