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) } context("EXPORT TESTS") scenarios <- testScenarios("export tests: as Matrix (without row headings)") 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(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE, noDataGroupNBSP=TRUE)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE) # sum(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE), na.rm=TRUE) # mean(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE), na.rm=TRUE) # min(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE), na.rm=TRUE) # max(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE), na.rm=TRUE) # prepStr(paste(as.character(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE)), sep=" ", collapse=" ")) text <- "3079 22133 5638 2137 32987 NA NA 8849 6457 15306 NA 732 NA NA 732 3079 22865 14487 8594 49025 830 63 5591 NA 6484 NA NA 28201 NA 28201 830 63 33792 NA 34685 3909 22928 48279 8594 83710" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260) expect_equal(mean(pt$cells$asMatrix(), na.rm=TRUE), 16742) expect_equal(min(pt$cells$asMatrix(), na.rm=TRUE), 63) expect_equal(max(pt$cells$asMatrix(), na.rm=TRUE), 83710) expect_identical(paste(as.character(pt$asMatrix(includeHeaders=FALSE, rawValue=TRUE)), sep=" ", collapse=" "), text) }) } scenarios <- testScenarios("export tests: as Matrix (with row headings)") 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(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE, noDataGroupNBSP=TRUE)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # prepStr(paste(as.character(pt$asMatrix(includeHeaders=TRUE)), sep=" ", collapse=" ")) text <- " Arriva Trains Wales CrossCountry London Midland Virgin Trains Total Express Passenger DMU 3079 22133 5638 2137 32987 EMU 8849 6457 15306 HST 732 732 Total 3079 22865 14487 8594 49025 Ordinary Passenger DMU 830 63 5591 6484 EMU 28201 28201 Total 830 63 33792 34685 Total 3909 22928 48279 8594 83710" expect_identical(paste(as.character(pt$asMatrix(includeHeaders=TRUE)), sep=" ", collapse=" "), text) }) } scenarios <- testScenarios("export tests: as Data Matrix") 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(pivottabler) data <- filter(bhmtrains, (Status=="A")|(Status=="C")) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(noDataGroupNBSP=TRUE)) pt$addData(data) pt$addColumnDataGroups("PowerType", addTotal=FALSE) pt$addColumnDataGroups("Status", addTotal=FALSE) pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # pt$renderPivot() # pt$asDataMatrix(separator="|") # prepStr(paste(capture.output(print(pt$asDataMatrix(separator="|"))), sep=" ", collapse=" ")) text <- " DMU|A DMU|C EMU|A EMU|C HST|A HST|C Arriva Trains Wales 3833 74 NA NA NA NA CrossCountry 21621 548 NA NA 709 23 London Midland 11054 168 35930 1082 NA NA Virgin Trains 2028 107 6331 119 NA NA Total 38536 897 42261 1201 709 23" expect_identical(paste(capture.output(print(pt$asDataMatrix(separator="|"))), sep=" ", collapse=" "), text) }) } scenarios <- testScenarios("export tests: as Data Frame") 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(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE, noDataGroupNBSP=TRUE)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # sum(pt$asDataFrame(), na.rm=TRUE) # prepStr(paste(as.character(pt$asDataFrame()), sep=" ", collapse=" ")) # prepStr(paste(as.character(pt$asDataFrame(stringsAsFactors=FALSE, rowGroupsAsColumns=TRUE)), sep=" ", collapse=" ")) text <- "c(3079, 22133, 5638, 2137, 32987) c(NA, NA, 8849, 6457, 15306) c(NA, 732, NA, NA, 732) c(3079, 22865, 14487, 8594, 49025) c(830, 63, 5591, NA, 6484) c(NA, NA, 28201, NA, 28201) c(830, 63, 33792, NA, 34685) c(3909, 22928, 48279, 8594, 83710)" text2 <- "c(\"Arriva Trains Wales\", \"CrossCountry\", \"London Midland\", \"Virgin Trains\", \"Total\") c(3079, 22133, 5638, 2137, 32987) c(NA, NA, 8849, 6457, 15306) c(NA, 732, NA, NA, 732) c(3079, 22865, 14487, 8594, 49025) c(830, 63, 5591, NA, 6484) c(NA, NA, 28201, NA, 28201) c(830, 63, 33792, NA, 34685) c(3909, 22928, 48279, 8594, 83710)" expect_equal(sum(pt$asDataFrame(), na.rm=TRUE), 502260) expect_identical(paste(as.character(pt$asDataFrame()), sep=" ", collapse=" "), text) expect_identical(paste(as.character(pt$asDataFrame(stringsAsFactors=FALSE, rowGroupsAsColumns=TRUE)), sep=" ", collapse=" "), text2) }) } scenarios <- testScenarios("export tests: as Tidy Data Frame") 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(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE, noDataGroupNBSP=TRUE)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # sum(pt$asTidyDataFrame()$rawValue, na.rm=TRUE) # prepStr(paste(as.character(pt$asTidyDataFrame(stringsAsFactors=FALSE)), sep=" ", collapse=" ")) text <- paste0("c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5) c(1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8) c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE) c(\"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \n\"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \"Total\", \"Total\", \"Total\", \"Total\", \"Total\", \"Total\", \"Total\", \"Total\") c(\"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Total\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Total\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Total\", \"Express Passenger\", \"Express Passenger\", \n\"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Total\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Total\") c(\"DMU\", \"EMU\", \"HST\", \"Total\", \"DMU\", \"EMU\", \"Total\", \"\", \"DMU\", \"EMU\", \"HST\", \"Total\", \"DMU\", \"EMU\", \"Total\", \"\", \"DMU\", \"EMU\", \"HST\", \"Total\", \"DMU\", \"EMU\", \"Total\", \"\", \"DMU\", \"EMU\", \"HST\", \"Total\", \"DMU\", \"EMU\", \"Total\", \"\", \"DMU\", \"EMU\", \"HST\", \"Total\", \"DMU\", \"EMU\", \"Total\", \"\") c(\"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"Arriva Trains Wales\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"CrossCountry\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"London Midland\", \"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \n\"Virgin Trains\", \"Virgin Trains\", ", "\"Virgin Trains\", \"Virgin Trains\", \"Virgin Trains\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\") c(\"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"NA\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"NA\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"NA\", \"Express Passenger\", \"Express Passenger\", \n\"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"NA\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Express Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"Ordinary Passenger\", \"NA\") c(\"DMU\", \"EMU\", \"HST\", \"NA\", \"DMU\", \"EMU\", \"NA\", \"NA\", \"DMU\", \"EMU\", \"HST\", \"NA\", \"DMU\", \"EMU\", \"NA\", \"NA\", \"DMU\", \"EMU\", \"HST\", \"NA\", \"DMU\", \"EMU\", \"NA\", \"NA\", \"DMU\", \"EMU\", \"HST\", \"NA\", \"DMU\", \"EMU\", \"NA\", \"NA\", \"DMU\", \"EMU\", \"HST\", \"NA\", \"DMU\", \"EMU\", \"NA\", \"NA\") c(\"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \n\"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\", \"TotalTrains\") c(\"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\", \"default\") c(3079, NA, NA, 3079, 830, NA, 830, 3909, 22133, NA, 732, 22865, 63, NA, 63, 22928, 5638, 8849, NA, 14487, 5591, 28201, 33792, 48279, 2137, 6457, NA, 8594, NA, NA, NA, 8594, 32987, 15306, 732, 49025, 6484, 28201, 34685, 83710) c(\"3079\", NA, NA, \"3079\", \"830\", NA, \"830\", \"3909\", \"22133\", NA, \"732\", \"22865\", \"63\", NA, \"63\", \"22928\", \"5638\", \"8849\", NA, \"14487\", \"5591\", \"28201\", \"33792\", \"48279\", \"2137\", \"6457\", NA, \"8594\", NA, NA, NA, \"8594\", \"32987\", \"15306\", \"732\", \"49025\", \"6484\", \"28201\", \"34685\", \"83710\")") expect_equal(sum(pt$asTidyDataFrame()$rawValue, na.rm=TRUE), 502260) expect_identical(paste(as.character(pt$asTidyDataFrame(stringsAsFactors=FALSE)), sep=" ", collapse=" "), text) }) } scenarios <- testScenarios("export tests: NA, NaN, -Inf and Inf") 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, { someData <- data.frame(Colour=c("Red", "Yellow", "Green", "Blue", "White", "Black"), SomeNumber=c(1, 2, NA, NaN, -Inf, Inf)) library(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(someData) pt$addRowDataGroups("Colour") pt$defineCalculation(calculationName="Total", summariseExpression="sum(SomeNumber)") pt$evaluatePivot() # pt$renderPivot() # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Total
BlackInf
BlueNaN
GreenNA
Red1
White-Inf
Yellow2
TotalNA
" expect_identical(as.character(pt$getHtml()), html) # pt$renderPivot(exportOptions=list(skipNegInf=TRUE, skipPosInf=TRUE, skipNA=TRUE, skipNaN=TRUE)) # prepStr(as.character(pt$getHtml(exportOptions=list(skipNegInf=TRUE, skipPosInf=TRUE, skipNA=TRUE, skipNaN=TRUE)))) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Total
Black
Blue
Green
Red1
White
Yellow2
Total
" expect_identical(as.character(pt$getHtml(exportOptions=list(skipNegInf=TRUE, skipPosInf=TRUE, skipNA=TRUE, skipNaN=TRUE))), html) # pt$renderPivot(exportOptions=list(exportNegInfAs="-Infinity", exportPosInfAs="Infinity", # exportNAAs="Nothing", exportNaNAs="Not a Number")) # prepStr(as.character(pt$getHtml(exportOptions=list(exportNegInfAs="-Infinity", exportPosInfAs="Infinity", # exportNAAs="Nothing", exportNaNAs="Not a Number")))) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Total
BlackInfinity
BlueNot a Number
GreenNothing
Red1
White-Infinity
Yellow2
TotalNothing
" expect_identical(as.character(pt$getHtml(exportOptions=list(exportNegInfAs="-Infinity", exportPosInfAs="Infinity", exportNAAs="Nothing", exportNaNAs="Not a Number"))), html) }) } basictblrversion <- utils::packageDescription("basictabler")$Version if (requireNamespace("lubridate", quietly = TRUE) && requireNamespace("basictabler", quietly = TRUE) && (numeric_version(basictblrversion) >= numeric_version("0.2.0"))) { scenarios <- testScenarios("export tests: as basictable") 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(pivottabler) library(basictabler) library(dplyr) library(lubridate) trains <- mutate(bhmtrains, GbttDate=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival), GbttMonth=make_date(year=year(GbttDate), month=month(GbttDate), day=1)) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(noDataGroupNBSP=TRUE)) pt$addData(trains) pt$addColumnDataGroups("GbttMonth", dataFormat=list(format="%B %Y")) pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$evaluatePivot() # convert the pivot table to a basic table, insert a new row, merge cells and highlight bt <- pt$asBasicTable() bt$cells$insertRow(5) bt$cells$setCell(5, 2, rawValue="The values below are significantly higher than expected.", styleDeclarations=list("text-align"="left", "background-color"="yellow", "font-weight"="bold", "font-style"="italic")) bt$mergeCells(rFrom=5, cFrom=2, rSpan=1, cSpan=13) bt$setStyling(rFrom=6, cFrom=2, rTo=6, cTo=14, declarations=list("text-align"="left", "background-color"="yellow")) # bt$renderTable() # prepStr(as.character(bt$getHtml())) # prepStr(as.character(bt$getCss())) if (numeric_version(basictblrversion) >= numeric_version("0.3.0")) { html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 December 2016January 2017February 2017Total
DMUEMUHSTTotalDMUEMUHSTTotalDMUEMUHSTTotal
Arriva Trains Wales1291129114021402121612163909
CrossCountry73142367550777725680337105240734522928
The values below are significantly higher than expected.
London Midland36351196715602396713062170293627120211564848279
Virgin Trains7402137287772822763004669204427138594
Total12980141042362732013874153382562946812617140652402692283710
" css <- ".Table {display: table; border-collapse: collapse; }\r\n.ColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.RowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.Cell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n.OutlineColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.OutlineRowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.OutlineCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; background-color: #F8F8F8; font-weight: bold; }\r\n.Total {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n" } else { html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
December 2016January 2017February 2017Total
DMUEMUHSTTotalDMUEMUHSTTotalDMUEMUHSTTotal
Arriva Trains Wales1291129114021402121612163909
CrossCountry73142367550777725680337105240734522928
The values below are significantly higher than expected.
London Midland36351196715602396713062170293627120211564848279
Virgin Trains7402137287772822763004669204427138594
Total12980141042362732013874153382562946812617140652402692283710
" css <- ".Table {display: table; border-collapse: collapse; }\r\n.ColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.RowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.Cell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n.OutlineColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.OutlineRowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.OutlineCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; background-color: #F8F8F8; font-weight: bold; }\r\n.Total {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n" } expect_identical(as.character(bt$getHtml()), html) expect_identical(bt$getCss(), css) }) } } basictblrversion <- utils::packageDescription("basictabler")$Version if (requireNamespace("basictabler", quietly = TRUE) && (numeric_version(basictblrversion) >= numeric_version("0.3.0"))) { scenarios <- testScenarios("export tests: same html for pivottable and basictable") 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(pivottabler) library(basictabler) # html is only the same if the compatibility option is set pt <- qpvt(bhmtrains, "TOC", "TrainCategory", "n()", compatibility=list(noDataGroupNBSP=TRUE)) pthtml <- as.character(pt$getHtml()) ptcss <- as.character(pt$getCss()) bt <- pt$asBasicTable() bthtml <- as.character(bt$getHtml()) btcss <- as.character(bt$getCss()) # prepStr(as.character(pthtml)) # prepStr(as.character(ptcss)) # prepStr(as.character(bthtml)) # prepStr(as.character(btcss)) exppthtml <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales30798303909
CrossCountry228656322928
London Midland144873379248279
Virgin Trains85948594
Total490253468583710
" expptcss <- ".Table {display: table; border-collapse: collapse; }\r\n.ColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.RowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.Cell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n.OutlineColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.OutlineRowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.OutlineCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; background-color: #F8F8F8; font-weight: bold; }\r\n.Total {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n" expbthtml <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales30798303909
CrossCountry228656322928
London Midland144873379248279
Virgin Trains85948594
Total490253468583710
" expbtcss <- ".Table {display: table; border-collapse: collapse; }\r\n.ColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.RowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.Cell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n.OutlineColumnHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px; text-align: center; }\r\n.OutlineRowHeader {font-family: Arial; font-size: 0.75em; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; padding: 2px 8px 2px 2px; text-align: left; }\r\n.OutlineCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; background-color: #F8F8F8; font-weight: bold; }\r\n.Total {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; text-align: right; }\r\n" htmlMatch <- pthtml==bthtml cssMatch <- ptcss==btcss expect_identical(pthtml, exppthtml) expect_identical(ptcss, expptcss) expect_identical(bthtml, expbthtml) expect_identical(btcss, expbtcss) expect_identical(htmlMatch, TRUE) expect_identical(cssMatch, TRUE) }) } } basictblrversion <- utils::packageDescription("basictabler")$Version if (requireNamespace("lubridate", quietly = TRUE) && requireNamespace("basictabler", quietly = TRUE) && (numeric_version(basictblrversion) >= numeric_version("0.2.0"))) { scenarios <- testScenarios("export tests: basictable with row group headings") 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) 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)) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(noDataGroupNBSP=TRUE)) pt$addData(trains) pt$addColumnDataGroups("GbttMonth", dataFormat=list(format="%B %Y")) pt$addColumnDataGroups("PowerType") pt$addRowDataGroups("TOC", header="Train Company", addTotal=FALSE) pt$addRowDataGroups("TrainCategory", header="Train Category", addTotal=FALSE) pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction) pt$theme <- getStandardTableTheme(pt) pt$evaluatePivot() bt <- pt$asBasicTable(showRowGroupHeaders=TRUE) # bt$renderTable() # prepStr(as.character(bt$getHtml())) # prepStr(as.character(bt$getCss())) if (numeric_version(basictblrversion) >= numeric_version("0.3.0")) { html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
Train CompanyTrain CategoryJanuary 2017February 2017Total
DMUEMUHSTTotalDMUEMUHSTTotal
Arriva Trains WalesExpress Passenger108810889749742062
Ordinary Passenger314314242242556
CrossCountryExpress Passenger775525680117085240732515336
Ordinary Passenger2222202042
London MidlandExpress Passenger1956310850641793287946729736
Ordinary Passenger2011995411965183491421097622941
Virgin TrainsExpress Passenger72822763004669204427135717
" css <- ".Table {display: table; border-collapse: collapse; }\r\n.LeftColumnHeader {font-family: Arial; font-size: 0.75em; padding: 2px; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; text-align: left; }\r\n.CentreColumnHeader {font-family: Arial; font-size: 0.75em; padding: 2px; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; text-align: center; }\r\n.LeftCell {font-family: Arial; font-size: 0.75em; padding: 2px 8px 2px 2px; border: 1px solid lightgray; vertical-align: middle; font-weight: normal; text-align: left; }\r\n.RightCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; font-weight: normal; text-align: right; }\r\n.OutlineCentreColumnHeader {font-family: Arial; font-size: 0.75em; padding: 2px; border: 1px solid lightgray; vertical-align: middle; font-weight: bold; background-color: #F2F2F2; text-align: center; }\r\n.OutlineLeftCell {font-family: Arial; font-size: 0.75em; padding: 2px 8px 2px 2px; border: 1px solid lightgray; vertical-align: middle; font-weight: normal; text-align: left; }\r\n.OutlineRightCell {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; font-weight: normal; text-align: right; }\r\n.Total {font-family: Arial; font-size: 0.75em; padding: 2px 2px 2px 8px; border: 1px solid lightgray; vertical-align: middle; font-weight: normal; text-align: right; }\r\n" expect_identical(as.character(bt$getHtml()), html) expect_identical(bt$getCss(), css) } else { # ignore this test for versions < 0.3.0 expect_identical(1, 1) } }) } }