Outputting a summary result per group in Shiny

shiny
1

Running below code, I get "arguments must have same length" error from the tapply line. Outside of shiny,

with(crime2, tapply(number, list(type), summary))

runs fine though. (Btw, the widgets have a problem as all of them show up as red -- but I posted this problem on a different post.)

library(shiny)
library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)

crime2 <- crime[1:50,]

ui <- fluidPage(
  titlePanel("Unusual Observations"),
  
  sidebarLayout(
    sidebarPanel(
      helpText("Create maps with 
        information from the Crime Data"),
      
      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("Hour",
                              "Number"),
                  selected = "Hour"),
      
      sliderInput("range", 
                  label = "Range of interest:",
                  min = 0, max = 10, value = c(1, 2))
    ),
    
    mainPanel(leafletOutput("map"))
  ),
  
  verbatimTextOutput("stats")
)

server <- function(input, output) {
  output$map <- renderLeaflet({
    data <- switch(input$var,
                   "hour" = crime2$hour,
                   "number" = crime2$number)
    
    getColor <- function(data){sapply(data, function(var){
       if(input$var< input$range[1]) {
         "green"
       } else if(input$var <= input$range[2]) {
         "orange"
       } else {
         "red"
        } })
    }

  icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = getColor(crime2)
)
    
    leaflet(crime2) %>%
  addTiles() %>%
  addAwesomeMarkers(~lon, ~lat, icon=icons)
    
  })
  
  output$stats <- renderPrint({
    
    with(crime2, tapply(input$var, list(type), summary))
    
  })
  
  
}

shinyApp(ui=ui, server=server)
2

If you test the problem line outside of Shiny but mimicking the app conditions as closely as possible, you'll see that it doesn't work there, either:

crime2 <- ggmap::crime[1:50, ]
input <- list(var = "Hour")

with(crime2, tapply(input$var, list(type), summary))
#> Error in tapply(input$var, list(type), summary): arguments must have same length

# Non-standard evaluation can be confusing!
with(crime2, hour)
#>  [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1
#> [36] 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2
with(crime2, input$var)
#> [1] "Hour"

Created on 2018-06-28 by the reprex package (v0.2.0).

The reason is that input$var is evaluating to "Hour", which is a character vector of length 1, while crime2$type is a vector of length 50.

with() isn't really saving that many keystrokes here and the non-standard evaluation is complicating matters, but if we go back to a standard evaluation approach another problem is revealed:

crime2 <- ggmap::crime[1:50, ]
input <- list(var = "Hour")

tapply(crime2[[input$var]], list(crime2$type), summary)
#> Error in tapply(crime2[[input$var]], list(crime2$type), summary): arguments must have same length

crime2[[input$var]]
#> NULL

Created on 2018-06-28 by the reprex package (v0.2.0).

The variable in crime2 is called hour, but the selectInput() is returning Hour. This works (I've cut out all the non-relevant bits of the app, for simplicity):

library(shiny)

crime2 <- ggmap::crime[1:50,]

ui <- fluidPage(
  titlePanel("Unusual Observations"),
  
  sidebarLayout(
    sidebarPanel(
      helpText("Create maps with 
               information from the Crime Data"),
      
      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("Hour",
                              "Number"),
                  selected = "Hour"),
      
      sliderInput("range", 
                  label = "Range of interest:",
                  min = 0, max = 10, value = c(1, 2))
      ),
    
    mainPanel()
  ),
  
  verbatimTextOutput("stats")
  )

server <- function(input, output) {

  output$stats <- renderPrint({
    
    tapply(crime2[[tolower(input$var)]], list(crime2$type), summary)
    
  })
  
}
3 Likes