如何在一个闪亮的应用程序

时间:2016-10-23 20:11:01

标签: r shiny leaflet

请注意,此问题已发布at the R Shiny Google Group

Leaflet for R/ Shiny Integration documentation之后,我使用leafletProxy函数获得了不必要/意外的行为。

在下面的应用中,我希望随着输入$选项的更改,圆圈标记会显示/消失。

反应式df'enteredData'似乎工作正常。

我是否错误地使用了leafletProxy()或clearShapes()?

library(shiny)
library(dplyr)
library(leaflet)


my_df <- data.frame(lat = 34.72 + rnorm(1000, sd = .18), 
                    lng = -92.5 + rnorm(1000, sd = .33), 
                    category = c(rep("A", 300), rep("B", 300), rep("C", 400)))

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", height = '100%', width = '100%'),
  absolutePanel(top = 10, right = 10, 
                checkboxGroupInput("choices", "Choices", choices =     list("A","B","C"), selected = c("A","B","C")),
                verbatimTextOutput("my_rows")


  )
)


server <- function(input, output) {

  filteredData <- reactive( my_df %>% filter(category %in% input$choices) )

    output$map <- renderLeaflet({ leaflet() %>% addTiles() %>% setView(lat =     34.72, lng = -92.5, zoom = 9) })

    observe({

      leafletProxy("map", data = filteredData()) %>% clearShapes() %>% addCircleMarkers(radius = 6, weight = 1, fillColor = "red", fillOpacity = 0.3)

    })

    output$my_rows <- renderPrint({ filteredData() %>% nrow() })
}

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

您的第一个问题是使用clearMarkers()而不是clearShapes()解决的。

至于你指出的另一个问题,leaflet与空(和NA)数据斗争。当您取消选择所有值时,data.frame显然会变空。对此进行简单检查以阻止leaflet尝试绘制它将解决此问题。

我在这里使用if - else做检查。

library(shiny)
library(dplyr)
library(leaflet)

my_df <- data.frame(lat = 34.72 + rnorm(1000, sd = .18), 
                    lng = -92.5 + rnorm(1000, sd = .33), 
                    category = c(rep("A", 300), rep("B", 300), rep("C", 400)))

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", height = '100%', width = '100%'),
    absolutePanel(top = 10, right = 10, 
                 checkboxGroupInput("choices", "Choices"
                                     , choices = list("A","B","C")
                                     , selected = c("A","B","C")),
                 verbatimTextOutput("my_rows")
    )
)

server <- function(input, output) {

    filteredData <- reactive({ 
        my_df %>% filter(category %in% input$choices) 
        })

    output$map <- renderLeaflet({ 
        leaflet() %>% 
            addTiles() %>% 
            setView(lat = 34.72, lng = -92.5, zoom = 9) 
        })

    observe({

        df <- filteredData()

        ## check for empty dataframe
        if(nrow(df) == 0){
            leafletProxy("map", data = df) %>% 
            clearMarkers()
        }else{
            leafletProxy("map", data = df) %>% 
                clearMarkers() %>% 
                addCircleMarkers(radius = 6, weight = 1
                                 , fillColor = "red", fillOpacity = 0.3)
        }

    })

    output$my_rows <- renderPrint({ 
        filteredData() %>% 
            nrow() 
        })
}

shinyApp(ui = ui, server = server)