Report theme amount for each planning unit

[edwardsmarc]

Feedback from users suggests access to theme values in the solution is crucial. They want to know why a certain planning unit was selected and which theme goals it is contributing too. This is useful because it lets the users know if a planning unit is contributing to many species goals (i.e. its good for biodiversity in general) or just a single species such as a SAR.

We should discuss where best to communicate this information. It could be done in the app, or outside as a post-hoc analysis, possibly to be viewed in GIS. The advantage of having this in a Shiny app is that we can communicate the data more effectively by splicing into multiple user friendly tables and adding summary information such as the number of species in each theme.

We might also want to consider some additional solution maps where the values show the count of species per planning unit.

I've written a little proof of concept showing that we can gather the required data inside wtw and display it in a map. Should work for any set of WTW files, but best to run on a small project since I'm displaying the planning units as polygons in this example:

library(wheretowork)
library(tibble)
library(tidyr)
library(dplyr)
library(terra)
library(sf)
library(shiny)
library(leaflet)


# read the WTW project files
x <- read_project(
  path = "C:/Data/PRZ/WTW_PREPPED/Kejimkujik/WTW/kejimkujik.yaml",
  spatial_path = "C:/Data/PRZ/WTW_PREPPED/Kejimkujik/WTW/kejimkujik.tif",
  attribute_path = "C:/Data/PRZ/WTW_PREPPED/Kejimkujik/WTW/kejimkujik_attribute.csv.gz",
  boundary_path = "C:/Data/PRZ/WTW_PREPPED/Kejimkujik/WTW/kejimkujik_boundary.csv.gz",
  mode = "advanced",
  force_hidden = FALSE
)

# grab the dataset object
d <- x$dataset

# objective 1 - get table of theme layers and their grouped theme
tib <- tibble(
  theme = as.character(),
  feature_name = as.character(),
  feature_index = as.character()
)

for(t in x$themes){
  f <- t$get_feature_name()
  tib2 <- tibble(
    theme = rep(t$name, length(f)),
    feature_name = f,
    feature_index = t$get_layer_index()
    )
  tib <- rbind(tib, tib2)
}
# need a step to filter this table so it only includes the themes that were included in the solution run


# objective 2 - get long format table of all cell values
df <- d$attribute_data %>%
  select(tib$feature_index, "_index") %>%
  pivot_longer(!'_index', names_to = "feature_index") %>%
  filter(value > 0) %>%
  left_join(tib, by = 'feature_index')

# can then use table df to filter by _index based on mouse click on the pu map
# popup would appear with some tabs, one for each theme group showing table df filtered
# by theme group. Would also have a summary tab with the count of themes in each 
# theme group.


### SHINY PROOF OF CONCEPT ###

# convert pu's to polygon for demo. In the real version we would probably capture 
# the index click using the ESRI API so we don't have to render the polygon layer.
idx <- d$attribute_data[["_index"]]
r <- raster::setValues(d$spatial_data, NA_real_)
r[idx] <- idx
names(r) <- 'Id'
pu <- terra::as.polygons(terra::rast(r))
pu <- sf::st_as_sf(pu) %>%
  st_transform(crs = 4326)

ui <- fluidPage(
  leafletOutput("Map"),
)

server <- function(input, output, session) {
  
  output$Map <- renderLeaflet({
    leaflet(pu) %>%
      addTiles() %>%
      addPolygons(layerId = ~Id)
  })
  
  observeEvent(input$Map_shape_click, {
    p <- input$Map_shape_click$id
    
    # Note that building the modal tables and tabs should be automated because themes will change 
    output$tbl1 <- renderDataTable(df[df$`_index` == p & df$theme == "Range: Endangered Species (ECCC)",])
    output$tbl2 <- renderDataTable(df[df$`_index` == p & df$theme == "Mammals (IUCN Area of Habitat)",])
    
    showModal(modalDialog(
      title = paste0("planning unit index: ", p),
      size = 'l',
      tabsetPanel(
        tabPanel(
          title = "Range: Endangered Species (ECCC)",
          dataTableOutput("tbl1")
        ),
        tabPanel(
          title = "Mammals (IUCN Area of Habitat)",
          dataTableOutput("tbl2")
        )
      )
    ))
  })
}

shinyApp(ui, server)