tests/testthat/test-B-15-findGrouptests.R
In cbailiss/pivottabler: Create Pivot Tables
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("FIND GROUP TESTS")
scenarios <- testScenarios("find groups tests: simple: variableNames")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: variableValues")
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, {
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableValues=list("PowerType"=c("DMU", "HST")))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: exclude totals")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory", totals="exclude")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: only totals")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory", totals="only")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 1)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: includeDescendantGroups")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(
variableValues=list("TrainCategory"="Ordinary Passenger"),
includeDescendantGroup=TRUE)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 4)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: variableNames")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableNames=c("TrainCategory", "PowerType"))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 8)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: variableValues")
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, {
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableValues=list("TrainCategory"="Express Passenger", "PowerType"=c("DMU", "HST")))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: specific sub total")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableValues=list("TrainCategory"="Express Passenger", "PowerType"="**"))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 1)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: atLevels")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(atLevels=2)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 8)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: minChildCount")
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$addRowDataGroups("TOC")
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findRowDataGroups(minChildCount=3)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\">Arriva Trains Wales</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">CrossCountry</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">London Midland</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">Virgin Trains</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: maxChildCount")
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$addRowDataGroups("TOC")
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findRowDataGroups(atLevels=1, maxChildCount=2)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"2\">Arriva Trains Wales</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">CrossCountry</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">London Midland</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">Virgin Trains</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: outline groups")
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$addRowDataGroups("TOC", outlineBefore=TRUE)
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
groups <- pt$findRowDataGroups(outlineGroups="only")
pt$setStyling(groups=groups, declarations=list("background-color"="#00FFFF"))
groupCount <- length(groups)
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">Arriva Trains Wales</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">CrossCountry</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">London Midland</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">Virgin Trains</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 4)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: restrict by rows, cols, cells")
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)
pt$addData(bhmtrains)
pt$addColumnDataGroups("TrainCategory")
pt$addColumnDataGroups("PowerType")
pt$addRowDataGroups("TOC")
pt$addRowDataGroups("Status")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
pt$evaluatePivot()
# find the data groups that are related to column 2
grps <- pt$findColumnDataGroups(columnNumbers=2)
pt$setStyling(groups=grps, declarations=list("background-color"="yellow"))
# find the DMU data groups that are related to columns 5 to 8
grps <- pt$findColumnDataGroups(columnNumbers=5:8, variableValues=list("PowerType"="DMU"))
pt$setStyling(groups=grps, declarations=list("background-color"="lightgreen"))
# find a totals data group that is related to the cell at (3, 7)
cells <- pt$getCell(3, 7)
pt$setStyling(cells=cells, declarations=list("background-color"="pink"))
grps <- pt$findColumnDataGroups(variableValues=list("PowerType"="**"), cells=cells)
pt$setStyling(groups=grps, declarations=list("background-color"="pink"))
# find the data groups at the second level in the hierarchy that are related to row 3
grps <- pt$findRowDataGroups(atLevel=2, rowNumbers=3)
pt$setStyling(groups=grps, declarations=list("background-color"="lightcyan"))
# find the data groups related to rows 5 to 10 with Status "A" or "R"
grps <- pt$findRowDataGroups(rowNumbers=5:10, variableValues=list("Status"=c("A", "R")))
pt$setStyling(groups=grps, declarations=list("background-color"="plum"))
# find the data groups related to row 11:13 or cells in the range (12, 4) to (15, 5)
cells <- pt$getCells(rowNumbers=12:15, columnNumbers=4:5, matchMode="combinations")
pt$setStyling(cells=cells, declarations=list("background-color"="palegreen"))
grps <- pt$findRowDataGroups(rowNumbers=11:13, cells=cells)
pt$setStyling(groups=grps, declarations=list("background-color"="palegreen"))
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: yellow; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: yellow; \">EMU</th>\n <th class=\"ColumnHeader\">HST</th>\n <th class=\"ColumnHeader\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: lightgreen; \">DMU</th>\n <th class=\"ColumnHeader\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: pink; \">Total</th>\n <th class=\"ColumnHeader\"> </th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"4\">Arriva Trains Wales</th>\n <th class=\"RowHeader\">A</th>\n <td class=\"Cell\">3018</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">3018</td>\n <td class=\"Cell\">815</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">815</td>\n <td class=\"Total\">3833</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">59</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">59</td>\n <td class=\"Cell\">15</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">15</td>\n <td class=\"Total\">74</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: lightcyan; \">R</th>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: pink; \"></td>\n <td class=\"Total\">2</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">3079</td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">3079</td>\n <td class=\"Total\">830</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">830</td>\n <td class=\"Total\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"4\">CrossCountry</th>\n <th class=\"RowHeader\" style=\"background-color: plum; \">A</th>\n <td class=\"Cell\">21561</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">709</td>\n <td class=\"Total\">22270</td>\n <td class=\"Cell\">60</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">60</td>\n <td class=\"Total\">22330</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">546</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">23</td>\n <td class=\"Total\">569</td>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">2</td>\n <td class=\"Total\">571</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: plum; \">R</th>\n <td class=\"Cell\">26</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">26</td>\n <td class=\"Cell\">1</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">1</td>\n <td class=\"Total\">27</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">22133</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">732</td>\n <td class=\"Total\">22865</td>\n <td class=\"Total\">63</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">63</td>\n <td class=\"Total\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \" rowspan=\"4\">London Midland</th>\n <th class=\"RowHeader\" style=\"background-color: plum; \">A</th>\n <td class=\"Cell\">5534</td>\n <td class=\"Cell\">8599</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">14133</td>\n <td class=\"Cell\">5520</td>\n <td class=\"Cell\">27331</td>\n <td class=\"Total\">32851</td>\n <td class=\"Total\">46984</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">101</td>\n <td class=\"Cell\">235</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">336</td>\n <td class=\"Cell\">67</td>\n <td class=\"Cell\">847</td>\n <td class=\"Total\">914</td>\n <td class=\"Total\">1250</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">R</th>\n <td class=\"Cell\">3</td>\n <td class=\"Cell\">15</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">18</td>\n <td class=\"Cell\">4</td>\n <td class=\"Cell\">23</td>\n <td class=\"Total\">27</td>\n <td class=\"Total\">45</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">Total</th>\n <td class=\"Total\">5638</td>\n <td class=\"Total\">8849</td>\n <td class=\"Total\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">14487</td>\n <td class=\"Total\" style=\"background-color: palegreen; \">5591</td>\n <td class=\"Total\">28201</td>\n <td class=\"Total\">33792</td>\n <td class=\"Total\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \" rowspan=\"4\">Virgin Trains</th>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">A</th>\n <td class=\"Cell\">2028</td>\n <td class=\"Cell\">6331</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">8359</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8359</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">C</th>\n <td class=\"Cell\">107</td>\n <td class=\"Cell\">119</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">226</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">226</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">R</th>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\">7</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">9</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">9</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">2137</td>\n <td class=\"Total\">6457</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8594</td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <th class=\"RowHeader\"> </th>\n <td class=\"Total\">32987</td>\n <td class=\"Total\">15306</td>\n <td class=\"Total\">732</td>\n <td class=\"Total\">49025</td>\n <td class=\"Total\">6484</td>\n <td class=\"Total\">28201</td>\n <td class=\"Total\">34685</td>\n <td class=\"Total\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 753390)
expect_identical(as.character(pt$getHtml()), html)
})
}
cbailiss/pivottabler documentation built on Oct. 14, 2023, 9:38 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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("FIND GROUP TESTS")
scenarios <- testScenarios("find groups tests: simple: variableNames")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: variableValues")
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, {
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableValues=list("PowerType"=c("DMU", "HST")))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: exclude totals")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory", totals="exclude")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: only totals")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(variableNames="TrainCategory", totals="only")
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 1)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: simple: includeDescendantGroups")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#FFFF00"))
groups <- pt$findColumnDataGroups(
variableValues=list("TrainCategory"="Ordinary Passenger"),
includeDescendantGroup=TRUE)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #FFFF00; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 4)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: variableNames")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableNames=c("TrainCategory", "PowerType"))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 8)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: variableValues")
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, {
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableValues=list("TrainCategory"="Express Passenger", "PowerType"=c("DMU", "HST")))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: combinations: specific sub total")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(matchMode="combinations",
variableValues=list("TrainCategory"="Express Passenger", "PowerType"="**"))
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 1)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: atLevels")
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)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findColumnDataGroups(atLevels=2)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"1\"> </th>\n <th class=\"ColumnHeader\" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">HST</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: #00FFFF; \" colspan=\"1\"></th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Arriva Trains Wales</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">CrossCountry</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">London Midland</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Virgin Trains</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">32987</td>\n <td class=\"Cell\">15306</td>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">6484</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 8)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: minChildCount")
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$addRowDataGroups("TOC")
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findRowDataGroups(minChildCount=3)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\">Arriva Trains Wales</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">CrossCountry</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">London Midland</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"3\">Virgin Trains</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 3)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: maxChildCount")
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$addRowDataGroups("TOC")
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
highlight <- PivotStyle$new(pt, "cellHighlight", list("background-color"="#00FFFF"))
groups <- pt$findRowDataGroups(atLevels=1, maxChildCount=2)
groupCount <- lapply(groups, function(grp) {grp$style <- highlight})
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"2\">Arriva Trains Wales</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">CrossCountry</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">London Midland</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\">Virgin Trains</th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 2)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: outline groups")
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$addRowDataGroups("TOC", outlineBefore=TRUE)
pt$addRowDataGroups("PowerType")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
groups <- pt$findRowDataGroups(outlineGroups="only")
pt$setStyling(groups=groups, declarations=list("background-color"="#00FFFF"))
groupCount <- length(groups)
pt$evaluatePivot()
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# length(groups)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" colspan=\"1\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"1\">Total</th>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">Arriva Trains Wales</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">3079</td>\n <td class=\"Cell\">830</td>\n <td class=\"Cell\">3909</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">CrossCountry</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">22133</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22196</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">HST</th>\n <td class=\"Cell\">732</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">732</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">22865</td>\n <td class=\"Cell\">63</td>\n <td class=\"Cell\">22928</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">London Midland</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">5638</td>\n <td class=\"Cell\">5591</td>\n <td class=\"Cell\">11229</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">8849</td>\n <td class=\"Cell\">28201</td>\n <td class=\"Cell\">37050</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">14487</td>\n <td class=\"Cell\">33792</td>\n <td class=\"Cell\">48279</td>\n </tr>\n <tr>\n <th class=\"OutlineRowHeader\" style=\"background-color: #00FFFF; \" rowspan=\"1\" colspan=\"2\">Virgin Trains</th>\n <td class=\"OutlineCell\" colspan=\"3\"> </td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"3\"></th>\n <th class=\"RowHeader\" rowspan=\"1\">DMU</th>\n <td class=\"Cell\">2137</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">2137</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">EMU</th>\n <td class=\"Cell\">6457</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">6457</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <td class=\"Cell\">8594</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"1\">Total</th>\n <th class=\"RowHeader\" rowspan=\"1\"></th>\n <td class=\"Cell\">49025</td>\n <td class=\"Cell\">34685</td>\n <td class=\"Cell\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 502260)
expect_equal(length(groups), 4)
expect_identical(as.character(pt$getHtml()), html)
})
}
scenarios <- testScenarios("find groups tests: restrict by rows, cols, cells")
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)
pt$addData(bhmtrains)
pt$addColumnDataGroups("TrainCategory")
pt$addColumnDataGroups("PowerType")
pt$addRowDataGroups("TOC")
pt$addRowDataGroups("Status")
pt$defineCalculation(calculationName="TotalTrains", summariseExpression=countFunction)
pt$evaluatePivot()
# find the data groups that are related to column 2
grps <- pt$findColumnDataGroups(columnNumbers=2)
pt$setStyling(groups=grps, declarations=list("background-color"="yellow"))
# find the DMU data groups that are related to columns 5 to 8
grps <- pt$findColumnDataGroups(columnNumbers=5:8, variableValues=list("PowerType"="DMU"))
pt$setStyling(groups=grps, declarations=list("background-color"="lightgreen"))
# find a totals data group that is related to the cell at (3, 7)
cells <- pt$getCell(3, 7)
pt$setStyling(cells=cells, declarations=list("background-color"="pink"))
grps <- pt$findColumnDataGroups(variableValues=list("PowerType"="**"), cells=cells)
pt$setStyling(groups=grps, declarations=list("background-color"="pink"))
# find the data groups at the second level in the hierarchy that are related to row 3
grps <- pt$findRowDataGroups(atLevel=2, rowNumbers=3)
pt$setStyling(groups=grps, declarations=list("background-color"="lightcyan"))
# find the data groups related to rows 5 to 10 with Status "A" or "R"
grps <- pt$findRowDataGroups(rowNumbers=5:10, variableValues=list("Status"=c("A", "R")))
pt$setStyling(groups=grps, declarations=list("background-color"="plum"))
# find the data groups related to row 11:13 or cells in the range (12, 4) to (15, 5)
cells <- pt$getCells(rowNumbers=12:15, columnNumbers=4:5, matchMode="combinations")
pt$setStyling(cells=cells, declarations=list("background-color"="palegreen"))
grps <- pt$findRowDataGroups(rowNumbers=11:13, cells=cells)
pt$setStyling(groups=grps, declarations=list("background-color"="palegreen"))
# pt$renderPivot()
# sum(pt$cells$asMatrix(), na.rm=TRUE)
# prepStr(as.character(pt$getHtml()))
html <- "<table class=\"Table\">\n <tr>\n <th class=\"RowHeader\" rowspan=\"2\" colspan=\"2\"> </th>\n <th class=\"ColumnHeader\" style=\"background-color: yellow; \" colspan=\"4\">Express Passenger</th>\n <th class=\"ColumnHeader\" colspan=\"3\">Ordinary Passenger</th>\n <th class=\"ColumnHeader\">Total</th>\n </tr>\n <tr>\n <th class=\"ColumnHeader\">DMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: yellow; \">EMU</th>\n <th class=\"ColumnHeader\">HST</th>\n <th class=\"ColumnHeader\">Total</th>\n <th class=\"ColumnHeader\" style=\"background-color: lightgreen; \">DMU</th>\n <th class=\"ColumnHeader\">EMU</th>\n <th class=\"ColumnHeader\" style=\"background-color: pink; \">Total</th>\n <th class=\"ColumnHeader\"> </th>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"4\">Arriva Trains Wales</th>\n <th class=\"RowHeader\">A</th>\n <td class=\"Cell\">3018</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">3018</td>\n <td class=\"Cell\">815</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">815</td>\n <td class=\"Total\">3833</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">59</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">59</td>\n <td class=\"Cell\">15</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">15</td>\n <td class=\"Total\">74</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: lightcyan; \">R</th>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: pink; \"></td>\n <td class=\"Total\">2</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">3079</td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">3079</td>\n <td class=\"Total\">830</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">830</td>\n <td class=\"Total\">3909</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" rowspan=\"4\">CrossCountry</th>\n <th class=\"RowHeader\" style=\"background-color: plum; \">A</th>\n <td class=\"Cell\">21561</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">709</td>\n <td class=\"Total\">22270</td>\n <td class=\"Cell\">60</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">60</td>\n <td class=\"Total\">22330</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">546</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\">23</td>\n <td class=\"Total\">569</td>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">2</td>\n <td class=\"Total\">571</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: plum; \">R</th>\n <td class=\"Cell\">26</td>\n <td class=\"Cell\"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">26</td>\n <td class=\"Cell\">1</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">1</td>\n <td class=\"Total\">27</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">22133</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">732</td>\n <td class=\"Total\">22865</td>\n <td class=\"Total\">63</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">63</td>\n <td class=\"Total\">22928</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \" rowspan=\"4\">London Midland</th>\n <th class=\"RowHeader\" style=\"background-color: plum; \">A</th>\n <td class=\"Cell\">5534</td>\n <td class=\"Cell\">8599</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">14133</td>\n <td class=\"Cell\">5520</td>\n <td class=\"Cell\">27331</td>\n <td class=\"Total\">32851</td>\n <td class=\"Total\">46984</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">C</th>\n <td class=\"Cell\">101</td>\n <td class=\"Cell\">235</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">336</td>\n <td class=\"Cell\">67</td>\n <td class=\"Cell\">847</td>\n <td class=\"Total\">914</td>\n <td class=\"Total\">1250</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">R</th>\n <td class=\"Cell\">3</td>\n <td class=\"Cell\">15</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\">18</td>\n <td class=\"Cell\">4</td>\n <td class=\"Cell\">23</td>\n <td class=\"Total\">27</td>\n <td class=\"Total\">45</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">Total</th>\n <td class=\"Total\">5638</td>\n <td class=\"Total\">8849</td>\n <td class=\"Total\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">14487</td>\n <td class=\"Total\" style=\"background-color: palegreen; \">5591</td>\n <td class=\"Total\">28201</td>\n <td class=\"Total\">33792</td>\n <td class=\"Total\">48279</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \" rowspan=\"4\">Virgin Trains</th>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">A</th>\n <td class=\"Cell\">2028</td>\n <td class=\"Cell\">6331</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">8359</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8359</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">C</th>\n <td class=\"Cell\">107</td>\n <td class=\"Cell\">119</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">226</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">226</td>\n </tr>\n <tr>\n <th class=\"RowHeader\" style=\"background-color: palegreen; \">R</th>\n <td class=\"Cell\">2</td>\n <td class=\"Cell\">7</td>\n <td class=\"Cell\"></td>\n <td class=\"Total\" style=\"background-color: palegreen; \">9</td>\n <td class=\"Cell\" style=\"background-color: palegreen; \"></td>\n <td class=\"Cell\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">9</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <td class=\"Total\">2137</td>\n <td class=\"Total\">6457</td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8594</td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\"></td>\n <td class=\"Total\">8594</td>\n </tr>\n <tr>\n <th class=\"RowHeader\">Total</th>\n <th class=\"RowHeader\"> </th>\n <td class=\"Total\">32987</td>\n <td class=\"Total\">15306</td>\n <td class=\"Total\">732</td>\n <td class=\"Total\">49025</td>\n <td class=\"Total\">6484</td>\n <td class=\"Total\">28201</td>\n <td class=\"Total\">34685</td>\n <td class=\"Total\">83710</td>\n </tr>\n</table>"
expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 753390)
expect_identical(as.character(pt$getHtml()), html)
})
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.