In bcgov/clus_explorer: CLUS Explorer

Current State

Landbase

The following indicators highlight the current state of the landbase in the area of interest:

• r scales::percent(params$status_thlb, accuracy = 1, scale = 1) - Percentage of the timber harvesting landbase in the area of interest.
• r scales::percent(params$status_road, accuracy = 1, scale = 1) - Percentage of the area of interest within 100m from the road.
• r params$status_avg_vol - Average volume (m3) per ha in THLB.

Seral Stage

The following chart represents the proportion of forest by forest age. Categories of forest age are defined as:

• Early (younger than 40 years old)

• Mature (60 - 120 years old)

• Old (Older than 120 years of age)

ggplot2::ggplot(
    as.data.frame(params$data_seral_treemap) %>% 
      dplyr::filter(!is.na(variable)) %>% 
      mutate(
        variable = forcats::fct_reorder(variable, V1, .desc = TRUE),
        percentage = round(V1 / sum(V1) * 100, 1)
      ),
    aes(
      area = V1, fill = variable, 
      label = paste0(variable, " (", scales::percent(percentage, accuracy = 1, scale = 1), ")")
    )
  ) +
  geom_treemap(alpha = 0.75) +
  geom_treemap_text(size = 9, colour = "#323F4B", place = 'topleft', grow = FALSE, reflow = TRUE)+
  theme_minimal() +
  theme(
    text = element_text(size = 10),
    legend.position = 'none',
    plot.title = element_text(size = 8, colour = '#3E4C59'),
    plot.subtitle = element_text(hjust = 0, size = 7, colour = '#3E4C59', margin = margin(b = 0.25, t = 0, unit = "cm")),
    plot.caption = element_text(face = 'italic', size = 6, colour = '#3E4C59', hjust = 1, margin = margin(t = 0.5, unit = "cm"))
  ) +
  scale_fill_brewer(palette = 'Greens') +
  labs(
    title = "Proportion of forest by age group",
    subtitle = "Early (<40 yrs), mature (60 - 120 yrs) and old (> 120 yrs)"
  )

Summary

Below you can compare outputs from different scenarios against the baseline scenario. The following scenarios have been selected for comparison:

selected_scenarios <- as.data.frame(
  params$scenarios %>%
    filter(scenario %in% params$scenario_names)
)

# Have to assign value even though it's not used, otherwise [[i]] NULL is printed
s <- lapply(rownames(selected_scenarios), function(i) {
  scenario_name <- selected_scenarios[i, 1]
  scenario_description <- selected_scenarios[i, 2]
  scenario_rank <- selected_scenarios[i, 3]

  cat(paste0('- **', scenario_name, '**: ', scenario_description, '\n\n'))
})

Baseline scenario

risk <- switch(
  params$risk,
  '0' = "Neutral",
  '-0.01' = "Low",
  '0.01' = "Medium",
  '0.05' = "High"
)

Scenario r params$baseline_scenario has been selected as the baseline, with the "Future importance" factor set to r risk. The charts and tables below show the indicator values from the baseline scenario. The indicator variables are Growing Stock (m_gs), Volume Harvested (vol_h), and area of forest disturbed within individual caribou herds (indicated by their names).

chart_line_faceted(
  data = as.data.frame(params$baseline_values$data),
  x_var = timeperiod,
  y_var = variable,
  color_var = scenario,
  facet_chart = TRUE,
  facet_vars = ind_name,
  facet_scales = 'free_y',
  facet_ncol = 2,
  facet_nrow = ceiling(
    params$baseline_values$indicator_count / 2
  ),
  xlab = "Future year",
  ylab = "",
  is_plotly = FALSE#,
  # height = 250 * params$baseline_values$indicator_count / 2
)

if (nrow(selected_scenarios) > 1) {
  cat('\n\n')
  cat('### Other scenarios compared to baseline')
  cat('\n\n')

  cat('The tables and charts below show how other selected scenarios compare to the baseline scenario. Dimensions in the multi-dimensional plots are Growing Stock (m_gs), Volume Harvested (vol_h), and area of forest disturbed within individual caribou herds (indicated by their names).')
  cat('\n\n')

  cat('In both the radar plot and heat map, the caribou indicators represent the relative proportion disturbed (i.e., cutblocks less than 40 years old and roads buffered by 50m) of a caribou subpopulation range (as named on the plot) in the area of interest. The forestry indicators are relative merchantable growing stock (m_gs) and relative volume of timber harvested (vol_h).')
  cat('\n\n')
}

if (nrow(selected_scenarios) > 1) {
  kableExtra::kbl(
      as.data.frame(params$radar_list),
      # align = 'lrlcc',
      booktabs = TRUE,
      longtable = FALSE
      # format = 'latex'
    ) %>%
    # column_spec(1, width = "1.5in") %>%
    # column_spec(3, width = "1.5in") %>%
    # column_spec(4, width = "1in") %>%
    kableExtra::kable_styling(
      latex_options = c('hold_position', 'scale_down', 'striped'), font_size = 7
    )

  # browser()
  radar_data <- as.data.frame(params$radar_list)
  rownames(radar_data) <- radar_data$scenario.x
  radar_data <- radar_data %>% 
    select(-scenario.x)

  col_max <- rep(1, length(colnames(radar_data)))
  col_min <- rep(-1, 8)

  # Bind variables summary to the data
  radar_data <- as.data.frame(rbind(col_min, col_max, radar_data))

  op <- par(mfrow = c(1, 1), mar = c(rep(2, 4)), xpd=TRUE)
  fmsb::radarchart(
    radar_data,
    axistype = 1,
    # Customize the polygon
    pcol = c("#00AFBB", "#E7B800", "#FC4E07"),
    # pfcol = scales::alpha('#00AFBB', 0.5),
    plwd = 2,
    plty = 1,
    # Customize the grid
    cglcol = "grey",
    cglty = 1,
    cglwd = 0.8,
    # Customize the axis
    axislabcol = "#393939",
    # Variable labels
    vlcex = 0.7,
    calcex = 0.7,
    caxislabels = c(-1, -0.5, 0, 0.5, 1),
    centerzero = TRUE
  )

  legend(
    x = "bottom", legend = rownames(radar_data[-c(1,2),]), horiz = TRUE,
    bty = "n", pch = 20 , col = c("#00AFBB", "#E7B800", "#FC4E07"),
    text.col = "black", cex = 0.5, pt.cex = 0.5, inset=c(0, 1)
  )


  par(op)
}

chart_heatmap(data = as.data.frame(params$radar_list_long), x = Herd, y = scenario.x, z = Ratio)

bcgov/clus_explorer documentation built on Oct. 16, 2022, 1:56 p.m.