logo标签列表

如何在滑动条（交互式地图）中使用Shiny Leaflet过滤年份

rshinyr-leaflet
3
library(shiny)
library(leaflet)
library(RMySQL)
library(DBI)

data <- function(con){
    con <- dbConnect(MySQL(), dbname="", host="localhost",
                     port = , user="",
                     password="")
    dbSendQuery(con, "SEt NAMES euckr")
    d <- dbGetQuery(con, "select * from accidents")
    dbDisconnect(con)
}

原始数据（d）包含信息：事故发生地点、事故发生年份、事故发生数量、经度、纬度等等...

这是UI界面。

ui <- navbarPage("Interactive Map",
                 tabPanel("Map",
                          leafletOutput("m", height=800),
                          tags$style("
                                     #controls {
                                     backgropund-color: #ddd;
                                     opacity: 0.7;
                                     }
                                     #controls:hover{
                                     opacity: 1;
                                     }
                                     "),
                          absolutePanel(id = "controls",  class="panel panel-default",
                                        fixed =TRUE, draggable = TRUE, top=60, left="auto",
                                        right=20, bottom ="auto", width=250, height=450,
                                        sliderInput("year",
                                                    "years:",
                                                    min=min(d$acci_year),
                                                    max=max(d$acci_year),
                                                    value=range(d$acci_year),
                                                    step=1, sep=""))))

这是服务器

server <- function(input, output, session){
    filteredData <- reactive({
        d[d$acci_year >= input$year[1] & d$acci_year <= input$year[2],]
    })
    d_colour <- colorFactor("viridis", d$acci_type)
    
    output$m <- renderLeaflet({
        
        leaflet(d) %>% 
            setView(lng = 126.97806, lat=37.56667, zoom=13) %>%
            addTiles() %>% 
            addCircles(lng=~d$longitude, lat=~d$latitude, color=~d_colour(d$acci_type), radius=20, 
                       popup=paste0("<br>accident place:", d$accident_address, "<br>accident year:", d$acci_year, "<br>발생건수:", d$발생건수,
                                    "<br>사상자수:", d$사상자수, "<br>사망자수:", d$사망자수,
                                    "<br>중상자수:", d$중상자수, "<br>경상자수:", d$경상자수,
                                    "<br>부상자수:", d$부상자수)) %>% 
            addLegend(position = "bottomleft",
                      title = "types of accident",
                      pal = d_colour, values = ~d$acci_type, opacity = 1)
    })
    
    d_colour <- colorFactor("viridis", d$acci_type)
    observe({
        
        leafletProxy("m", data=filteredData()) %>% 
            clearShapes() %>% 
            addCircles(lng=~d$longitude, lat=~d$latitude, color=~d_colour(d$acci_type), radius=20,
                       popup=paste0("<br>accident place:", d$accident_address, "<br>accident year:", d$acci_year, "<br>발생건수:", d$발생건수,
                                    "<br>사상자수:", d$사상자수, "<br>사망자수:", d$사망자수,
                                    "<br>중상자수:", d$중상자수, "<br>경상자수:", d$경상자수,
                                    "<br>부상자수:", d$부상자수))
    })
}

shinyApp(ui=ui, server=server)

我替你把一些变量名从韩文改为英文！但由于这个函数的问题，我已经一个星期无法进行下一步操作了。非常感谢你的回复！！

当您在控制台中键入d$사고발생지时会发生什么？ - KmnsE2
@KmnsE2 啊，它指的是数据d中的列“事故发生地点(accident happen place)” - 이훈석
我的问题已解决：在 observe 中将 d$ 更改为 filteredData()$ 的弹出窗口中。 - 이훈석
1个回答
2

更新

你的代码中存在错误，你正在替换地图上的所有点，因此你的地图不会随着滑块输入而改变。你需要将lng=~d$longitude, lat=~d$latitude, 更改为：lng=~longitude, lat=~latitude, 这意味着你不想在你的地图中添加所有的圆圈~d$longitude lat=~d$latitude，而是只添加由滑块输入过滤的圆圈lng=~longitude lat=~latitude。

当你使用filteredData()进行过滤时，你不想要d中的所有信息，例如d$lat，你只想要由SliderInput过滤的信息：~lat。

旧回答

你的代码中的错误在这里：

 leafletProxy("m", data=filteredData()) %>% 
            clearShapes() %>% 
 addCircles(lng=~d$longt, lat=~d$lat, color=~d_colour(d$acci_type), # this line

你正在用创建地图的相同点（d$longt和d$lat）替换点，因此地图不会改变。
为解决此问题，您需要使用filteredData()列来放置点：
 leafletProxy("m", data=filteredData()) %>%  
      clearShapes() %>% clearMarkers()  %>% 
      addCircles(lng=~longt, lat=~lat,  #don't forget ~ to specify that the column comes from filteredData()
color=~d_colour(acci_type),

这里有一个完整的可复现的例子：reproducible example：
library(shiny)
library(leaflet)

d=data.frame(
  acci_year=c(2012,2013,2014,2015),
  longt=c(126.97806,126.97822126,125.97806,124.97806),
  lat=c(37.56667,35.56667,38.56667,37.56667),
  acci_type=c("low","high","medium","high"),
  accident_happen_place=c("word1","word2","word3","word4"),
  accident_2 =c("anotherword1","anotherword2","anotherword3","anotherword4"),
  accident_3=c("otheword1","otheword2","otheword3","otheword4"),
  accident_4 =c("example1","example2","example3","example4"),
  accident_5 =c("anotherexample1","anotherexample2","anotherexample3","anotherexample4"),
  accident_6 =c("onemoreexample1","onemoreexample2","onemoreexample3","onemoreexample4"),
  accident_7 =c("ex1","ex2","ex3","ex4"),
  accident_8 =c("2_ex1","2_ex2","2_ex3","2_ex4")
)
ui <- navbarPage("Interactive Map",
                 tabPanel("Map",
                          leafletOutput("m", height=800),
                          tags$style("
                                     #controls {
                                     backgropund-color: #ddd;
                                     opacity: 0.7;
                                     }
                                     #controls:hover{
                                     opacity: 1;
                                     }
                                     "),
                          absolutePanel(id = "controls",  class="panel panel-default",
                                        fixed =TRUE, draggable = TRUE, top=60, left="auto",
                                        right=20, bottom ="auto", width=250, height=450,
                                        sliderInput("year",
                                                    "years:",
                                                    min=min(d$acci_year),
                                                    max=max(d$acci_year),
                                                    value=2012:2019,
                                                    step=1, sep=""))))
server <- function(input, output, session){
  
  filteredData <- reactive({
    d[d$acci_year >= input$year[1] & d$acci_year <= input$year[2],]
  })
  d_colour <- colorFactor("viridis", d$acci_type)
  
  output$m <- renderLeaflet({
    
    leaflet(d) %>% 
      setView(lng = 126.97806, lat=37.56667, zoom=7) %>%
      addTiles() %>% 
      addCircles(lng=~d$longt, lat=~d$lat, color=~d_colour(d$acci_type), radius=20, 
                 popup=paste0("<br>사고장소:", d$accident_happen_place, "<br>accident_2:", d$accident_2, "<br>accident_3:", d$accident_3,
                              "<br>accident_4:", d$accident_4, "<br>accident_5:", d$accident_5,
                              "<br>accident_6:", d$accident_6, "<br>accident_7:", d$accident_7,
                              "<br>accident_8:", d$accident_8)) %>% 
      addLegend(position = "bottomleft",
                title = "사고유형",
                pal = d_colour, values = ~d$acci_type, opacity = 1)
    })
  
  
  d_colour <- colorFactor("viridis", d$acci_type)
  observe({
   
   
    leafletProxy("m", data=filteredData()) %>% 
      clearShapes() %>% 
      addCircles(lng=~longt, lat=~lat, color=~d_colour(acci_type), radius=20, 
                 popup=paste0("<br>사고장소:", d$accident_happen_place, "<br>발생년도:", d$accident_2, "<br>accident_3:", d$accident_3,
                              "<br>accident_4:", d$accident_4, "<br>accident_5:", d$accident_5,
                              "<br>accident_6:", d$accident_6, "<br>accident_7:", d$accident_7,
                              "<br>accident_8:", d$accident_8) ) 
  } )
}

shinyApp(ui, server)

您不需要两次使用dbGetquery：

d <- dbGetQuery(con, "select * from accidents"
dbGetQuery(con,d)

那种方式已经很完美了：
d <- dbGetQuery(con, "select * from accidents")
谢谢你的回答！！但是，我遇到了这个错误：addcircles函数找不到。 - 이훈석
用addCircles替换addcircles，R区分大小写。 - KmnsE2
我重新上传了问题。 - 이훈석
我理解你的意思，但是没有'longitude'和'latitude'变量。 - 이훈석
让我们在聊天中继续这个讨论。 - KmnsE2
显示剩余5条评论
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接