Question

首先，我有一个完美的解决方案here如何根据行创建一个Shiny传单地图和过滤器。

现在我想显示一个非常相似的地图，其中过滤器应用于列。绊倒了一点。

我希望按年创建美国成年人吸烟地图，用不同颜色突出显示％。

.csv格式的数据为here

Shapefile是here

目前，我的地图看起来像这样

这是我的代码：

# Set directory
setwd("C:/DC/R/Shiny/US Adult Smoking by State")

# Upload packages
library(ggthemes)
library(rgdal)
library(sp)
library(leaflet)
library(shinythemes)

# Read dataset
smoking <- read.csv("US adult smoking by state1.csv", header = TRUE)

# Leaflet map
states <- readOGR(dsn = "C:/DC/R/Cool datasets/US smoking", layer = 
"cb_2016_us_state_500k", 
              encoding = "UTF-8", verbose = FALSE)

# Merge data
# require(sp)! For spatial dataframe!
smoking.df <- merge(states, smoking, by.x = "NAME", by.y = "state")
class(smoking.df)

# Create palette
pal <- colorBin("Reds", c(0, 30), na.color = "#808080",
            alpha = FALSE, reverse = FALSE)


# UI
ui <- shinyUI(fluidPage(theme = shinytheme("united"),
                    titlePanel(HTML("<h1><center><font size=14> US Adult 
Smoking by State in 2015-2017</font></center></h1>")), 
                    sidebarLayout(
                      sidebarPanel(
                        selectInput("stateInput", label = h3("State"),
                                    choices = c("Choose state",
                                                "Alabama",
                                                "Alaska",
                                                "Arizona",
                                                "Arkansas",
                                                "California",
                                                "Colorado",
                                                "Connecticut",
                                                "Delaware",
                                                "Florida",
                                                "Georgia",
                                                "Hawaii",
                                                "Idaho",
                                                "Illinois",
                                                "Indiana",
                                                "Iowa",
                                                "Kansas",
                                                "Kentucky",
                                                "Louisiana",
                                                "Maine",
                                                "Maryland",
                                                "Massachusetts",
                                                "Michigan",
                                                "Minnesota",
                                                "Mississippi",
                                                "Missouri",
                                                "Montana",
                                                "Nebraska",
                                                "Nevada",
                                                "New Hampshire",
                                                "New Jersey",
                                                "New Mexico",
                                                "New York",
                                                "North Carolina",
                                                "North Dakota",
                                                "Ohio",
                                                "Oklahoma",
                                                "Oregon",
                                                "Pennsylvania",
                                                "Rhode Island",
                                                "South Carolina",
                                                "South Dakota",
                                                "Tennessee",
                                                "Texas",
                                                "Utah",
                                                "Vermont",
                                                "Virginia",
                                                "Washington",
                                                "West Virginia",
                                                "Wisconsin",
                                                "Wyoming"
                                                ),
                                    selected = "Choose state"),
                        selectInput("stateInput", label = h3("State"),
                                    choices = c("Choose year",
                                                "2015",
                                                "2016",
                                                "2017"),
                                    selected = "Choose year")),
                      mainPanel(leafletOutput(outputId = 'map', height = 
800) 
                          ))
                    ))



# SERVER
server <- shinyServer(function(input, output) {
output$map <- renderLeaflet({
leaflet(smoking.df) %>% 
  addProviderTiles(providers$Stamen.TonerLite) %>% 
  setView(lng = -98.583, lat = 39.833, zoom = 4) #%>% 

})
# observers

# selected state
selectedState <- reactive({
smoking.df[smoking.df$NAME == input$stateInput, ] 
})

observe({
state_popup <- paste0("<strong>State: </strong>", 
                      selectedState()$NAME, 
                      "<br><strong>% of smoking adults in 2015: </strong>",
                      selectedState()$adult_smoking_2015,
                      "<br><strong>% of smoking adults in 2016: </strong>",
                      selectedState()$adult_smoking_2016,
                      "<br><strong>% of smoking adults in 2017: </strong>",
                      selectedState()$adult_smoking_2017)

leafletProxy("map", data = selectedState()) %>%
  clearShapes() %>%
  addPolygons(fillColor = "orange",
              popup = state_popup,
              color = "#BDBDC3",
              fillOpacity = 0.8,
              weight = 1)
})

# selected year
selectedYear <- reactive({
smoking.df[smoking.df$adult_smoking_2015 == input$yearInput &
           smoking.df$adult_smoking_2016 == input$yearInput &
           smoking.df$adult_smoking_2017 == input$yearInput,] 
})

observe({
state_popup1 <- paste0("<strong>State: </strong>", 
                      selectedState()$NAME)

leafletProxy("map", data = selectedYear()) %>%
  clearShapes() %>%
  addPolygons(fillColor = ~pal(selectedYear()$yearInput),
              popup = state_popup1,
              color = "#BDBDC3",
              fillOpacity = 0.8,
              weight = 1)
})


})


# Run app! 
shinyApp(ui = ui, server = server)

所以，我的假设是我搞砸了inputYear，还有传单地图中的调色板。几年是专栏，我现在有点难以理解我的错误在哪里。

非常感谢所有提示。希望我的问题也能帮助其他人。

我理想的结果，我在下面的传单中创建。我想在过滤器中更改年份并在地图上接收更改。

Answer 1

初步解决方案（不是我的，来自其他聪明人）。另外，shapefile被geojson一个替换。

# Upload packages
library(rgdal)
library(sp)
library(leaflet)
library(geojsonio)
library(shinythemes)
library(shiny)

# Read dataset
smoking <- read.csv("US adult smoking by state1.csv", header = TRUE)

# Leaflet map
# states <- readOGR(dsn = ".", layer = 
#                    "cb_2016_us_state_500k", 
#                   encoding = "UTF-8", verbose = FALSE)

states <- geojson_read("gz_2010_us_040_00_500k.json",what = "sp")

# Merge data
# require(sp)! For spatial dataframe!
smoking.df <- merge(states, smoking, by.x = "NAME", by.y = "state")


# UI
ui <- shinyUI(fluidPage(theme = shinytheme("united"),
                    titlePanel(HTML("<h1><center><font size=14> US Adult 
                                    Smoking by State in 2015-2017</font>
</center></h1>")), 
                    sidebarLayout(
                      sidebarPanel(
                        selectizeInput(
                          "stateInput", 'State', choices = "", multiple = 
FALSE,
                          options = list(
                            placeholder = 'Please select a state from 
below')
                        )
                        ,
                        selectInput("yearInput", label = h3("Year"),
                                    choices = c("Choose year", "2015", # 
 Choose year was added!
                                                "2016",
                                                "2017"))),
                      mainPanel(leafletOutput(outputId = 'map', height = 
                                                800) 
                      ))
                    ))


# SERVER
server <- shinyServer(function(input, output, session) {

updateSelectizeInput(session, "stateInput", choices = smoking.df$NAME,
                   server = TRUE)
# selected state
selectedState <- reactive({
smoking.df[smoking.df$NAME == input$stateInput, ] 
})
# selected year
selectedYear <- reactive({switch(input$yearInput, 
                               "2015"=smoking.df$adult_smoking_2015, 
                               "2016"=smoking.df$adult_smoking_2016, 
                               "2017"=smoking.df$adult_smoking_2017)
})
pal2 <- colorNumeric(palette = "Reds", domain=NULL)

output$map <- renderLeaflet({
leaflet(smoking.df) %>% 
  addProviderTiles(providers$Stamen.TonerLite) %>% 
  setView(lng = -98.583, lat = 39.833, zoom = 4) %>%
  addPolygons(data = smoking.df ,fillColor = ~pal2(selectedYear()),
              popup = paste0("<strong>State: </strong>", 
                             smoking.df$NAME),
              color = "#BDBDC3",
              fillOpacity = 0.8,
              weight = 1)

  })

  observeEvent(input$stateInput, {
  state_popup <- paste0("<strong>State: </strong>", 
                      selectedState()$NAME, 
                      "<br><strong>% of smoking adults in 2015: </strong>",
                      selectedState()$adult_smoking_2015,
                      "<br><strong>% of smoking adults in 2016: </strong>",
                      selectedState()$adult_smoking_2016,
                      "<br><strong>% of smoking adults in 2017: </strong>",
                      selectedState()$adult_smoking_2017)

    leafletProxy("map", data = selectedState()) %>%
  clearGroup(c("st.ate")) %>%
  addPolygons(group ="st.ate",fillColor = "orange",
              popup = state_popup,
              color = "#BDBDC3",
              fillOpacity = 0.8,
              weight = 5)
})

})

# Run app! 
shinyApp(ui = ui, server = server)

当前输出：

当前问题：

geojson的地图仍然很慢，更改年份的时间为2秒，正在重绘。
地图上没有任何选择的灰色。有任何想法吗？

会让你发布，会尝试再添加一个过滤器。

闪亮的传单地图 - 按列过滤数据，而不是按行过滤数据

1 个答案: