if-statementshinyleaflettmap

Highlight selected data table entries on interactive map in r shiny


I am creating an application using r shiny where a user can add public fruit tree locations to a map. I would like to make is so that a user can select an entry in the data table ( made with DT package) and have it appear highlighted on the interactive map. I would like to make it so only the point representing the selected value changes (shape, size, color or whatever) while every other point remains the same.

here is the code for my shiny application with the part I am having trouble with highlighted.

library(dplyr)
library(shiny)
library(leaflet)
library(tmap)
library(sf)
library(mapview)


# an orginal data set for starting the app
dat <- data.frame(lat = c(48.7323,48.7308,
                          48.7301,48.7276,
                          48.7246,48.7323,
                          48.7211),
                  long = c(-122.4928,-122.4940,
                           -122.4942,-122.4939,
                           -122.4958,-122.4975,
                           -122.4946),
                  species = c("Apple", "Apple",
                              "Pear", "Plum",
                              "Fig", "Plum",
                              "Pear"),
                  status = c(rep("Confirmed",6), "Unconfirmed") )



ui <- fluidPage(
  
  titlePanel("Public Fruit Trees"),
  
  sidebarLayout(
    sidebarPanel(
      numericInput(inputId = "lat",
                   label = "Latitude DD",
                   value = 48.7211,step = 1e-3),
      numericInput(inputId = "long",
                   label = "Longitude DD",
                   value=-122.4942,step = 1e-3),
      selectInput(inputId = "species", label = "Species",
                  choices = c("Apple","Pear","Fig","Peach","Other")),
      actionButton(inputId = "addObservation",
                   label = "Add tree to database"),
      uiOutput("verifyObservation"),
      # adding action button for verification 
      # actionButton(inputId = "verifyObservation",
                   # label = "Verify Tree Location ")
    ),
    mainPanel(
      # the main map
      tmapOutput(outputId = "tmapMap"),
      # and a table just for diagnostics probably
      DT::dataTableOutput("updatedData"),
      
      verbatimTextOutput("y") # this is for checking that rows selected works
    )
  )
)

server <- function(input, output, session) {
  
  # this is a a reactiveValues object that gets updated as the user
  # add new rows
  theData <- reactiveValues()
  theData$dat <- dat
  
  # this makes the tmap and returns it
  output$tmapMap <- renderTmap({
    dat2plot <- theData$dat
    # convert to sf for plotting
    dat2plot <- st_as_sf(dat2plot, coords = c("long","lat"), crs=st_crs("EPSG:4326"))
    # get the data from the reactve
  
###  
HERE'S THE HARD PART
###
    map1 <- tm_shape(dat2plot) +
      tm_dots(col= "species", alpha=0.8,size = 0.1) +
      tm_legend(show = TRUE) +
      tm_view(set.zoom.limits = c(14,16))
    map1
    if(length(selected())==1) tm_shape(dat2plot[selected(),]) + tm_dots(alpha= 0.9, size=0.2)
  })
###
####
  
  # and here is the logic that will add rows to the data from the user
  observeEvent(input$addObservation,{
    to_add <- data.frame(lat = input$lat,
                         long = input$long,
                         species = input$species,
                         status = "Unconfirmed"
    )
    theData$dat <- rbind(theData$dat,to_add) # adding new data
  })
  
  output$updatedData <- DT::renderDataTable(
    theData$dat, selection = 'single'
  )
  # display selected data
selected <- reactive({input$updatedData_rows_selected})
output$y = renderPrint(theData$dat[selected(), 4])
  
  # update numeric input with click 
  observeEvent(input$tmapMap_click, {
    updateNumericInput(
      inputId = "long",
      value = input$tmapMap_click$lng
    )
    
    updateNumericInput(
      inputId = "lat",
      value = input$tmapMap_click$lat
      
      # add action button conditionally 
    )  
  }) 
      
 
    output$verifyObservation <- renderUI({
      if(theData$dat[selected(), 4] == "Unconfirmed"){
        actionButton(inputId = "verifyObservation",
                     label = "Verify Tree Location ")
      }
    })
    observeEvent(input$verifyObservation,{
      theData$dat[selected(), 4] = "Confirmed"
    })
  
  
}


shinyApp(ui = ui, server = server)

As you can see, I have tried creating a condition where if the selected() vector has a length of 1 (or if something is selected) then the shape will display differently for the map. But this creates a whole new map with only the selected point. I want the shape of the point representing the selected table entry to change shape on the same map. Thanks so much for your help!


Solution

  • I figured it out. It's kinda ugly. I can create a vector of the data table and observe the selection of a row. I can create a vector for this selection.

    output$updatedData <- DT::renderDataTable(theData$dat, selection = 'single')
    
    observeEvent(input$updatedData_rows_selected, {
    selectedRow <- input$updatedData_rows_selected
    output$selectedRow <- renderPrint(selectedRow)
    

    I can glean lat long coords from the selected row

        if (!is.null(selectedRow)) {
        selectedLat <- theData$dat[selectedRow, "lat"]
        selectedLong <- theData$dat[selectedRow, "long"]
    

    Create a custom icon to highlight observations with

          greencircle <- makeIcon(
          iconUrl = "https://clipground.com/images/green-circle-clipart- 
           7.jpg",
          iconWidth = 15, iconHeight = 15,
          iconAnchorX = 0, iconAnchorY = 0,
       )
    

    And now I can add a marker using leafletProxy and use clearImages to clear the icon every time I select a new entry.

        leafletProxy("tmapMap") %>%  
        addMarkers(lat = selectedLat, lng = selectedLong, icon = 
        greencircle, layerId = 'HL' ) 
        
        leafletProxy("tmapMap") %>% 
          clearImages() 
       
      }
    })