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("CALCULATION TESTS") if (requireNamespace("lubridate", quietly = TRUE)) { scenarios <- testScenarios("calculation tests: calculate dply summarise") for(i in 1:nrow(scenarios)) { evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { skip_on_cran() library(pivottabler) library(dplyr) library(lubridate) # derive some additional data trains <- mutate(bhmtrains, ArrivalDelta=difftime(ActualArrival, GbttArrival, units="mins"), ArrivalDelay=ifelse(ArrivalDelta<0, 0, ArrivalDelta)) # create the pivot table pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addRowDataGroups("TOC", totalCaption="All TOCs") pt$defineCalculation(calculationName="TotalTrains", caption="Total Trains", summariseExpression=countFunction) pt$defineCalculation(calculationName="MinArrivalDelay", caption="Min Arr. Delay", summariseExpression="min(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="MaxArrivalDelay", caption="Max Arr. Delay", summariseExpression="max(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="MeanArrivalDelay", caption="Mean Arr. Delay", summariseExpression="mean(ArrivalDelay, na.rm=TRUE)", format="%.1f") pt$defineCalculation(calculationName="MedianArrivalDelay", caption="Median Arr. Delay", summariseExpression="median(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="IQRArrivalDelay", caption="Delay IQR", summariseExpression="IQR(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="SDArrivalDelay", caption="Delay Std. Dev.", summariseExpression="sd(ArrivalDelay, na.rm=TRUE)", format="%.1f") pt$evaluatePivot() # pt$renderPivot() # sprintf("%.6f", sum(pt$cells$asMatrix())) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Total TrainsMin Arr. DelayMax Arr. DelayMean Arr. DelayMedian Arr. DelayDelay IQRDelay Std. Dev.
Arriva Trains Wales39090492.3134.3
CrossCountry2292802733.5248.1
London Midland4827901772.3134.2
Virgin Trains859401813.0038.4
All TOCs8371002732.7136.1
" expect_equal(sum(pt$cells$asMatrix()), 168438.858522) expect_identical(as.character(pt$getHtml()), html) }) } } if (requireNamespace("lubridate", quietly = TRUE)) { scenarios <- testScenarios("calculation tests: calculate on rows dply summarise") for(i in 1:nrow(scenarios)) { if(!isDevelopmentVersion) break evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { library(pivottabler) library(dplyr) library(lubridate) # derive some additional data trains <- mutate(bhmtrains, ArrivalDelta=difftime(ActualArrival, GbttArrival, units="mins"), ArrivalDelay=ifelse(ArrivalDelta<0, 0, ArrivalDelta)) # create the pivot table pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TOC", totalCaption="All TOCs") pt$defineCalculation(calculationName="TotalTrains", caption="Total Trains", summariseExpression=countFunction) pt$defineCalculation(calculationName="MinArrivalDelay", caption="Min Arr. Delay", summariseExpression="min(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="MaxArrivalDelay", caption="Max Arr. Delay", summariseExpression="max(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="MeanArrivalDelay", caption="Mean Arr. Delay", summariseExpression="mean(ArrivalDelay, na.rm=TRUE)", format="%.1f") pt$defineCalculation(calculationName="MedianArrivalDelay", caption="Median Arr. Delay", summariseExpression="median(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="IQRArrivalDelay", caption="Delay IQR", summariseExpression="IQR(ArrivalDelay, na.rm=TRUE)") pt$defineCalculation(calculationName="SDArrivalDelay", caption="Delay Std. Dev.", summariseExpression="sd(ArrivalDelay, na.rm=TRUE)", format="%.1f") pt$addRowCalculationGroups() pt$evaluatePivot() # pt$renderPivot() # sprintf("%.6f", sum(pt$cells$asMatrix())) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Arriva Trains WalesCrossCountryLondon MidlandVirgin TrainsAll TOCs
Total Trains39092292848279859483710
Min Arr. Delay00000
Max Arr. Delay49273177181273
Mean Arr. Delay2.33.52.33.02.7
Median Arr. Delay12101
Delay IQR34333
Delay Std. Dev.4.38.14.28.46.1
" expect_equal(sum(pt$cells$asMatrix()), 168438.858522) expect_identical(as.character(pt$getHtml()), html) }) } } if (requireNamespace("lubridate", quietly = TRUE)) { scenarios <- testScenarios("calculation tests: deriving values from other calculations") 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) library(dplyr) library(lubridate) # derive some additional data trains <- mutate(bhmtrains, ArrivalDelta=difftime(ActualArrival, GbttArrival, units="mins"), ArrivalDelay=ifelse(ArrivalDelta<0, 0, ArrivalDelta), DelayedByMoreThan5Minutes=ifelse(ArrivalDelay>5,1,0)) # create the pivot table pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addRowDataGroups("TOC", totalCaption="All TOCs") pt$defineCalculation(calculationName="DelayedTrains", caption="Trains Arr. 5+ Mins Late", summariseExpression="sum(DelayedByMoreThan5Minutes, na.rm=TRUE)") pt$defineCalculation(calculationName="TotalTrains", caption="Total Trains", summariseExpression=countFunction) pt$defineCalculation(calculationName="DelayedPercent", caption="% Trains Arr. 5+ Mins Late", type="calculation", basedOn=c("DelayedTrains", "TotalTrains"), format="%.1f %%", calculationExpression="values$DelayedTrains/values$TotalTrains*100") pt$evaluatePivot() # pt$renderPivot() # sprintf("%.6f", sum(pt$cells$asMatrix())) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Trains Arr. 5+ Mins LateTotal Trains% Trains Arr. 5+ Mins Late
Arriva Trains Wales37239099.5 %
CrossCountry27802292812.1 %
London Midland3561482797.4 %
Virgin Trains77085949.0 %
All TOCs7483837108.9 %
" expect_equal(sum(pt$cells$asMatrix()), 182432.916225) expect_identical(as.character(pt$getHtml()), html) }) } } scenarios <- testScenarios("calculation tests: showing values only") for(i in 1:nrow(scenarios)) { if(!isDevelopmentVersion) break evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { library(pivottabler) library(dplyr) # perform the aggregation in R code explicitly trains <- bhmtrains %>% group_by(TrainCategory, TOC) %>% summarise(NumberOfTrains=n()) %>% ungroup() # display this pre-calculated data pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TrainCategory", addTotal=FALSE) # << *** CODE CHANGE *** << pt$addRowDataGroups("TOC", addTotal=FALSE) # << *** CODE CHANGE *** << pt$defineCalculation(calculationName="TotalTrains", type="value", valueName="NumberOfTrains") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary Passenger
Arriva Trains Wales3079830
CrossCountry2286563
London Midland1448733792
Virgin Trains8594
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 83710) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: showing values plus derived 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) library(dplyr) # perform the aggregation in R code explicitly trains <- bhmtrains %>% group_by(TrainCategory, TOC) %>% summarise(NumberOfTrains=n()) %>% ungroup() # display this pre-calculated data pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", # << *** CODE CHANGE (AND BELOW) *** << type="value", valueName="NumberOfTrains", summariseExpression="sum(NumberOfTrains)") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales30798303909
CrossCountry228656322928
London Midland144873379248279
Virgin Trains85948594
Total490253468583710
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 334840) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: showing values plus pre-calculated 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(dplyr) library(pivottabler) # perform the aggregation in R code explicitly trains <- bhmtrains %>% group_by(TrainCategory, TOC) %>% summarise(NumberOfTrains=n()) %>% ungroup() trainsTrainCat <- bhmtrains %>% group_by(TrainCategory) %>% summarise(NumberOfTrains=n()) %>% ungroup() trainsTOC <- bhmtrains %>% group_by(TOC) %>% summarise(NumberOfTrains=n()) %>% ungroup() trainsTotal <- bhmtrains %>% summarise(NumberOfTrains=n()) # display this pre-calculated data pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode) pt$addData(trains) pt$addTotalData(trainsTrainCat, variableNames="TrainCategory") pt$addTotalData(trainsTOC, variableNames="TOC") pt$addTotalData(trainsTotal, variableNames=NULL) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="TotalTrains", type="value", valueName="NumberOfTrains") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales30798303909
CrossCountry228656322928
London Midland144873379248279
Virgin Trains85948594
Total490253468583710
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 334840) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: calcs first 1") 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)) pt$addData(bhmtrains) pt$defineCalculation(calculationName="NumberOfTrains", caption="Number of Trains", summariseExpression=countFunction) pt$defineCalculation(calculationName="MaximumSpeedMPH", caption="Maximum Speed (MPH)", summariseExpression="max(SchedSpeedMPH, na.rm=TRUE)") pt$addColumnCalculationGroups() pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Number of TrainsMaximum Speed (MPH)
Express PassengerOrdinary PassengerTotalExpress PassengerOrdinary PassengerTotal
Arriva Trains Wales30798303909909090
CrossCountry228656322928125100125
London Midland144873379248279110100110
Virgin Trains85948594125125
Total490253468583710125100125
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 336380) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: calcs first 2") 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$defineCalculation(calculationName="NumberOfTrains", caption="Number of Trains", summariseExpression=countFunction) pt$defineCalculation(calculationName="MaximumSpeedMPH", caption="Maximum Speed (MPH)", summariseExpression="max(SchedSpeedMPH, na.rm=TRUE)") pt$addRowCalculationGroups() pt$addRowDataGroups("TOC") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
DMUEMUHSTTotalDMUEMUTotal
Number of TrainsArriva Trains Wales307930798308303909
CrossCountry2213373222865636322928
London Midland56388849144875591282013379248279
Virgin Trains2137645785948594
Total3298715306732490256484282013468583710
Maximum Speed (MPH)Arriva Trains Wales9090909090
CrossCountry125125125100100125
London Midland100110110100100100110
Virgin Trains125125125125
Total125125125125100100100125
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 505565) expect_identical(as.character(pt$getHtml()), html) }) } # Failed testing on win builder (R 3.4.0 alpha) - guess: something to do with NA matching or NA sorting # 2. Failure: specific tests: checking NA matching (@testGeneral.R#772) --------- # digest::digest(as.character(pt$getHtml()), algo = "md5") not identical to "4de9b5984fc79813e347de07177f6d58". # 1/1 mismatches # x[1]: "b60fb6d08a52644b7e535c105a444579" # y[1]: "4de9b5984fc79813e347de07177f6d58" # test_that("specific tests: checking NA matching", { # # checkDigestAvailable() # # library(pivottabler) # pt <- PivotTable$new() # pt$addData(bhmtrains) # pt$addColumnDataGroups("TrainCategory") # pt$addRowDataGroups("TOC") # pt$addRowDataGroups("PowerType") # pt$addRowDataGroups("SchedSpeedMPH") # << **** CODE CHANGE **** << # pt$defineCalculation(calculationName="TotalTrains", summariseExpression="n()") # pt$evaluatePivot() # # pt$renderPivot() # # sum(pt$cells$asMatrix(), na.rm=TRUE) # # prepStr(as.character(pt$getHtml())) # # expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 669680) # expect_identical(as.character(pt$getHtml()), html), "4de9b5984fc79813e347de07177f6d58") # }) scenarios <- testScenarios("calculation tests: filter overrides - % of row total") for(i in 1:nrow(scenarios)) { evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { skip_on_cran() library(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Count", visible=FALSE) filterOverrides <- PivotFilterOverrides$new(pt, keepOnlyFiltersFor="TOC") pt$defineCalculation(calculationName="TOCTotalTrains", filters=filterOverrides, summariseExpression=countFunction, caption="TOC Total", visible=FALSE) pt$defineCalculation(calculationName="PercentageOfTOCTrains", type="calculation", basedOn=c("CountTrains", "TOCTotalTrains"), calculationExpression="values$CountTrains/values$TOCTotalTrains*100", format="%.1f %%", caption="% of TOC") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales78.8 %21.2 %100.0 %
CrossCountry99.7 %0.3 %100.0 %
London Midland30.0 %70.0 %100.0 %
Virgin Trains100.0 %100.0 %
Total58.6 %41.4 %100.0 %
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 1000) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - % of grand 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)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Count", visible=FALSE) filterOverrides <- PivotFilterOverrides$new(pt, removeAllFilters=TRUE) pt$defineCalculation(calculationName="GrandTotalTrains", filters=filterOverrides, summariseExpression=countFunction, caption="Grand Total", visible=FALSE) pt$defineCalculation(calculationName="PercentageOfAllTrains", type="calculation", basedOn=c("CountTrains", "GrandTotalTrains"), calculationExpression="values$CountTrains/values$GrandTotalTrains*100", format="%.1f %%", caption="% of All") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales3.7 %1.0 %4.7 %
CrossCountry27.3 %0.1 %27.4 %
London Midland17.3 %40.4 %57.7 %
Virgin Trains10.3 %10.3 %
Total58.6 %41.4 %100.0 %
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 400) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - ratios/multiples") 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)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Count", visible=FALSE) filterOverrides <- PivotFilterOverrides$new(pt, removeAllFilters=TRUE) filterOverrides$add(variableName="TrainCategory", values="Express Passenger", action="replace") filterOverrides$add(variableName="TOC", values="CrossCountry", action="replace") pt$defineCalculation(calculationName="CrossCountryExpress", filters=filterOverrides, summariseExpression=countFunction, caption="CrossCountry Express Trains", visible=FALSE) pt$defineCalculation(calculationName="MultipleOfCCExpressTrains", type="calculation", basedOn=c("CountTrains", "CrossCountryExpress"), calculationExpression="values$CountTrains/values$CrossCountryExpress", format="%.2f", caption="Multiple of CC Express") pt$evaluatePivot() # pt$renderPivot() # round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=3) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales0.130.040.17
CrossCountry1.000.001.00
London Midland0.631.482.11
Virgin Trains0.380.38
Total2.141.523.66
" expect_equal(round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=3), 14.644) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - subsets of data") 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)) pt$addData(bhmtrains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("TOC") filterDMU <- PivotFilter$new(pt, variableName="PowerType", values="DMU") filterOverrides <- PivotFilterOverrides$new(pt, filter=filterDMU, action="intersect") pt$defineCalculation(calculationName="CountDMU", filters=filterOverrides, summariseExpression=countFunction, caption="DMU", visible=FALSE) pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Count", visible=FALSE) pt$defineCalculation(calculationName="PercentageDMU", type="calculation", basedOn=c("CountTrains", "CountDMU"), calculationExpression="values$CountDMU/values$CountTrains*100", format="%.1f %%", caption="% DMU") pt$evaluatePivot() # pt$renderPivot() # round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=3) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Arriva Trains Wales100.0 %100.0 %100.0 %
CrossCountry96.8 %100.0 %96.8 %
London Midland38.9 %16.5 %23.3 %
Virgin Trains24.9 %24.9 %
Total67.3 %18.7 %47.2 %
" expect_equal(round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=3), 855.192) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - custom function 1") for(i in 1:nrow(scenarios)) { evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { skip_on_cran() library(dplyr) trains <- bhmtrains %>% mutate(GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival), GbttDate=as.Date(GbttDateTime)) januaryDates <- seq(as.Date("2017-01-01"), as.Date("2017-01-07"), by="days") # comparison to yesterday # date filter function to return yesterday getYesterdayDateFilter <- function(pt, filters, cell) { # get the date filter filter <- filters$getFilter("GbttDate") if(is.null(filter)||(filter$type=="ALL")||(length(filter$values)>1)) { # there is no filter on GbttDate in this cell # i.e. we are in one of the total cells that covers all dates, # so the concept of yesterday has no meaning, so block all dates newFilter <- PivotFilter$new(pt, variableName="GbttDate", type="NONE") filters$setFilter(newFilter, action="replace") } else { # get the date value and subtract one day date <- filter$values date <- date - 1 filter$values <- date } } library(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("GbttDate", fromData=FALSE, explicitListOfValues=as.list(januaryDates), visualTotals=TRUE) pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Current Day Count") filterOverrides <- PivotFilterOverrides$new(pt, overrideFunction=getYesterdayDateFilter) pt$defineCalculation(calculationName="CountPreviousDayTrains", filters=filterOverrides, summariseExpression=countFunction, caption="Previous Day Count") pt$defineCalculation(calculationName="Daily Change", type="calculation", basedOn=c("CountTrains", "CountPreviousDayTrains"), calculationExpression="values$CountTrains-values$CountPreviousDayTrains", caption="Daily Change") pt$evaluatePivot() # pt$renderPivot() # sum(pt$cells$asMatrix(), na.rm=TRUE) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Current Day CountPrevious Day CountDaily ChangeCurrent Day CountPrevious Day CountDaily ChangeCurrent Day CountPrevious Day CountDaily Change
2017-01-01297486-189214309-95511795-284
2017-01-02565297268318214104883511372
2017-01-03605565404383181201043883160
2017-01-046076052437438-1104410431
2017-01-0560960724384371104710443
2017-01-06607609-2436438-210431047-4
2017-01-07577607-30433436-310101043-33
Total386727146581
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 39486) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - custom function 2") for(i in 1:nrow(scenarios)) { if(!isDevelopmentVersion) break evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { library(dplyr) trains <- bhmtrains %>% mutate(GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival), GbttDate=as.Date(GbttDateTime)) januaryDates <- seq(as.Date("2017-01-01"), as.Date("2017-01-07"), by="days") # three day rolling average # date filter function to a three day range of dates getThreeDayFilter <- function(pt, filters, cell) { # get the date filter filter <- filters$getFilter("GbttDate") if(is.null(filter)||(filter$type=="ALL")||(length(filter$values)>1)) { # there is no filter on GbttDate in this cell # i.e. we are in one of the total cells that covers all dates, # so the concept of previous/next day has no meaning, so block all dates newFilter <- PivotFilter$new(pt, variableName="GbttDate", type="NONE") filters$setFilter(newFilter, action="replace") } else { # get the date value and create three day filter date <- filter$values newDates <- seq(date-1, date+1, by="days") filter$values <- newDates } } library(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("GbttDate", fromData=FALSE, explicitListOfValues=as.list(januaryDates), visualTotals=TRUE) pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Current Day Count") filterOverrides <- PivotFilterOverrides$new(pt, overrideFunction=getThreeDayFilter) pt$defineCalculation(calculationName="ThreeDayCount", filters=filterOverrides, summariseExpression=countFunction, caption="Three Day Total") pt$defineCalculation(calculationName="ThreeDayAverage", type="calculation", basedOn="ThreeDayCount", calculationExpression="values$ThreeDayCount/3", format="%.1f", caption="Three Day Rolling Average") pt$evaluatePivot() # pt$renderPivot() # round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=1) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Current Day CountThree Day TotalThree Day Rolling AverageCurrent Day CountThree Day TotalThree Day Rolling AverageCurrent Day CountThree Day TotalThree Day Rolling Average
2017-01-012971348449.3214841280.35112189729.7
2017-01-025651467489.0318970323.38832437812.3
2017-01-036051777592.34381193397.710432970990.0
2017-01-046071821607.04371313437.7104431341044.7
2017-01-056091823607.74381311437.0104731341044.7
2017-01-066071793597.74361307435.7104331001033.3
2017-01-075771503501.04331083361.010102586862.0
Total386727146581
" expect_equal(round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=1), 78457.3) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: filter overrides - custom function 3") for(i in 1:nrow(scenarios)) { if(!isDevelopmentVersion) break evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { library(dplyr) trains <- bhmtrains %>% mutate(GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival), GbttDate=as.Date(GbttDateTime)) %>% filter((as.Date("2017-01-01") <= GbttDate)&(GbttDate <= as.Date("2017-01-07"))) januaryDates <- seq(as.Date("2017-01-01"), as.Date("2017-01-07"), by="days") # date filter function to all dates since 1st jan getCumulativeFilter <- function(pt, filters, cell) { # get the date filter filter <- filters$getFilter("GbttDate") if(is.null(filter)||(filter$type=="ALL")||(length(filter$values)>1)) { # there is no filter on GbttDate in this cell # i.e. we are in one of the total cells that covers all dates, # can allow this to just be the total } else { # get the date value and modify the filter date <- filter$values newDates <- seq(as.Date("2017-01-01"), date, by="days") filter$values <- newDates } } library(pivottabler) pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode, compatibility=list(totalStyleIsCellStyle=TRUE, explicitHeaderSpansOfOne=TRUE)) pt$addData(trains) pt$addColumnDataGroups("TrainCategory") pt$addRowDataGroups("GbttDate", fromData=FALSE, explicitListOfValues=as.list(januaryDates)) pt$defineCalculation(calculationName="CountTrains", summariseExpression=countFunction, caption="Current Day Count") filterOverrides <- PivotFilterOverrides$new(pt, overrideFunction=getCumulativeFilter) pt$defineCalculation(calculationName="CumulativeCount", filters=filterOverrides, summariseExpression=countFunction, caption="Cumulative Count") pt$evaluatePivot() # pt$renderPivot() # round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=1) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 Express PassengerOrdinary PassengerTotal
Current Day CountCumulative CountCurrent Day CountCumulative CountCurrent Day CountCumulative Count
2017-01-01297297214214511511
2017-01-025658623185328831394
2017-01-03605146743897010432437
2017-01-046072074437140710443481
2017-01-056092683438184510474528
2017-01-066073290436228110435571
2017-01-075773867433271410106581
Total386738672714271465816581
" expect_equal(sum(pt$cells$asMatrix(), na.rm=TRUE), 88492) expect_identical(as.character(pt$getHtml()), html) }) } scenarios <- testScenarios("calculation tests: custom function with calcFuncArgs") for(i in 1:nrow(scenarios)) { if(!isDevelopmentVersion) break evaluationMode <- scenarios$evaluationMode[i] processingLibrary <- scenarios$processingLibrary[i] description <- scenarios$description[i] countFunction <- scenarios$countFunction[i] test_that(description, { library(pivottabler) library(dplyr) library(lubridate) # derive some additional data trains <- mutate(bhmtrains, GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival), GbttDate=make_date(year=year(GbttDateTime), month=month(GbttDateTime), day=day(GbttDateTime)), GbttMonth=make_date(year=year(GbttDateTime), month=month(GbttDateTime), day=1), ArrivalDelta=difftime(ActualArrival, GbttArrival, units="mins"), ArrivalDelay=ifelse(ArrivalDelta<0, 0, ArrivalDelta), DelayedByMoreThan5Minutes=ifelse(ArrivalDelay>5,1,0)) # custom calculation function getWorstSingleDayPerformance <- function(pivotCalculator, netFilters, calcFuncArgs, format, fmtFuncArgs, baseValues, cell) { # get the data frame trains <- pivotCalculator$getDataFrame("trains") # apply the TOC and month filters coming from the headers in the pivot table filteredTrains <- pivotCalculator$getFilteredDataFrame(trains, netFilters) # calculate the percentage of trains more than five minutes late by date dateSummary <- filteredTrains %>% group_by(GbttDate) %>% summarise(DelayedPercent = sum(DelayedByMoreThan5Minutes, na.rm=TRUE) / n() * 100) %>% arrange(desc(DelayedPercent)) # top value tv <- dateSummary$DelayedPercent[1] date <- dateSummary$GbttDate[1] if(calcFuncArgs$output=="day") { # << CODE CHANGES HERE << # build the return value value <- list() value$rawValue <- date value$formattedValue <- format(date, format="%a %d") } else if(calcFuncArgs$output=="performance") { # << CODE CHANGES HERE << # build the return value value <- list() value$rawValue <- tv value$formattedValue <- pivotCalculator$formatValue(tv, format=format) } return(value) } # create the pivot table pt <- PivotTable$new(processingLibrary=processingLibrary, evaluationMode=evaluationMode) pt$addData(trains, "trains") pt$addColumnDataGroups("GbttMonth", dataFormat=list(format="%B %Y")) pt$addRowDataGroups("TOC", totalCaption="All TOCs") pt$defineCalculation(calculationName="WorstSingleDay", caption="Day", format="%.1f %%", type="function", calculationFunction=getWorstSingleDayPerformance, calcFuncArgs=list(output="day")) pt$defineCalculation(calculationName="WorstSingleDayPerf", caption="Perf", format="%.1f %%", type="function", calculationFunction=getWorstSingleDayPerformance, calcFuncArgs=list(output="performance")) pt$evaluatePivot() # pt$renderPivot() # round(sum(pt$cells$asMatrix(), na.rm=TRUE), digits=1) # prepStr(as.character(pt$getHtml())) html <- "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n
 December 2016January 2017February 2017Total
DayPerfDayPerfDayPerfDayPerf
Arriva Trains WalesTue 2742.9 %Sun 2918.8 %Sun 1218.8 %Tue 2742.9 %
CrossCountryThu 0135.4 %Fri 0619.4 %Thu 2327.9 %Thu 0135.4 %
London MidlandThu 0126.9 %Fri 0617.2 %Thu 2312.1 %Thu 0126.9 %
Virgin TrainsThu 0133.0 %Thu 1221.4 %Sat 1125.5 %Thu 0133.0 %
All TOCsThu 0129.5 %Fri 0616.3 %Thu 2317.1 %Thu 0129.5 %
" expect_equal(round(sum(pt$cells$asMatrix(), na.rm=TRUE), 0), 530) expect_identical(as.character(pt$getHtml()), html) }) }