11. Shiny

Chris Bailiss

2019-11-01

In This Vignette

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:

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)
Minimal pivottabler Shiny App

Minimal pivottabler Shiny App

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)
Comparing pairs of variables with Shiny and pivottabler

Comparing pairs of variables with Shiny and pivottabler

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)
Multi-Level Example Shiny App

Multi-Level Example Shiny App

Further Reading

The full set of vignettes is:

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