R Блестящие реактивный код не реагирует при перемещении в функцию

Question

У меня есть следующий R Блестящего код в server.R и он работает отлично:

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) 

Я использую листовку-блестящий пример, как это полный пример ...