Change and apply a numeric range inside Shiny

shiny
,
1

I want to make an app where a user chooses a numeric variable (i.e. hour in crime data), low and high threshold (i.e. <1 and <=1 in the below) for color changes for the variable. Below codes work without Shiny:

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

crime2 <- crime[1:50,]

getColor <- function(crime2) {
 sapply(crime2$hour, function(hour) {
 if(hour< 1) {
   "green"
 } else if(hour <= 1) {
   "orange"
 } else {
   "red"
  } })
}

icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = getColor(crime2)
)

leaflet(crime2) %>%
  addTiles() %>%
  addAwesomeMarkers(~lon, ~lat, icon=icons)

Now, I want to put this in Shiny, but I get warnings saying "Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.". and all the observations were red and the ranges didn't apply. This is my attempt:

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"))
  )
)


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)
    
  })
}

shinyApp(ui=ui, server=server)

Could anyone help? Thanks a lot in advance!

2

Hi there! There are a number of issues with the code you posted.

getColor

  1. input$var is used where you meant var
  2. You're calling it getColor(crime2), it should be getColor(data) (you're passing the whole data frame when you should just be passing the selected vector)
  3. The logic should be vectorized instead of using sapply to loop:
getColor <- function(data) {
  ifelse(data < input$range[1], "green", ifelse(data <= input$range[2], "orange", "red"))
}

Either 2 or 3 will eliminate the "Input to asJSON" warning you're seeing; your sapply was returning a named vector.

I couldn't get your example to work (I don't know where crime2 is coming from) but here's your example adapted to the quakes dataset:

library(shiny)
library(leaflet)

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 = names(quakes),
        selected = character(0)),
      
      uiOutput("range_ui")
    ),
    
    mainPanel(leafletOutput("map"))
  )
)


server <- function(input, output) {
  df <- quakes[sample(nrow(quakes), 100),]
  
  data <- reactive({
    req(input$var)
    df[[input$var]]
  })
  
  output$range_ui <- renderUI({
    sliderInput("range", 
      label = "Range of interest:",
      min = min(data()), max = max(data()), value = range(data()))
  })
  
  getColor <- function(x){
    req(input$range)
    ifelse(x < input$range[1], "green", ifelse(x <= input$range[2], "orange", "red"))
  }
  
  output$map <- renderLeaflet({
    icons <- awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = getColor(data())
    )
    
    leaflet(df) %>%
      addTiles() %>%
      addAwesomeMarkers(icon=icons)
  })
}

shinyApp(ui=ui, server=server)
1 Like
3

Thank you so much. I looked into this right after you posted and somehow it didn't work after I changed things a bit. It works perfectly now! Thank you so much.

Some questions, why does sliderInput go inside the server? And why is getColor on the outside of output$map but awesomeIcons is in the inside of output$map?