Trying to update Spatial Polygon Dataframe using reactive expression

Question

I have written code for inputs and a leaflet map that work independently, but error when I try to get them to be dependent on each other. Overall, I am trying to allow these 4 sliders to be adjusted to provide "weights" which are then used to calculate new fields in my Spatial Polygon Dataframe. I then want to take that updated file and put it into Leaflet. I then want to be able to further filter the polygons by score with another slider.

I have followed this RStudio Tutorial closely to format my code. Basically, I'm using reactive expressions to do my calculations, defining them as a variable (eg NewVar <- reactive({...})), and then trying to use that variable in subsequent code in the data argument (eg data = NewVar()). My code would error when I did that and also when I referred to columns with ~ (eg values = ~Column). But I couldn't refer to columns using $Column because it is a function now, not a Spatial Polygon DataFrame. I tried to fix this by, within the reactive function, assigning the function to a variable (eg SPDF <- NewVar()) and then using values = SPDF$Column. That is also erroring (Warning: Error in <-: invalid (NULL) left side of assignment) and (Warning: Error in : trying to get slot "data" from an object of a basic class ("numeric") with no slots).

I'm pasting the entire code below. Please do let me know if anything stands out - or to help me understand how to properly call on a column from a reactive expression that did calculations on a Spatial Polygon Dataframe.

# Build UI
ui <- fluidPage(

titlePanel("UNCWI Score Evaluation"),

sidebarLayout(

sidebarPanel(
sliderInput(inputId = "weightir", label = "Weight for IR",
          value = 0.19, min = 0, max = 1),
sliderInput(inputId = "weightul", label = "Weight for Upland Protection",
          value = 0.31, min = 0, max = 1),
sliderInput(inputId = "weightva", label = "Weight for Vulnerable Areas",
          value = 0.21, min = 0, max = 1),
sliderInput(inputId = "weightwsc", label = "Weight for WSC",
          value = 0.29, min = 0, max = 1),
actionButton("run", "Run")
),

mainPanel(
leafletOutput("map"),
sliderInput("range", "Scores", min = 0.0, max= 10.0, value = as.numeric(c("0.0", "10.0")), step = 0.1),
actionButton("export", "Export Shapefile")
)
))

# Render Outputs
server <- function(input, output) {
defaultData <- eventReactive(input$run, {
# Multiply by Weights
merge.proj@data$IR_WtScore <- round(merge.proj@data$MEAN_IR_Sc*input$weightir, digits = 1)
merge.proj@data$UL_WtScore <- round(merge.proj@data$MEAN_UL_Sc*input$weightul, digits = 1)
merge.proj@data$VA_WtScore <- round(merge.proj@data$MEAN_VA_Sc*input$weightva, digits = 1)
merge.proj@data$WSC_WtScore <- round(merge.proj@data$MEAN_WSC_S*input$weightwsc, digits = 1)
# Find Total Score
merge.proj@data$Total_Score <- merge.proj@data$IR_WtScore + merge.proj@data$UL_WtScore + merge.proj@data$VA_WtScore + merge.proj@data$WSC_WtScore
})

# Plot with leaflet

# Palette for map
colorpal <-  reactive({
merge.proj <- defaultData()  
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})

# Label Option for map
labels <- reactive({  
merge.proj <- defaultData()  
lsprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score:</strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})

# Render Default Map
output$map <- renderLeaflet ({leaflet() %>% 
        merge.proj <- defaultData()
        pal <- colorpal()
        lab <- labels()
  addTiles() %>%
  addPolygons(data=merge.proj,
              fillColor = ~pal(Total_Score),
              weight = 1,                              
              opacity = 1,
              color = "white",
              dashArray = "3",
              fillOpacity = 0.7,
              highlight = highlightOptions(
                weight = 3,                              
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE),
              label = lab,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto")) %>%
  addLegend(position = "bottomleft",pal = pal, opacity = 0.7, values = merge.proj$Total_Score, title = "<strong>Total Score</strong>")
})

# Update map to parcel score slider

# Subset data
  filteredData <- reactive({
    merge.proj <- defaultData()
merge.proj[merge.proj@data$Total_Score >= input$range[1] & merge.proj@data$Total_Score <= input$range[2],]
})


# New Palette
  colorpal2 <-  reactive({
    merge.proj <- filteredData()  
    colorNumeric(palette = "YlOrRd",
      domain = merge.proj$Total_Score)
  })

# Label Option
  labels2 <- reactive({  
    merge.proj <- filteredData()  
    sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score: </strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})

#Leaflet Proxy
  observe({
    merge.proj <- filteredData()
    pal2 <- colorpal2()
    lab2 <- labels2()

    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addPolygons(
        fillColor = ~pal2(Total_Score),
        weight = 1,                              
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        highlight = highlightOptions(
          weight = 3,                             
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label = lab2,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal", padding = "3px 8px"),
          textsize = "15px",
          direction = "auto"))
})

#Update Legend
observe({
    proxy <- leafletProxy("map", data = filteredData())

    pal2 <- colorpal2()
    proxy %>% clearControls()
    proxy %>% addLegend(position = "bottomleft",pal = pal2, opacity = 0.7, values = ~Total_Score, title = "<strong>Total Score</strong>")
})

# Export new shapefile
observeEvent(input$export, {
    merge.proj <- filteredData()
writeOGR(merge.proj, dsn = "Data", layer = "UNCWI_Output", driver = "ESRI Shapefile")
})
}

shinyApp(ui = ui, server = server)

Answer 1

I got my code to work by moving leaflet() %>% below where I define the variables in the renderLeaflet({}) portion of the code. See below:

# Build UI
ui <- fluidPage(

titlePanel("UNCWI Score Evaluation"),

sidebarLayout(

sidebarPanel(
sliderInput(inputId = "weightir", label = "Weight for IR",
          value = 0.19, min = 0, max = 1),
sliderInput(inputId = "weightul", label = "Weight for Upland Protection",
          value = 0.31, min = 0, max = 1),
sliderInput(inputId = "weightva", label = "Weight for Vulnerable Areas",
          value = 0.21, min = 0, max = 1),
sliderInput(inputId = "weightwsc", label = "Weight for WSC",
          value = 0.29, min = 0, max = 1),
actionButton("run", "Run")
),

mainPanel(
leafletOutput("map"),
sliderInput("range", "Scores", min = 0.0, max= 10.0, value = as.numeric(c("0.0", "10.0")), step = 0.1),
actionButton("export", "Export Shapefile")
)
))

# Render Outputs
server <- function(input, output) {
defaultData <- eventReactive(input$run, {
# Multiply by Weights
merge.proj@data$IR_WtScore <- round(merge.proj@data$MEAN_IR_Sc*input$weightir, digits = 1)
merge.proj@data$UL_WtScore <- round(merge.proj@data$MEAN_UL_Sc*input$weightul, digits = 1)
merge.proj@data$VA_WtScore <- round(merge.proj@data$MEAN_VA_Sc*input$weightva, digits = 1)
merge.proj@data$WSC_WtScore <- round(merge.proj@data$MEAN_WSC_S*input$weightwsc, digits = 1)
# Find Total Score
merge.proj@data$Total_Score <- merge.proj@data$IR_WtScore + merge.proj@data$UL_WtScore + merge.proj@data$VA_WtScore + merge.proj@data$WSC_WtScore
})

# Plot with leaflet

# Palette for map
colorpal <-  reactive({
merge.proj <- defaultData()  
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})

# Label Option for map
labels <- reactive({  
merge.proj <- defaultData()  
lsprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score:</strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})

# Render Default Map
output$map <- renderLeaflet ({
        merge.proj <- defaultData()
        pal <- colorpal()
        lab <- labels()
  leaflet() %>% 
  addTiles() %>%
  addPolygons(data=merge.proj,
              fillColor = ~pal(Total_Score),
              weight = 1,                              
              opacity = 1,
              color = "white",
              dashArray = "3",
              fillOpacity = 0.7,
              highlight = highlightOptions(
                weight = 3,                              
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE),
              label = lab,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto")) %>%
  addLegend(position = "bottomleft",pal = pal, opacity = 0.7, values = merge.proj$Total_Score, title = "<strong>Total Score</strong>")
})

# Update map to parcel score slider

# Subset data
  filteredData <- reactive({
    merge.proj <- defaultData()
merge.proj[merge.proj@data$Total_Score >= input$range[1] & merge.proj@data$Total_Score <= input$range[2],]
})


# New Palette
  colorpal2 <-  reactive({
    merge.proj <- filteredData()  
    colorNumeric(palette = "YlOrRd",
      domain = merge.proj$Total_Score)
  })

# Label Option
  labels2 <- reactive({  
    merge.proj <- filteredData()  
    sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score: </strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})

#Leaflet Proxy
  observe({
    merge.proj <- filteredData()
    pal2 <- colorpal2()
    lab2 <- labels2()

    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addPolygons(
        fillColor = ~pal2(Total_Score),
        weight = 1,                              
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        highlight = highlightOptions(
          weight = 3,                             
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        label = lab2,
        labelOptions = labelOptions(
          style = list("font-weight" = "normal", padding = "3px 8px"),
          textsize = "15px",
          direction = "auto"))
})

#Update Legend
observe({
    proxy <- leafletProxy("map", data = filteredData())

    pal2 <- colorpal2()
    proxy %>% clearControls()
    proxy %>% addLegend(position = "bottomleft",pal = pal2, opacity = 0.7, values = ~Total_Score, title = "<strong>Total Score</strong>")
})

# Export new shapefile
observeEvent(input$export, {
    merge.proj <- filteredData()
writeOGR(merge.proj, dsn = "Data", layer = "UNCWI_Output", driver = "ESRI Shapefile")
})
}

shinyApp(ui = ui, server = server)

Answer 2

This is a problem I have seen before. Basically, the most recommended Shiny design pattern, while simple and easy to understand, kind of leads to these deadends. I prefer using reactiveValues to get around this, as this gives you the flexiblity you are looking for.

I can't work with your code because it is not a complete sample (merge.proj is not defined anywhere).

But I modified the example you said you "followed closely" to use reactiveValues so you can see what I mean.

library(shiny)
library(leaflet)

r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

ui <- fluidPage(
  leafletOutput("mymap"),
  p(),
  actionButton("recalc", "New points")
)

server <- function(input, output, session) {

  # initialize our leaflet map into a reactive value
  rv <- reactiveValues(lmap=leaflet() %>% addProviderTiles(providers$Stamen.TonerLite,
                                          options = providerTileOptions(noWrap = TRUE))

  points <- eventReactive(input$recalc, {
     cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)

     # now modify our leaflet map with our new points
     # note we could do anything with our map, we have access to all its columns
     rv$lmap <- addMarkers(rv$lmap,data=points())
  }, ignoreNULL = FALSE)

  output$mymap <- renderLeaflet({
     # reactively render the map when it changes
     rv$lmap
  })
}

shinyApp(ui, server)

The logic is more complicated than just using purely reactive values, but I find it leads to a more flexible structure.

In your case you need to initialize merge.proj into that reactiveValues list (I think). Note also that you can have more than one element in that list, they are quite flexible.