Economic Indicator Refinement

This page describes the various iterations of indicator sets for the economics dimensions. First, we observe the indicators included in the dimension at three points in time. The second section then shows the results of the survey following the indicator refinement meeting. A final set of indicators to incorporate into the next RFP is still in the works!

1 Indicator Progression

1.1 Wiltshire

This graph shows the original framework as described in the Wiltshire et al. paper.

source('dev/get_dimension_ggraph.R')
get_dimension_ggraph(
  csv_path = 'data/trees/econ_wiltshire_tree.csv',
  dimension_in = 'economics',
  include_metrics = FALSE,
  y_limits = c(-1.5, 2.1)
)

1.2 Matrix

Here is the current set of indicators in the matrix, following the Sustainability Metrics workshop in July, 2024

source('dev/get_dimension_ggraph.R')
get_dimension_ggraph(
  csv_path = 'data/trees/econ_tree.csv',
  dimension_in = 'economics',
  y_limits = c(-1.5, 2.1)
)

1.3 Refinement Meeting

Finally, the tentative set of indicators following the indicator refinement meeting on November 15th, 2024

source('dev/get_dimension_ggraph.R')
get_dimension_ggraph(
  csv_path = 'data/trees/econ_meeting_tree.csv',
  dimension_in = 'economics',
  y_limits = c(-1.5, 2.1)
)

2 Survey

These are the results from the follow-up survey to the economic indicator refinement meeting on November 15th. This feedback will be used to refine the framework for the next RFP.

2.1 Indicators

raw <- read_csv('data/surveys/econ_survey.csv')

dat <- raw %>% 
  select(
    starts_with('Q'),
    -ends_with('RANK')
  ) %>% 
  setNames(c(
    'indi_must',
    'indi_probably',
    'indi_probably_not',
    'indi_must_not',
    paste0('add_indi_', 1:3),
    'notes',
    'idx_must',
    'idx_probably',
    'idx_probably_not',
    'idx_must_not',
    paste0('add_idx_', 1:3),
    'idx_notes',
    'final_notes'
  )) %>% 
  .[-c(1:2), ]

groups <- select(dat, indi_must:indi_must_not, idx_must:idx_probably_not)

to_df <- function(x) {
  x %>% 
    str_split(',') %>% 
    unlist() %>% 
    table() %>% 
    as.data.frame() %>% 
    setNames(c('indicator', 'freq')) %>% 
    arrange(desc(freq))
}

indi_out <- map(groups[1:4], to_df)
idx_out <- map(groups[5:7], to_df)

# Add scores by multipliers
multipliers <- c(3:0)
ind_tables <- map2(indi_out, multipliers, ~ {
  .x %>% 
    mutate(
      freq = as.numeric(freq),
      multiplier = .y,
      score = freq * multiplier,
    ) %>% 
    select(indicator, freq, score)
})

# Set up DF for color graph 
graph_table <- imap(ind_tables, ~ {
  col_name <- str_remove(.y, 'indi_')
  .x %>% 
    rename(!!sym(col_name) := freq) %>% 
    select(-score)
}) %>% 
  reduce(full_join) %>% 
  mutate(
    across(where(is.numeric), ~ ifelse(is.na(.x), 0, .x)),
    sort_key = must * 1e6 + probably * 1e4 + probably_not * 1e2 + must_not,
    indicator = fct_reorder(indicator, sort_key, .desc = TRUE)
  ) %>% 
  pivot_longer(
    cols = must:must_not,
    names_to = "category",
    values_to = "count"
  ) %>% 
  mutate(
    category = fct_relevel(
      category, 
      "must_not",
      "probably_not", 
      "probably", 
      "must"
    )
  ) %>%
  group_by(indicator) %>%
  mutate(proportion = count / sum(count)) %>%
  ungroup()

ggplot(graph_table, aes(
  y = reorder(indicator, sort_key),
  x = proportion, 
  fill = category
)) +
  geom_col(position = "stack") +  
  labs(
    y = "Indicator",
    x = "Proportion",
    fill = "Category"
  ) +
  theme_minimal() +
  theme(
    text = element_text(size = 20),
    legend.position = 'top'
    ) +
  scale_fill_brewer(
    palette = "RdBu", 
    direction = -1,
    limits = c(
      "must",
      "probably", 
      "probably_not", 
      "must_not" 
    ),
    labels = c(
      "Must Include", 
      "Probably Include", 
      "Probably Not Include", 
      "Must Not Include"
    )
  )

We are coding this so “Must Include” is worth 3 points, “Probably Include” is worth 2 points, “Probably Not Include” is worth 1 point, and “Must Not Include” is worth 0 points. Note that the last column is the sum of proportions of “Must Include” and “Probably Include”. You can sort, search, expand, or page through the table below.

# Add category to tables
props <- ind_tables %>% 
  imap(~ .x %>% mutate(cat = .y)) %>% 
  bind_rows() %>% 
  select(-score)
 
# Get proportion of probably include OR must include
prop_prob_or_must_include <- props %>% 
  filter(cat %in% c('indi_must', 'indi_probably')) %>% 
  group_by(indicator) %>% 
  summarize(prop_include = sum(freq) / 6) %>% 
  arrange(desc(prop_include))

# Get proportion of must include
prop_must_include <- props %>% 
  filter(cat == 'indi_must') %>% 
  group_by(indicator) %>% 
  summarize(prop_must = sum(freq) / 6) %>% 
  arrange(desc(prop_must))

# Add up weighted scores
ind_scores <- ind_tables %>% 
  bind_rows() %>% 
  group_by(indicator) %>% 
  summarize(score = sum(score, na.rm = TRUE)) %>% 
  arrange(desc(score))

# Join everything together
scores_table <- ind_scores %>% 
  full_join(prop_must_include) %>% 
  full_join(prop_prob_or_must_include) %>% 
  arrange(desc(score)) %>% 
  mutate(
    across(where(is.numeric), ~ ifelse(is.na(.x), 0, .x)),
    across(c(3:4), ~ format(round(.x, 2), nsmall = 2))
  ) %>% 
  setNames(c('Indicator', 'Score', 'Proportion Must Include', 'Proportion Must OR Probably Include'))

2.2 Indices

idx_out <- map(groups[5:7], to_df)

# Add scores by multipliers
multipliers <- c(3:1)
idx_tables <- map2(idx_out, multipliers, ~ {
  .x %>% 
    mutate(
      freq = as.numeric(freq),
      multiplier = .y,
      score = freq * multiplier,
    ) %>% 
    select(index = indicator, freq, score)
})

# Set up DF for color graph 
graph_table <- imap(idx_tables, ~ {
  col_name <- str_remove(.y, 'idx_')
  .x %>% 
    rename(!!sym(col_name) := freq) %>% 
    select(-score)
}) %>% 
  reduce(full_join) %>% 
  mutate(
    across(where(is.numeric), ~ ifelse(is.na(.x), 0, .x)),
    sort_key = must * 1e6 + probably * 1e4 + probably_not,
    index = fct_reorder(index, sort_key, .desc = TRUE)
  ) %>% 
  pivot_longer(
    cols = must:probably_not,
    names_to = "category",
    values_to = "count"
  ) %>% 
  mutate(
    category = fct_relevel(
      category, 
      "probably_not", 
      "probably", 
      "must"
    )
  ) %>%
  group_by(index) %>%
  mutate(proportion = count / sum(count)) %>%
  ungroup()


colors <- RColorBrewer::brewer.pal(4, 'RdBu')[2:4]

ggplot(graph_table, aes(
  y = reorder(index, sort_key),
  x = proportion, 
  fill = category
)) +
  geom_col(position = "stack") +  
  labs(
    y = "Index",
    x = "Proportion",
    fill = "Category"
  ) +
  theme_minimal() +
  theme(
    text = element_text(size = 16),
    legend.position = 'top'
    ) +
  scale_fill_manual(
    values = rev(colors),
    limits = c(
      "must",
      "probably",
      "probably_not"
    ),
    labels = c(
      "Must Include",
      "Probably Include",
      "Probably Not Include"
    )
  )

The indices are going through the same treatment as indicators above - scored from 3 to 0. Note that there were no indices rated as “Must Not Include”.