In cbailiss/pivottabler: Create Pivot Tables

In This Vignette

• About Shiny
• Examples
• Example 1: Minimal Example
• Example 2: Comparing pairs of variables
• Example 3: Multiple rows, columns and measures

About Shiny

Shiny is an R package that makes it easy to build interactive web applications (apps) straight from R.

Good starting points for using Shiny are:

• Overview
• Video Tutorial
• Detailed Written Articles

Examples

This vignette presents a couple of examples to get started using 'pivottabler' with Shiny. They are not intended to be fully featured applications, rather they are intended to help the reader get started quickly using pivottabler with Shiny.

To use each of these examples, create a new single-file Shiny web application in RStudio, then paste the R code into the app.R file.

Example 1: Minimal Example

library(shiny)
library(htmlwidgets)
library(pivottabler)

ui <- fluidPage(

   titlePanel("Pivottabler Minimal Example Shiny App"),

   sidebarLayout(
      sidebarPanel(

         selectInput("selectRows", label = h5("Rows"),
                     choices = list("Train Category" = "TrainCategory",
                                    "TOC" = "TOC",
                                    "Power Type" = "PowerType"), selected = "TOC"),
         selectInput("selectCols", label = h5("Columns"),
                     choices = list("Train Category" = "TrainCategory",
                                    "TOC" = "TOC",
                                    "Power Type" = "PowerType"), selected = "TrainCategory")
      ),

      mainPanel(
         pivottablerOutput('pvt')
      )
   )
)

server <- function(input, output) {

   output$pvt <- renderPivottabler({
     pt <- PivotTable$new()
     pt$addData(bhmtrains)
     pt$addColumnDataGroups(input$selectCols)
     pt$addRowDataGroups(input$selectRows)
     pt$defineCalculation(calculationName="TotalTrains", summariseExpression="n()")
     pt$evaluatePivot()
     pivottabler(pt)
   })
}

shinyApp(ui = ui, server = server)

Example 2: Comparing pairs of variables

library(shiny)
library(htmlwidgets)
library(pivottabler)
library(dplyr)
library(lubridate)

getDelayBand <- function(delayMinutes) {
  if(is.na(delayMinutes)) return(NA)
  else if(delayMinutes <= 0) return(0)
  else if(delayMinutes <= 1) return(1)
  else if(delayMinutes <= 2) return(2)
  else if(delayMinutes <= 5) return(5)
  else if(delayMinutes <= 10) return(10)
  else if(delayMinutes <= 15) return(15)
  else if(delayMinutes <= 20) return(20)
  else if(delayMinutes <= 30) return(30)
  else if(delayMinutes <= 45) return(45)
  else if(delayMinutes <= 60) return(60)
  else if(delayMinutes <= 90) return(90)
  else if(delayMinutes <= 120) return(120)
  else if(delayMinutes <= 180) return(180)
  else if(delayMinutes <= 240) return(240)
  else if(delayMinutes <= 300) return(300)
  else return(999)
}

getDelayBands <- function(delayMinutes) {
  return(sapply(delayMinutes, getDelayBand))
}

stations <- mutate(trainstations, CrsCodeChr=as.character(CrsCode))
trains <- bhmtrains %>%
  mutate(OriginChr=as.character(Origin), DestinationChr=as.character(Destination)) %>%
  inner_join(stations, by=c("OriginChr"="CrsCodeChr")) %>%
  inner_join(stations, by=c("DestinationChr"="CrsCodeChr")) %>%
  select(Status, TOC, TrainCategory, PowerType, SchedSpeedMPH,
         Origin=StationName.x, OriginGbttDeparture, OriginActualDeparture,
         GbttArrival, ActualArrival, GbttDeparture, ActualDeparture,
         Destination=StationName.y, DestinationGbttArrival, DestinationActualArrival) %>%
  mutate(Status=recode(Status, "A"="Normal", "C"="Cancelled", "R"="Reinstated"),
         GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival),
         GbttHourOfDay=hour(GbttDateTime),
         GbttDate=make_date(year=year(GbttDateTime), month=month(GbttDateTime), day=day(GbttDateTime)),
         GbttMonth=make_date(year=year(GbttDateTime), month=month(GbttDateTime), day=1),
         ArrivalDeltaMins=difftime(ActualArrival, GbttArrival, units="mins"),
         ArrivalDelayMins=ifelse(ArrivalDeltaMins<0, 0, ArrivalDeltaMins),
         ArrivalDelayBand=getDelayBands(ArrivalDelayMins)) %>%
  select(Status, TOC, TrainCategory, PowerType, SchedSpeedMPH, Origin, Destination,
         GbttMonth, GbttDate, GbttHourOfDay, ArrivalDeltaMins, ArrivalDelayMins, ArrivalDelayBand)

ui <- fluidPage(

  titlePanel("Pivottabler Minimal Example Shiny App"),

  fluidRow(
    column(4,
      selectInput("selectRows", label = "Rows", choices=list(""))
    ),
    column(4,
      selectInput("selectCols", label = "Columns", choices=list(""))
    ),
    column(4,
      selectInput("selectCalc", label = "Calculation",
                     choices = list("Total Trains", "Total Delay Minutes"), selected = "Total Trains")
    )
  ),

  hr(),

  pivottablerOutput('pvt')
)

server <- function(input, output, session) {

  observe({
    isolate({
    sr <- input$selectRows
    sc <- input$selectCols

    updateSelectInput(session, "selectRows",
      label = "Rows",
      choices = names(trains)
    )
    updateSelectInput(session, "selectCols",
      label = "Columns",
      choices = names(trains)
    )
    })
  })

  output$pvt <- renderPivottabler({
   if((length(input$selectRows)>0)&&(nchar(input$selectRows)>0)) {
   pt <- PivotTable$new()
   trains2 <- trains %>%
     group_by_(input$selectCols, input$selectRows) %>%
     summarise(TotalTrains=n(), DelayMinutes=sum(ArrivalDelayMins, na.rm=TRUE)) %>%
     ungroup()
   pt$addData(trains2)
   pt$addColumnDataGroups(input$selectCols)
   pt$addRowDataGroups(input$selectRows)
   if(input$selectCalc=="Total Trains")
     pt$defineCalculation(calculationName="TotalTrains", summariseExpression="sum(TotalTrains)")
   else if (input$selectCalc=="Total Delay Minutes")
     pt$defineCalculation(calculationName="ToalDelayMinutes",
                          summariseExpression="sum(DelayMinutes, na.rm=TRUE)")
   pt$evaluatePivot()
   pivottabler(pt)
   }
  })
}

shinyApp(ui = ui, server = server)

Example 3: Multiple rows, columns and measures

library(shiny)
library(htmlwidgets)
library(dplyr)
library(lubridate)
library(pivottabler)

# START OF DATA PREP

# to be used when getting station names in joins below
tsorigin = transmute(trainstations, CrsCode=as.character(CrsCode),
                     OriginName=as.character(StationName))
tsdestination = transmute(trainstations, CrsCode=as.character(CrsCode),
                          DestinationName=as.character(StationName))

# recode status and join to get station names from CrsCodes
data <- bhmtrains %>%
  mutate(Status = recode(Status,
                         "A" = "Active", "C" = "Cancelled", "R" = "Reinstated"),
         Origin = as.character(Origin),
         Destination = as.character(Destination)) %>%
  left_join(tsorigin, by = c("Origin" = "CrsCode")) %>%
  left_join(tsdestination, by = c("Destination" = "CrsCode"))

# derive some additional delay data
data <- mutate(data,
                 GbttDateTime=if_else(is.na(GbttArrival), GbttDeparture, GbttArrival),
                 GbttMonth=make_date(year=year(GbttDateTime), month=month(GbttDateTime), day=1),
                 IsArrival=ifelse(is.na(GbttArrival), 0, 1),
                 ArrivalDelta=difftime(ActualArrival, GbttArrival, units="mins"),
                 ArrivalDelay=ifelse(ArrivalDelta<0, 0, ArrivalDelta),
                 DelayedByMoreThan5Minutes=ifelse(ArrivalDelay>5,1,0))

totalTrainCount <- nrow(data)

# END OF DATA PREP

ui <- fluidPage(

  titlePanel("Pivottabler Multi-Level Example Shiny App"),

  fluidRow(
    column(3,
           selectInput("selectRows1", label = h5("Rows 1"),
                       choices = list("None" = "None",
                                      "Status" = "Status",
                                      "Train Category" = "TrainCategory",
                                      "TOC" = "TOC",
                                      "Power Type" = "PowerType",
                                      "Scheduled Speed" = "SchedSpeedMPH",
                                      "Origin" = "OriginName",
                                      "Destination" = "DestinationName"),
                       selected = "TOC")
    ),
    column(3,
           selectInput("selectRows2", label = h5("Rows 2"),
                       choices = list("None" = "None",
                                      "Status" = "Status",
                                      "Train Category" = "TrainCategory",
                                      "TOC" = "TOC",
                                      "Power Type" = "PowerType",
                                      "Scheduled Speed" = "SchedSpeedMPH",
                                      "Origin" = "OriginName",
                                      "Destination" = "DestinationName"),
                       selected = "None")
    ),
    column(3,
           selectInput("selectCols1", label = h5("Columns 1"),
                       choices = list("None" = "None",
                                      "Status" = "Status",
                                      "Train Category" = "TrainCategory",
                                      "TOC" = "TOC",
                                      "Power Type" = "PowerType",
                                      "Scheduled Speed" = "SchedSpeedMPH",
                                      "Origin" = "OriginName",
                                      "Destination" = "DestinationName"),
                       selected = "TrainCategory")
    ),
    column(3,
           selectInput("selectCols2", label = h5("Columns 2"),
                       choices = list("None" = "None",
                                      "Status" = "Status",
                                      "Train Category" = "TrainCategory",
                                      "TOC" = "TOC",
                                      "Power Type" = "PowerType",
                                      "Scheduled Speed" = "SchedSpeedMPH",
                                      "Origin" = "OriginName",
                                      "Destination" = "DestinationName"),
                       selected = "None")
    )
  ),

  fluidRow(
    column(3,
           selectInput("selectMeasure1", label = h5("Measure 1"),
                       choices = list("Train Count" = "Train Count",
                                      "% of Trains" = "% of Trains",
                                      "Total Arrival Delay Minutes" = "Total Arrival Delay Minutes",
                                      "Average Arrival Delay Minutes" = "Average Arrival Delay Minutes",
                                      "Max Arrival Delay Minutes" = "Max Arrival Delay Minutes",
                                      "Trains with Arrival Delay >= 5 Minutes",
                                      "% of Trains with Arrival Delay >= 5 Minutes"),
                       selected = "Train Count")
    ),
    column(3,
           selectInput("selectMeasure2", label = h5("Measure 2"),
                       choices = list("None",
                                      "Train Count" = "Train Count",
                                      "% of Trains" = "% of Trains",
                                      "Total Arrival Delay Minutes" = "Total Arrival Delay Minutes",
                                      "Average Arrival Delay Minutes" = "Average Arrival Delay Minutes",
                                      "Max Arrival Delay Minutes" = "Max Arrival Delay Minutes",
                                      "Trains with Arrival Delay >= 5 Minutes",
                                      "% of Trains with Arrival Delay >= 5 Minutes"),
                       selected = "None")
    ),
    column(6,
           br(),
           helpText("Note:  Selecting Origin and/or Destination in rows/columns will result in thousands or
             tens of thousands of cells being calculated, so the pivot table may take a couple of
             minutes to calculate.")
    )
  ),

  hr(),

  pivottablerOutput('pvt')

)

server <- function(input, output) {



  output$pvt <- renderPivottabler({
    pt <- PivotTable$new()
    pt$addData(data)

    # rows and columns
    if (input$selectCols1 != "None") { pt$addColumnDataGroups(input$selectCols1) }
    if (input$selectCols2 != "None") { pt$addColumnDataGroups(input$selectCols2) }
    if (input$selectRows1 != "None") { pt$addRowDataGroups(input$selectRows1) }
    if (input$selectRows2 != "None") { pt$addRowDataGroups(input$selectRows2) }

    # measure 1
    if (input$selectMeasure1 == "Train Count") {
      pt$defineCalculation(calculationName="TotalTrains",
                           summariseExpression="n()",
                           caption="Train Count")
    }
    else if (input$selectMeasure1 == "% of Trains") {
      pt$defineCalculation(calculationName="TotalTrains",
                           summariseExpression="n()",
                           visible=FALSE)
      pt$defineCalculation(calculationName="PercentageOfTrains",
                           caption="% of Trains",
                           type="calculation",
                           basedOn=c("TotalTrains"),
                           format="%.2f %%",
                           calculationExpression=paste0("values$TotalTrains/", totalTrainCount, "*100"))
    }
    else if (input$selectMeasure1 == "Total Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="TotalArrivalDelayMinutes",
                           caption="Total Arrival Delay Minutes",
                           summariseExpression="sum(ArrivalDelay, na.rm = TRUE)")
    }
    else if (input$selectMeasure1 == "Average Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="TotalArrivals",
                           summariseExpression="sum(IsArrival, na.rm=TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="TotalArrivalDelayMinutes",
                           summariseExpression="sum(ArrivalDelay, na.rm = TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="AverageArrivalDelayMinutes",
                           caption="Average Arrival Delay Minutes",
                           type="calculation",
                           basedOn=c("TotalArrivals", "TotalArrivalDelayMinutes"),
                           format="%.2f",
                           calculationExpression="values$TotalArrivalDelayMinutes/values$TotalArrivals")
    }
    else if (input$selectMeasure1 == "Max Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="MaxArrivalDelayMinutes",
                           caption="Max Arrival Delay Minutes",
                           summariseExpression="max(ArrivalDelay, na.rm = TRUE)")
    }
    else if (input$selectMeasure1 == "Trains with Arrival Delay >= 5 Minutes") {
      pt$defineCalculation(calculationName="Trains5orMoreMinsLate",
                           caption="Trains with Arrival Delay >= 5 Minutes",
                           summariseExpression="sum(DelayedByMoreThan5Minutes, na.rm = TRUE)")
    }
    else if (input$selectMeasure1 == "% of Trains with Arrival Delay >= 5 Minutes") {
      pt$defineCalculation(calculationName="TotalArrivals",
                           summariseExpression="sum(IsArrival, na.rm=TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="Trains5orMoreMinsLate",
                           summariseExpression="sum(DelayedByMoreThan5Minutes, na.rm = TRUE)",
                           visible=FALSE)
      pt$defineCalculation(calculationName="PercentageOfTrainsWithArrivalDelay5orMoreMinutesLate",
                           caption="% of Trains with Arrival Delay >= 5 Minutes",
                           type="calculation", basedOn=c("TotalArrivals", "Trains5orMoreMinsLate"),
                           format="%.2f %%",
                           calculationExpression="values$Trains5orMoreMinsLate/values$TotalArrivals*100")
    }

    # measure 2
    if (input$selectMeasure2 == "Train Count") {
      pt$defineCalculation(calculationName="TotalTrains2",
                           summariseExpression="n()",
                           caption="Train Count")
    }
    else if (input$selectMeasure2 == "% of Trains") {
      pt$defineCalculation(calculationName="TotalTrains2",
                           summariseExpression="n()",
                           visible=FALSE)
      pt$defineCalculation(calculationName="PercentageOfTrains2",
                           caption="% of Trains",
                           type="calculation",
                           basedOn=c("TotalTrains2"),
                           format="%.2f %%",
                           calculationExpression=paste0("values$TotalTrains2/", totalTrainCount, "*100"))
    }
    else if (input$selectMeasure2 == "Total Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="TotalArrivalDelayMinutes2",
                           caption="Total Arrival Delay Minutes",
                           summariseExpression="sum(ArrivalDelay, na.rm = TRUE)")
    }
    else if (input$selectMeasure2 == "Average Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="TotalArrivals2",
                           summariseExpression="sum(IsArrival, na.rm=TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="TotalArrivalDelayMinutes2",
                           summariseExpression="sum(ArrivalDelay, na.rm = TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="AverageArrivalDelayMinutes2",
                           caption="Average Arrival Delay Minutes",
                           type="calculation",
                           basedOn=c("TotalArrivals2", "TotalArrivalDelayMinutes2"),
                           format="%.2f",
                           calculationExpression="values$TotalArrivalDelayMinutes2/values$TotalArrivals2")
    }
    else if (input$selectMeasure2 == "Max Arrival Delay Minutes") {
      pt$defineCalculation(calculationName="MaxArrivalDelayMinutes2",
                           caption="Max Arrival Delay Minutes",
                           summariseExpression="max(ArrivalDelay, na.rm = TRUE)")
    }
    else if (input$selectMeasure2 == "Trains with Arrival Delay >= 5 Minutes") {
      pt$defineCalculation(calculationName="Trains5orMoreMinsLate2",
                           caption="Trains with Arrival Delay >= 5 Minutes",
                           summariseExpression="sum(DelayedByMoreThan5Minutes, na.rm = TRUE)")
    }
    else if (input$selectMeasure2 == "% of Trains with Arrival Delay >= 5 Minutes") {
      pt$defineCalculation(calculationName="TotalArrivals2",
                           summariseExpression="sum(IsArrival, na.rm=TRUE)", visible=FALSE)
      pt$defineCalculation(calculationName="Trains5orMoreMinsLate2",
                           summariseExpression="sum(DelayedByMoreThan5Minutes, na.rm = TRUE)",
                           visible=FALSE)
      pt$defineCalculation(calculationName="PercentageOfTrainsWithArrivalDelay5orMoreMinutesLate2",
                           caption="% of Trains with Arrival Delay >= 5 Minutes",
                           type="calculation", basedOn=c("TotalArrivals2", "Trains5orMoreMinsLate2"),
                           format="%.2f %%",
                           calculationExpression="values$Trains5orMoreMinsLate2/values$TotalArrivals2*100")
    }

    # generate pivot tabler
    pt$evaluatePivot()
    pivottabler(pt)
  })
}

shinyApp(ui = ui, server = server)

Further Reading

The full set of vignettes is:

1. Introduction
2. Data Groups
3. Calculations
4. Regular Layout
5. Outputs
6. Latex Output
7. Styling
8. Finding and Formatting
9. Cell Context
10. Navigating a Pivot Table
11. Irregular Layout
12. Performance
13. Excel Export
14. Shiny
15. Appendix: Details
16. Appendix: Calculations
17. Appendix: Class Overview

cbailiss/pivottabler documentation built on Oct. 14, 2023, 9:38 a.m.