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, varName="html") {
t <- escapeString(s)
u <- eval(parse(text=paste0("\"", t, "\"")))
if(s!=u) stop("Unable to escape string!")
if(is.null(varName)) varName <- "html"
t <- paste0("\t", varName, " <- \"", t, "\"")
utils::writeClipboard(t)
return(invisible())
}
context("QUICK TABLE TESTS")
test_that("quick table", {
bhmsummary2 <- bhmsummary %>%
mutate(TotalArrivalDelayMins=as.integer(TotalArrivalDelayMinutes)) %>%
mutate(TotalDepartureDelayMins=as.integer(TotalDepartureDelayMinutes)) %>%
select(-TotalArrivalDelayMinutes, -TotalDepartureDelayMinutes)
tbl <- qtbl(head(bhmsummary2), compatibility=list(headerCellsAsTD=TRUE))
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- "Status TOC TrainCategory PowerType SchedSpeedMPH GbttWeekDate GbttMonth Origin Destination TrainCount OnTimeArrivals OnTimeDepartures TotalArrivalDelayMins TotalDepartureDelayMins \n A Arriva Trains Wales Express Passenger DMU 75 2016-11-27 2016-12-01 CRE BHI 2 0 0 8 3 \n A Arriva Trains Wales Express Passenger DMU 75 2016-12-04 2016-12-01 CRE BHI 5 0 2 50 37 \n A Arriva Trains Wales Express Passenger DMU 75 2016-12-11 2016-12-01 CRE BHI 4 0 0 27 15 \n A Arriva Trains Wales Express Passenger DMU 75 2016-12-18 2016-12-01 CRE BHI 5 1 1 12 7 \n A Arriva Trains Wales Express Passenger DMU 75 2016-12-25 2016-12-01 CRE BHI 4 0 2 33 19 \n A Arriva Trains Wales Express Passenger DMU 75 2016-12-25 2016-12-01 HHD BHI 1 0 0 11 9 "
html <- "\n \n | Status | \n TOC | \n TrainCategory | \n PowerType | \n SchedSpeedMPH | \n GbttWeekDate | \n GbttMonth | \n Origin | \n Destination | \n TrainCount | \n OnTimeArrivals | \n OnTimeDepartures | \n TotalArrivalDelayMins | \n TotalDepartureDelayMins | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-11-27 | \n 2016-12-01 | \n CRE | \n BHI | \n 2 | \n 0 | \n 0 | \n 8 | \n 3 | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-12-04 | \n 2016-12-01 | \n CRE | \n BHI | \n 5 | \n 0 | \n 2 | \n 50 | \n 37 | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-12-11 | \n 2016-12-01 | \n CRE | \n BHI | \n 4 | \n 0 | \n 0 | \n 27 | \n 15 | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-12-18 | \n 2016-12-01 | \n CRE | \n BHI | \n 5 | \n 1 | \n 1 | \n 12 | \n 7 | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-12-25 | \n 2016-12-01 | \n CRE | \n BHI | \n 4 | \n 0 | \n 2 | \n 33 | \n 19 | \n
\n \n | A | \n Arriva Trains Wales | \n Express Passenger | \n DMU | \n 75 | \n 2016-12-25 | \n 2016-12-01 | \n HHD | \n BHI | \n 1 | \n 0 | \n 0 | \n 11 | \n 9 | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})
# sample data for following tests
# aggregate the sample data to make a small data frame
library(basictabler)
library(dplyr)
tocsummary <- bhmsummary %>%
group_by(TOC) %>%
summarise(OnTimeArrivals=sum(OnTimeArrivals),
OnTimeDepartures=sum(OnTimeDepartures),
TotalTrains=sum(TrainCount)) %>%
ungroup() %>%
mutate(OnTimeArrivalPercent=OnTimeArrivals/TotalTrains*100,
OnTimeDeparturePercent=OnTimeDepartures/TotalTrains*100) %>%
arrange(TOC)
test_that("quick table with simple theming", {
# column formats
columnFormats=list(NULL, list(big.mark=","), list(big.mark=","), list(big.mark=","), "%.1f", "%.1f")
# simple theme
simpleBlueTheme <- list(
fontName="Verdana, Arial",
headerBackgroundColor = "rgb(68, 114, 196)",
headerColor = "rgb(255, 255, 255)",
cellBackgroundColor = "rgb(255, 255, 255)",
cellColor = "rgb(0, 0, 0)",
totalBackgroundColor = "rgb(186, 202, 233)",
totalColor = "rgb(0, 0, 0)",
borderColor = "rgb(48, 84, 150)"
)
# headings in red text, cells in light gray
tbl <- qtbl(tocsummary, firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("TOC", "On-Time Arrivals", "On-Time Departures",
"Total Trains", "On-Time Arrival %", "On-Time Departure %"),
columnFormats=columnFormats, theme=simpleBlueTheme,
compatibility=list(headerCellsAsTD=TRUE))
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- " TOC On-Time Arrivals On-Time Departures Total Trains On-Time Arrival % On-Time Departure % \nArriva Trains Wales 1,404 2,348 3,909 35.9 60.1 \n CrossCountry 5,799 10,246 22,928 25.3 44.7 \n London Midland 13,036 17,184 48,279 27.0 35.6 \n Virgin Trains 3,289 3,864 8,594 38.3 45.0 "
html <- "\n \n | TOC | \n On-Time Arrivals | \n On-Time Departures | \n Total Trains | \n On-Time Arrival % | \n On-Time Departure % | \n
\n \n \n | 1,404 | \n 2,348 | \n 3,909 | \n 35.9 | \n 60.1 | \n
\n \n \n | 5,799 | \n 10,246 | \n 22,928 | \n 25.3 | \n 44.7 | \n
\n \n \n | 13,036 | \n 17,184 | \n 48,279 | \n 27.0 | \n 35.6 | \n
\n \n \n | 3,289 | \n 3,864 | \n 8,594 | \n 38.3 | \n 45.0 | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})
test_that("quick table with cell type styling", {
# column formats
columnFormats=list(NULL, list(big.mark=","), list(big.mark=","), list(big.mark=","), "%.1f", "%.1f")
# create the table
tbl <- qtbl(tocsummary, firstColumnAsRowHeaders=FALSE,
explicitColumnHeaders=c("TOC", "On-Time Arrivals", "On-Time Departures",
"Total Trains", "On-Time Arrival %", "On-Time Departure %"),
columnFormats=columnFormats,
tableStyle=list("border-color"="maroon"),
headingStyle=list("color"="cornsilk", "background-color"="maroon",
"font-style"="italic", "border-color"="maroon"),
cellStyle=list("color"="maroon", "background-color"="cornsilk",
"border-color"="maroon"),
compatibility=list(headerCellsAsTD=TRUE))
# set column alignment of first column
tbl$setStyling(2, 1, 5, 1, declarations=list("text-align"="left"))
# tbl$renderTable()
# prepStr(tbl$print(asCharacter=TRUE), "str")
# prepStr(as.character(tbl$getHtml()))
str <- " TOC On-Time Arrivals On-Time Departures Total Trains On-Time Arrival % On-Time Departure % \nArriva Trains Wales 1,404 2,348 3,909 35.9 60.1 \n CrossCountry 5,799 10,246 22,928 25.3 44.7 \n London Midland 13,036 17,184 48,279 27.0 35.6 \n Virgin Trains 3,289 3,864 8,594 38.3 45.0 "
html <- "\n \n | TOC | \n On-Time Arrivals | \n On-Time Departures | \n Total Trains | \n On-Time Arrival % | \n On-Time Departure % | \n
\n \n | Arriva Trains Wales | \n 1,404 | \n 2,348 | \n 3,909 | \n 35.9 | \n 60.1 | \n
\n \n | CrossCountry | \n 5,799 | \n 10,246 | \n 22,928 | \n 25.3 | \n 44.7 | \n
\n \n | London Midland | \n 13,036 | \n 17,184 | \n 48,279 | \n 27.0 | \n 35.6 | \n
\n \n | Virgin Trains | \n 3,289 | \n 3,864 | \n 8,594 | \n 38.3 | \n 45.0 | \n
\n
"
expect_identical(tbl$print(asCharacter=TRUE), str)
expect_identical(as.character(tbl$getHtml()), html)
})