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("GET CELLS TESTS")
test_that("getting a mixture of rows, columns and cells when `specifyCellsAsList=TRUE`", {
# 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)
# formatting values (explained in the introduction vignette)
columnFormats=list(NULL, list(big.mark=","), list(big.mark=","), list(big.mark=","), "%.1f", "%.1f")
# create the table
tbl <- BasicTable$new(compatibility=list(headerCellsAsTD=TRUE))
tbl$addData(tocsummary, firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("TOC", "On-Time Arrivals", "On-Time Departures",
"Total Trains", "On-Time Arrival %", "On-Time Departure %"),
columnFormats=columnFormats)
# get the cells and apply styling
highlight <- tbl$createInlineStyle(declarations=list("background-color"="#FFCC66"))
cells <- tbl$getCells(specifyCellsAsList=TRUE, rowNumbers=2, columnNumbers=4, cellCoordinates=list(c(5, 6)))
lst <- lapply(cells, function(cell) {cell$style <- highlight})
# 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("getting a mixture of rows, columns and cells when `specifyCellsAsList=FALSE`", {
# 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)
# formatting values (explained in the introduction vignette)
columnFormats=list(NULL, list(big.mark=","), list(big.mark=","), list(big.mark=","), "%.1f", "%.1f")
# create the table
tbl <- BasicTable$new(compatibility=list(headerCellsAsTD=TRUE))
tbl$addData(tocsummary, firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("TOC", "On-Time Arrivals", "On-Time Departures",
"Total Trains", "On-Time Arrival %", "On-Time Departure %"),
columnFormats=columnFormats)
# get the cells and apply styling
highlight <- tbl$createInlineStyle(declarations=list("background-color"="#00FF00"))
cells <- tbl$getCells(specifyCellsAsList=FALSE, rowNumbers=c(2, NA, 5), columnNumbers=c(NA, 4, 6))
lst <- lapply(cells, function(cell) {cell$style <- highlight})
# 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("getting a mixture of rows, columns and cells when `matchMode=\"Combinations\"` and specifyCellsAsList=TRUE`", {
# 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)
# formatting values (explained in the introduction vignette)
columnFormats=list(NULL, list(big.mark=","), list(big.mark=","), list(big.mark=","), "%.1f", "%.1f")
# create the table
tbl <- BasicTable$new(compatibility=list(headerCellsAsTD=TRUE))
tbl$addData(tocsummary, firstColumnAsRowHeaders=TRUE,
explicitColumnHeaders=c("TOC", "On-Time Arrivals", "On-Time Departures",
"Total Trains", "On-Time Arrival %", "On-Time Departure %"),
columnFormats=columnFormats)
# get the cells and apply styling
highlight <- tbl$createInlineStyle(declarations=list("background-color"="#FFCC66"))
cells <- tbl$getCells(specifyCellsAsList=TRUE, rowNumbers=2, columnNumbers=4, cellCoordinates=list(c(5, 6)), matchMode="combinations")
lst <- lapply(cells, function(cell) {cell$style <- highlight})
# 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)
})