library(testthat)
# most common expectations:
# equality: expect_equal() and expect_identical()
# regexp: expect_match()
# catch-all: expect_true() and expect_false()
# console output: expect_output()
# messages: expect_message()
# warning: expect_warning()
# errors: expect_error()
escapeString <- function(s) {
t <- gsub("(\\\\)", "\\\\\\\\", s)
t <- gsub("(\n)", "\\\\n", t)
t <- gsub("(\r)", "\\\\r", t)
t <- gsub("(\")", "\\\\\"", t)
return(t)
}
prepStr <- function(s) {
t <- escapeString(s)
u <- eval(parse(text=paste0("\"", t, "\"")))
if(s!=u) stop("Unable to escape string!")
t <- paste0("\thtml <- \"", t, "\"")
utils::writeClipboard(t)
return(invisible())
}
evaluationMode <- "sequential"
processingLibrary <- "dplyr"
description <- "test: sequential dplyr"
countFunction <- "n()"
isDevelopmentVersion <- (length(strsplit(packageDescription("pivottabler")$Version, "\\.")[[1]]) > 3)
testScenarios <- function(description="test", releaseEvaluationMode="batch", releaseProcessingLibrary="dplyr", runAllForReleaseVersion=FALSE) {
isDevelopmentVersion <- (length(strsplit(packageDescription("pivottabler")$Version, "\\.")[[1]]) > 3)
if(isDevelopmentVersion||runAllForReleaseVersion) {
evaluationModes <- c("sequential", "batch")
processingLibraries <- c("dplyr", "data.table")
}
else {
evaluationModes <- releaseEvaluationMode
processingLibraries <- releaseProcessingLibrary
}
testCount <- length(evaluationModes)*length(processingLibraries)
c1 <- character(testCount)
c2 <- character(testCount)
c3 <- character(testCount)
c4 <- character(testCount)
testCount <- 0
for(evaluationMode in evaluationModes)
for(processingLibrary in processingLibraries) {
testCount <- testCount + 1
c1[testCount] <- evaluationMode
c2[testCount] <- processingLibrary
c3[testCount] <- paste0(description, ": ", evaluationMode, " ", processingLibrary)
c4[testCount] <- ifelse(processingLibrary=="data.table", ".N", "n()")
}
df <- data.frame(evaluationMode=c1, processingLibrary=c2, description=c3, countFunction=c4, stringsAsFactors=FALSE)
return(df)
}
# Test data
library(dplyr)
library(lubridate)
library(pivottabler)
trains <- mutate(bhmtrains,
GbttDate=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival),
GbttMonth=make_date(year=year(GbttDate), month=month(GbttDate), day=1))
trains <- filter(trains, GbttMonth>=make_date(year=2017, month=1, day=1))
context("ROW GROUP HEADER BASIC LAYOUT TESTS")
scenarios <- testScenarios("Row group header basic layout test: One group only")
for(i in 1:nrow(scenarios)) {
if(!isDevelopmentVersion) break
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode)
pt$addData(trains)
pt$addRowDataGroups("TOC", header="Train Company", addTotal=FALSE)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n | \n
\n \n | Arriva Trains Wales | \n | \n
\n \n | CrossCountry | \n | \n
\n \n | London Midland | \n | \n
\n \n | Virgin Trains | \n | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 0)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}
scenarios <- testScenarios("Row group header basic layout test: Two row groups only")
for(i in 1:nrow(scenarios)) {
if(!isDevelopmentVersion) break
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(noDataGroupNBSP=TRUE))
pt$addData(trains)
pt$addRowDataGroups("TOC", header="Train Company", addTotal=FALSE)
pt$addRowDataGroups("TrainCategory", header="Train Category", addTotal=FALSE)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n Train Category | \n | \n
\n \n | Arriva Trains Wales | \n Express Passenger | \n | \n
\n \n | Ordinary Passenger | \n | \n
\n \n | CrossCountry | \n Express Passenger | \n | \n
\n \n | Ordinary Passenger | \n | \n
\n \n | London Midland | \n Express Passenger | \n | \n
\n \n | Ordinary Passenger | \n | \n
\n \n | Virgin Trains | \n Express Passenger | \n | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 0)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}
scenarios <- testScenarios("Row group header basic layout test: One row group and calculation")
for(i in 1:nrow(scenarios)) {
if(!isDevelopmentVersion) break
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode)
pt$addData(trains)
pt$addRowDataGroups("TOC", header="Train Company")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n TotalTrains | \n
\n \n | Arriva Trains Wales | \n 2618 | \n
\n \n | CrossCountry | \n 15378 | \n
\n \n | London Midland | \n 32677 | \n
\n \n | Virgin Trains | \n 5717 | \n
\n \n | Total | \n 56390 | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 112780)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}
scenarios <- testScenarios("Row group header basic layout test: Two row groups and calculation")
for(i in 1:nrow(scenarios)) {
if(!isDevelopmentVersion) break
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(noDataGroupNBSP=TRUE))
pt$addData(trains)
pt$addRowDataGroups("TOC", header="Train Company")
pt$addRowDataGroups("TrainCategory", header="Train Category", addTotal=FALSE)
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n Train Category | \n TotalTrains | \n
\n \n | Arriva Trains Wales | \n Express Passenger | \n 2062 | \n
\n \n | Ordinary Passenger | \n 556 | \n
\n \n | CrossCountry | \n Express Passenger | \n 15336 | \n
\n \n | Ordinary Passenger | \n 42 | \n
\n \n | London Midland | \n Express Passenger | \n 9736 | \n
\n \n | Ordinary Passenger | \n 22941 | \n
\n \n | Virgin Trains | \n Express Passenger | \n 5717 | \n
\n \n | Total | \n | \n 56390 | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 112780)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}
scenarios <- testScenarios("Row group header basic layout test: Row and column only")
for(i in 1:nrow(scenarios)) {
if(!isDevelopmentVersion) break
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode)
pt$addData(trains)
pt$addColumnDataGroups("GbttMonth", dataFormat=list(format="%B %Y"))
pt$addRowDataGroups("TOC", header="Train Company", addTotal=FALSE)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n January 2017 | \n February 2017 | \n Total | \n
\n \n | Arriva Trains Wales | \n | \n | \n | \n
\n \n | CrossCountry | \n | \n | \n | \n
\n \n | London Midland | \n | \n | \n | \n
\n \n | Virgin Trains | \n | \n | \n | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 0)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}
scenarios <- testScenarios("Row group header basic layout test: Row, column and calculation")
for(i in 1:nrow(scenarios)) {
evaluationMode <- scenarios$evaluationMode[i]
processingLibrary <- scenarios$processingLibrary[i]
description <- scenarios$description[i]
countFunction <- scenarios$countFunction[i]
test_that(description, {
skip_on_cran()
library(dplyr)
library(lubridate)
library(pivottabler)
pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode)
pt$addData(trains)
pt$addColumnDataGroups("GbttMonth", dataFormat=list(format="%B %Y"))
pt$addRowDataGroups("TOC", header="Train Company")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
pt$theme <- getStandardTableTheme(pt)
pt$evaluatePivot()
# pt$renderPivot(showRowGroupHeaders=TRUE)
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml(showRowGroupHeaders=TRUE)))
html <- "\n \n | Train Company | \n January 2017 | \n February 2017 | \n Total | \n
\n \n | Arriva Trains Wales | \n 1402 | \n 1216 | \n 2618 | \n
\n \n | CrossCountry | \n 8033 | \n 7345 | \n 15378 | \n
\n \n | London Midland | \n 17029 | \n 15648 | \n 32677 | \n
\n \n | Virgin Trains | \n 3004 | \n 2713 | \n 5717 | \n
\n \n | Total | \n 29468 | \n 26922 | \n 56390 | \n
\n
"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 225560)
expect_identical(as.character(pt$getHtml(showRowGroupHeaders=TRUE)), html)
})
}