How to filter years in shiny leaflet in sliderbar (Interactive map)

Question

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)
}

raw data(d) have informations : accident happen place, accident happen year, accident occur number, longitude, latitude, etc...

This is 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=""))))

This is server

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)

I changed some variables korean into english for you ! I can't go for next step because of this function for a week.. Thanks for your answering really really much !!

@KmnsE2 Ah, it means column '사고발생지(accident happen place)' of data d — 이훈석, Nov 15 '20 at 14:53
My question completed : change d$ -> filteredData()$ in popup in observe !! — 이훈석, Nov 15 '20 at 17:23

KmnsE2 · Answer 1 · 2021-02-21T01:18:03.533

UPDATE

The error persist in your code you are replacing all the points in the map for that reason your map dont change with sliderInput. you need to change lng=~d$longitude, lat=~d$latitude, by: lng=~longitude, lat=~latitude, Which means that you dont want to add all the circles in your map ~d$longitude lat=~d$latitude but only the filtered by sliderinput lng=~longitude lat=~latitude.

When you filter with filteredData() you dont want all the information in d like d$lat for example do you only want the filtered information by the SliderInput: ~lat.

OLD ANSWER

The error in your code is here:

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

you are replacing the points by the same points that created the map (d$longt and d$lat), for that reason the map dont change.

To solve this you need to placing the point by the filteredData() columns:

 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),

Here a full 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)

You dont need to use dbGetquery twice:

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

That way is already perfect:

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

Thanks for your answering really !! but, I got this error : Error in addcircles: can't find function "addcircles" — 이훈석, Nov 15 '20 at 15:42
change your filteredData by mine filteredData <- reactive({ d[d$acci_year >= input$year[1] & d$acci_year <= input$year[2],] }) . Works? — KmnsE2, Nov 15 '20 at 15:55
I see your new question but it not a regular behavior create a new post for this, you only need to click in edit in this post. just copy and paste your new question — KmnsE2, Nov 15 '20 at 16:18
I understand what you are saying but There is no 'longitude' and 'latitude' variable — 이훈석, Nov 15 '20 at 16:32
try my old answer lng=~longt, lat=~lat. i only change to ~longitude because your new question has lng=~d$longitude, lat=~d$latitude.. You only need to erase "d$" in your code — KmnsE2, Nov 15 '20 at 16:35
i got this : Error in guessLatLongCols: Couldn't infer longitude/latitude columns — 이훈석, Nov 15 '20 at 16:37
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/224595/discussion-between-kmnse2-and-). — KmnsE2, Nov 15 '20 at 16:39

How to filter years in shiny leaflet in sliderbar (Interactive map)

1 Answers1

UPDATE

OLD ANSWER