Визуализация листовки в Shiny с использованием validate + need или eventReactive не работает - PullRequest
Новая
       13

Визуализация листовки в Shiny с использованием validate + need или eventReactive не работает

0 голосов
/ 26 февраля 2019

Я пытаюсь создать приложение R Shiny Dashboard с библиотекой Leaflet.В приложении пользователь может выбрать страну происхождения, страну назначения и продукт.Кадр данных затем фильтруется для этой конкретной комбинации входов.Полученный кадр данных затем передается в renderLeaflet, и данные о местоположении и детали отображаются пользователю.

Моя цель состоит в том, чтобы отображать и отображать листовую диаграмму только тогда, когда отфильтрованный кадр данных создается после пользовательского ввода.Я пытался использовать как validate + need и eventReactive для этого.На данный момент я добавил некоторые данные-заполнители в листовку.

eventReactive не возвращает листовую карту на приборной панели даже после того, как пользователь выберет ввод.eventReactive Для проверки + необходимо, листовка карты и данные заполнителя строятся и отображаются еще до того, как пользователь выберет ввод.enter image description here Код для UI.R: 


sidebar <- shinydashboard::dashboardSidebar(
  selectizeInput(
    "srcLoc", label="Source Country", choices=locsAgg$SrcLocation, options=list(create=TRUE, maxItems=100, placeholder="Select a Country")
  ),
  selectizeInput(
    "destLoc", label="Destination Country", choices=locsAgg$SonLocation, options=list(create=TRUE, maxItems=100, placeholder="Select a Country")
  ),
  selectizeInput(
    "pdt", label="Product", choices=locsAgg$Pdt, options=list(create=TRUE, maxItems=100, placeholder="Select a Product")
  )
)

body <- shinydashboard::dashboardBody(
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)


# Put them together into a dashboardPage
dashboardPage(
  dashboardHeader(title = "World Map"),
  sidebar,
  body
)

Код для Server.R для проверки + необходимо: 

### Using valid and need --> plot still gets plotted

shinyServer<- function(input,output,session){
  updateSelectizeInput(session, "srcLoc", choices=locsAgg$SrcLocation, server=T)

  locsFil1 <-reactive({
    locsAgg %>% filter(SrcLocation %in% input$srcLoc)
  })

  observeEvent(input$srcLoc, {updateSelectizeInput(session, "destLoc", choices=locsFil1()$SonLocation, server=T)})

  locsFil2 <-reactive({
    locsFil1() %>% filter(SonLocation %in% input$destLoc)
  })

  observeEvent(input$destLoc, {updateSelectizeInput(session, "pdt", choices=locsFil2()$Pdt, server=T)})

  locsFil3 <-reactive({
    locsFil2() %>% filter(Pdt %in% input$pdt)
  })


  output$map <- renderLeaflet({
    validate(
      need(locsFil3(), "Select inputs")
    )
    m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>% 
      addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
    m <- addMarkers(m, lng=c(12,21) , lat=c(37,67))
  })

}

Код для Server.R для событияReactive: 

# doesnt work and messes up filters as well

shinyServer<- function(input,output,session){
  updateSelectizeInput(session, "srcLoc", choices=locsAgg$SrcLocation, server=T)

  locsFil1 <-reactive({
    locsAgg %>% filter(SrcLocation %in% input$srcLoc)
  })

  observeEvent(input$srcLoc, {updateSelectizeInput(session, "destLoc", choices=locsFil1()$SonLocation, server=T)})

  locsFil2 <-reactive({
    locsFil1() %>% filter(SonLocation %in% input$destLoc)
  })

  observeEvent(input$destLoc, {updateSelectizeInput(session, "pdt", choices=locsFil2()$Pdt, server=T)})

  locsFil3 <-reactive({
    locsFil2() %>% filter(Pdt %in% input$pdt)
  })


  output$map <- eventReactive(locsFil3(), {
    renderLeaflet({

      m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>% 
        addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
      m <- addMarkers(m, lng=c(12,21) , lat=c(37,67))
    })
  }
  )
}

Используемые пакеты: определено в Global.R: 

packages = c("shiny",
             "shinydashboard",
             "dplyr",
             "openxlsx",
             "stringr",
             "readr",
             "tidyr",
             "leaflet",
             "geosphere")

Как обновить код server.R для листового графика, чтобы он отображался только после того, как отфильтрованный кадр данных станет доступным?Спасибо!

1 Ответ

0 голосов
/ 26 февраля 2019

Трудно помочь без набора данных locsAgg.

Я бы попробовал 

locsFil3 <- eventReactive(list(locsFil2(), input$pdt), {
  locsFil2() %>% filter(Pdt %in% input$pdt)
}, ignoreInit = TRUE)

output$map <- renderLeaflet({
  req(locsFil3())
  m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>% 
    addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
  addMarkers(m, lng=c(12,21) , lat=c(37,67))
})

или 

locsFil3 <- reactive({
  locsFil2() %>% filter(Pdt %in% input$pdt)
})

 observeEvent(locsFil3(), {
   output$map <- renderLeaflet({
    m <- leaflet(options=leafletOptions(minZoom=1, maxZoom=5, zoomDelta=0.5)) %>% 
      addProviderTiles(providers$OpenStreetMap) %>% setView(lng=-93.85, lat=37.45, zoom=2)
    addMarkers(m, lng=c(12,21) , lat=c(37,67))
  })
}, ignoreInit = TRUE)

Если это не помогло, укажите locAggs (отредактируйте свой вопрос и вставьте вывод dput(locsAgg) или dput(head(locsAgg,20)), если этого достаточно).

...