Question

我在server.R中有以下R Shiny代码，它运行正常：

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

当我移动其中一个滑块（例如map1WeekSlider）时，相应的输出窗口小部件（例如w1）会更新。

我将公共代码抽象为函数renderMap，如下所示：

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

现在它不起作用。更改滑块的值无法正确更新窗口小部件。

我在这里做错了什么？

Answer 1

您可能会看到如下消息：

.getReactiveEnvironment（）$ currentContext（）中的错误：没有活动的反应上下文，不允许操作。（你试图做一些只能在反应式表达式或观察者内部完成的事情。）

对闭包滑块值的调用必须在反应式上下文中完成，例如反应，观察，渲染 ......

为了能够进行一些代码分解，你可以使用像

这样的东西

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)

我使用传单有光泽的例子，因为它是一个完整的例子......

R Shiny无效代码在移入功能时不响应

1 个答案: