CODEWITHSUNDEEP
rshinyreactive-programming
Paul Reiners
Paul Reiners

Reputation: 7886

R Shiny reactive code not reacting when moved into function

I have the following R Shiny code in server.R and it works fine:

  slider1Values <- reactive({
    weekNumber = input$map1WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  slider2Values <- reactive({
    weekNumber = input$map2WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  slider3Values <- reactive({
    weekNumber = input$map3WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  output$w1 <- renderLeaflet({leaflet(slider1Values()) %>% addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png', 
                                                                   attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>') %>% 
      addCircles(~lon, ~lat, weight = 3, radius=40, 
                 color="#ffa500", stroke = TRUE, fillOpacity = 0.8)})

  output$w2 <- renderLeaflet({leaflet(slider2Values()) %>% addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png', 
                                                            attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>') %>% 
      addCircles(~lon, ~lat,  weight = 3, radius=40, 
                 color="#ffa500", stroke = TRUE, fillOpacity = 0.8)})
  output$w3 <- renderLeaflet({leaflet(slider3Values()) %>% addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png', 
                                                            attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>') %>% 
      addCircles(~lon, ~lat, weight = 3, radius=40, 
                 color="#ffa500", stroke = TRUE, fillOpacity = 0.8)})

When I move one of the sliders, such as map1WeekSlider, then the corresponding output widget, such as w1 updates.

I abstract common code into a function renderMap like this:

  slider1Values <- reactive({
    weekNumber = input$map1WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  slider2Values <- reactive({
    weekNumber = input$map2WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  slider3Values <- reactive({
    weekNumber = input$map3WeekSlider
    data <- get_nkweek(weekNumber)
  }) 

  renderMap <- function(data) {
    map <- renderLeaflet({leaflet(data) %>% addTiles('http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png', 
                                                                   attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>') %>% 
        addCircles(~lon, ~lat, weight = 3, radius=40, 
                   color="#ffa500", stroke = TRUE, fillOpacity = 0.8)})

    return(map)
  }

  output$w1 <- renderMap(slider1Values())
  output$w2 <- renderMap(slider2Values())
  output$w3 <- renderMap(slider3Values())

Now it doesn't work. Changing the value of a slider does not properly update the widget.

What am I doing wrong here?

Upvotes: 2

Views: 194

Answers (1)

tokiloutok
tokiloutok

Reputation: 467

You may see a message like :

Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

The call to the closures sliderValues must be done in a reactive context like reactive, observe, render ...

To be able to do some code factorization, you can use something like 

library(shiny)
library(leaflet)

r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

renderMap <- function(points) {
  map <- 
    leaflet() %>%
      addProviderTiles("Stamen.TonerLite",
                       options = providerTileOptions(noWrap = TRUE)
      ) %>%
      addMarkers(data = points)
  return(map)
}

ui <- fluidPage(
  leafletOutput("mymap"),
  p(),
  actionButton("recalc", "New points")
)

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

  points <- eventReactive(input$recalc, {
    cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
  }, ignoreNULL = FALSE)

  output$mymap <- renderLeaflet({
    map <- renderMap(points())
    map
  })
}

shinyApp(ui, server)

I'm using leaflet-shiny example as it is a complete example ...

Upvotes: 2

Related Questions