CODEWITHSUNDEEP
rshinydashboardshiny-reactivityr-leaflet
JNN
JNN

Reputation: 131

Highlight marker from user input in leaflet - R Shiny

I'm trying to highlight points in my map based on the user input slider. If the point falls within a certain date range, change the color, and if it doesn't, default it to black.

#server
    shinyServer(function(input, output,session) {
   
        output$myMap <- renderLeaflet({
    
            leaflet() %>%
                addTiles()%>%
                addCircles(data=df,
                          # ~Longitude,
                          # ~Latitude,
                           group = "myMarkers",
                          label = ~htmlEscape(date))
        })
        
        observeEvent(input$selectVariable, {
        mydat$col_format<- ifelse(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2],'blue', 
    ifelse(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2], 'black',
    ifelse (mydat$Date, 'yellow')) )

            leafletProxy("myMap") %>%
                clearGroup("myMarkers") %>%
                addCircles(data = df[df$AnimlID == input$selectVariable, ],
                           #~ mydat$Longitd ,
                           #~ mydat$Latitud,
                           group = "myMarkers",
                           col = mydat$col_format,
                           label = ~htmlEscape(date)
                         )
        })
    })

#ui shinyUI(dashboardPage(#skin = "black",
    dashboardHeader(title = "Mapping Test", titleWidth = 350
),
    dashboardSidebar(width = 350,
        selectInput("selectVariable", label = h4("Select an D:"),
                                             choices =  unique(df$id)),
                   
                                 sliderInput("falltime","NSD Fall Slider:",
                                             min = min, max = max, value = c(min, max)),
                                verbatimTextOutput("dateText"),
                                 sliderInput("springtime","NSD Spring Slider:",
                                             min = min, max = max, value = c(min, max)),
                                 actionButton("submit", ("Submit"))),
    dashboardBody(fluidPage(
           box( plotOutput("plotlraj")),
           box( leafletOutput("myMap")),
           box(DT::dataTableOutput("Table"),
)
                
        ),
    )
))

With the above code I don't get any errors but the map is really slow to load and the points are always blue no matter what the date range the slider input is set to.

I've also tried adding this reactive block but again, all the points are blue even when I change the slider date range

    colorpal<- reactive({
    
        if(mydat$Date >= input$falltime[1] & mydat$Date <= input$falltime [2]){
            mydat[,'seasonColor']<-'#626262'
        }
        if(mydat$Date >= input$springtime[1] & mydat$Date <= input$springtime [2]){
            mydat[,'seasonColor']<-'#BAF218
'
        }

Upvotes: 0

Views: 501

Answers (1)

rbasa
rbasa

Reputation: 462

Using quakes so others can replicate.

In the filtered_df reactive function, manipulate your data.frame as you prefer. I prefer using dplyr, but am showing base R.

req() are used to ensure those inputs have values.

There is no need to have addCircles() in the leaflet instantiation. The observe reactive will take care of displaying the circles once filtered_df() is ready and every time it is changed after that.

For brevity, showing just the server code.

    output$myMap <- renderLeaflet({
        leaflet() %>%
            addTiles()
    })
    
    filtered_df <- reactive({
        req(input$depth_slider,
            input$mag_slider)
        
        filtered_df <- quakes[quakes$depth <= input$depth_slider,]
        filtered_df[filtered_df$mag <= input$mag_slider, 'Strength'] <- 'Weak'
        filtered_df[filtered_df$mag > input$mag_slider, 'Strength'] <- 'Strong'
        return(filtered_df)
    })
    
    observe({
        filtered_df <- filtered_df()
        pal <- colorFactor(c('Green', 'Red'), domain = filtered_df$Strength)
        
        leafletProxy('myMap') %>%
            clearGroup('myMarkers') %>%
            clearControls() %>%
            addCircles(
                data = filtered_df,
                lng = ~long,
                lat = ~lat,
                group = 'myMarkers',
                color = ~pal(Strength)
            ) %>%
            addLegend(
                pal = pal,
                values = filtered_df$Strength
            )
    })

Upvotes: 1

Related Questions