This short report presents baseline values and supporting data for four key BSC metrics to help Fish Forever leadership set informed targets for FY2026. These metrics include: (1) fishers adopting sustainable practices, (2) people living in more resilient communities, (3) area of ocean under conservation, and (4) area of critical habitat under protection or management. For each metric, the report provides either available baseline values or proxy measures and highlights any data limitations that may affect interpretation.
Definition: Count of fishers living in area-based management (ABM) sites that score above 50% on the Co-management resilience factor (i.e., score > 2 on the 0–4 scale). Reported in Table 3.
What we show:
The average Co-management score by country (Table 1).
The number of ABM sites meeting the >50% threshold, by country and in total (Table 2).
The number of fishers living in qualifying ABM sites, by country and overall total (Table 3).
Data completeness note: Estimated fisher numbers are reported at the community level. Currently, more than half of communities have this value recorded as 0 (i.e., missing). As a result, the figures presented here likely underestimate the true number of fishers reached by the program. Completing these fields would significantly improve the baseline. If full data collection is not feasible, we can explore modeled estimates to impute community-level fisher counts. Table 4 summarizes the extent of missing data.
# 1) Read datasets from the "data" folder using here()
res <- readr::read_csv(here::here("data", "factor_scores.csv"))
unique(res$country)
#> [1] "HND" "IDN" "BRA" "PHL" "MOZ" "FSM" "GTM" "PLW"
iso_to_name <- c(
HND = "Honduras",
IDN = "Indonesia",
BRA = "Brazil",
PHL = "Philippines",
MOZ = "Mozambique",
FSM = "Federated States of Micronesia",
GTM = "Guatemala",
PLW = "Palau"
)
res$country <- as.character(res$country)
mapped <- iso_to_name[res$country]
res$country <- ifelse(is.na(mapped), res$country, mapped)
fp <- readr::read_csv(here::here("data", "footprint_global.csv"))
# Ensure numeric score and est_fishers
res <- res %>% mutate(score = as.numeric(score))
fp <- fp %>% mutate(est_fishers = as.numeric(est_fishers))
# 2) Filter to "Coastal Fishery Co-Management"
cm_res <- res %>%
filter(name == "Coastal Fishery Co-Management")
# 3) Average "Coastal Fishery Co-Management" score per country
avg_cm_by_country <- cm_res %>% # AVERAGE CO-MGMT BY COUNTRY
group_by(country) %>%
summarise(
avg_cm_score = round(mean(score, na.rm = TRUE), 1),
n_abm = n_distinct(ma),
.groups = "drop"
) %>%
arrange(desc(avg_cm_score))
# 4) ABM areas above 2 (score 3 or 4) and % above 2 by country
# First reduce to one score per ABM (in case of duplicates)
cm_by_abm <- cm_res %>%
group_by(country, ma) %>%
summarise(score = mean(score, na.rm = TRUE), .groups = "drop")
abm_above2 <- cm_by_abm %>%
mutate(above2 = score > 2)
pct_above2_by_country <- abm_above2 %>% # % ABOVE 50% CO-MGMT BY COUNTRY
group_by(country) %>%
summarise(
n_total = n(),
n_above2 = sum(above2, na.rm = TRUE),
pct_above2 = if_else(n_total > 0, round(100 * n_above2 / n_total, 0), NA_real_),
.groups = "drop"
) %>%
arrange(desc(pct_above2))
# 5) % of communities (level4_name) without estimated fishers (0 or NA) in footprint_global.csv
# Overall
pct_comm_missing_overall <- fp %>% # MISSING EST FISHERS
mutate(missing = is.na(est_fishers) | est_fishers == 0) %>%
summarise(
n_comm = n_distinct(level4_name),
n_missing = n_distinct(level4_name[missing]),
pct_missing = if_else(n_comm > 0, 100 * n_missing / n_comm, NA_real_)
)
# By country (useful for QA)
pct_comm_missing_by_country <- fp %>%
mutate(missing = is.na(est_fishers) | est_fishers == 0) %>%
group_by(country) %>%
summarise(
n_comm = n_distinct(level4_name),
n_missing = n_distinct(level4_name[missing]),
pct_missing = if_else(n_comm > 0, round(100 * n_missing / n_comm), 0, NA_real_),
.groups = "drop"
) %>%
arrange(desc(pct_missing))
# 6) Fishers per ABM area (sum of community est_fishers) using ma_name
fishers_by_abm <- fp %>%
group_by(country, ma_name) %>%
summarise(
fishers = sum(est_fishers, na.rm = TRUE), # conservative: ignores NAs, keeps zeros as zeros
.groups = "drop"
)
# 7) Fishers in ABM areas above 2 (program-wide and by country)
# Join qualifying ABMs (from resilience scores) to fishers_by_abm (from footprint)
fishers_in_above2 <- fishers_by_abm %>%
inner_join(
abm_above2 %>% filter(above2) %>% select(country, ma),
by = c("country" = "country", "ma_name" = "ma")
)
# Program-wide total
program_total_fishers_in_above2 <- fishers_in_above2 %>% # TOTAL FISHERS ABOVE 50%
summarise(total_fishers_in_above2 = sum(fishers, na.rm = TRUE))
# By-country totals
by_country_fishers_in_above2 <- fishers_in_above2 %>% # FISHERS ABOVE 50% BY COUNTRY - add total
group_by(country) %>%
summarise(
total_fishers_in_above2 = sum(fishers, na.rm = TRUE),
n_abm_qualifying = n_distinct(ma_name),
.groups = "drop"
) %>%
arrange(desc(total_fishers_in_above2))
# Table 1: Average Co-management Score by Country (0–4).
avg_cm_by_country <- avg_cm_by_country %>%
select(-n_abm)
avg_cm_by_country %>%
arrange(desc(avg_cm_score)) %>%
kbl(
caption = "Table 1: Average Co-management Score by Country (0–4)",
col.names = c("Country", "Average Co-management Score"),
digits = 1,
align = c("l", "c"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Average Co-management Score |
|---|---|
| Mozambique | 3.2 |
| Federated States of Micronesia | 3.0 |
| Philippines | 3.0 |
| Indonesia | 2.3 |
| Brazil | 1.9 |
| Honduras | 1.8 |
| Guatemala | 1.0 |
| Palau | 1.0 |
all_countries <- pct_above2_by_country %>%
summarise(
country = "All Countries",
n_total = sum(n_total, na.rm = TRUE),
n_above2 = sum(n_above2, na.rm = TRUE)
) %>%
mutate(
pct_above2 = round(100 * n_above2 / n_total) # recompute %
)
pct_above2_by_country <- pct_above2_by_country %>%
bind_rows(all_countries)
tbl <- pct_above2_by_country %>%
mutate(pct_above2 = paste0(pct_above2, "%"))
tbl %>%
kbl(
caption = "Table 2: ABM Sites Meeting the Co-management Threshold (>50%)",
col.names = c(
"Country", "Total ABM Sites", "ABM Sites Above Threshold",
"% of ABM Sites Above Threshold"
),
align = c("l","c","c","c"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center") %>%
row_spec(nrow(tbl), bold = TRUE) | Country | Total ABM Sites | ABM Sites Above Threshold | % of ABM Sites Above Threshold |
|---|---|---|---|
| Federated States of Micronesia | 5 | 5 | 100% |
| Philippines | 92 | 68 | 74% |
| Mozambique | 35 | 25 | 71% |
| Indonesia | 101 | 52 | 51% |
| Honduras | 18 | 5 | 28% |
| Brazil | 14 | 2 | 14% |
| Guatemala | 1 | 0 | 0% |
| Palau | 3 | 0 | 0% |
| All Countries | 269 | 157 | 58% |
fishers_table <- by_country_fishers_in_above2 %>%
select(country, total_fishers_in_above2) %>%
bind_rows(
summarise(.,
country = "All Countries",
total_fishers_in_above2 = sum(total_fishers_in_above2, na.rm = TRUE))
)
# Format and create the table
fishers_table %>%
mutate(
total_fishers_in_above2 = comma(total_fishers_in_above2), # Format numbers
country = ifelse(country == "All Countries",
cell_spec(country, bold = TRUE),
country),
total_fishers_in_above2 = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(total_fishers_in_above2, bold = TRUE),
total_fishers_in_above2)
) %>%
kbl(
escape = FALSE,
caption = "Table 3: Fishers in ABM Sites Meeting the Co-management Threshold (>50%)",
col.names = c("Country", "Fishers in ABM Sites Above Threshold"),
align = c("l", "r"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Fishers in ABM Sites Above Threshold |
|---|---|
| Philippines | 69,974 |
| Indonesia | 31,383 |
| Mozambique | 26,715 |
| Honduras | 1,604 |
| Brazil | 338 |
| Federated States of Micronesia | 0 |
| All Countries | 130,014 |
pct_comm_missing_by_country <- pct_comm_missing_by_country %>%
select(country, pct_missing)
pct_comm_missing_by_country %>%
arrange(desc(pct_missing)) %>%
mutate(
pct_missing = paste0(pct_missing, "%") # Add % symbol
) %>%
kbl(
caption = "Table 4: Missing Fisher Estimates by Country",
col.names = c("Country", "% of Communities with Missing Fisher Estimates"),
align = c("l", "c"),
escape = FALSE,
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | % of Communities with Missing Fisher Estimates |
|---|---|
| Federated States of Micronesia | 100% |
| Brazil | 95% |
| Philippines | 72% |
| Indonesia | 37% |
| Palau | 33% |
| Guatemala | 9% |
| Mozambique | 8% |
| Honduras | 0% |
Definition: This indicator counts the number of people living in communities that are becoming more resilient; defined as sites with stable or increasing resilience scores. Since resilience factor scores are currently only available for 2025, we cannot assess change over time. Instead, we present average resilience factor scores and the aggregated resilience score per country to provide a snapshot of current conditions (Table 5).
What we show:
The average resilience factor scores and the aggregated resilience score (on a 0–24 scale) per country (Table 5).
The communities per country that score above 50% on the aggregated resilience score (i.e., aggregated score > 12), as a rough proxy for identifying more resilient communities and the number of people living in those “resilient” communities. While this is not exactly what the indicator is intended to measure, these figures offer a useful approximation of the scale of resilience currently reached (Table 6).
Data completeness note: Population is recorded at the community level. As of now, approximately 22% of communities have missing data (i.e., population recorded as 0). As a result, the number of people reported here likely underrepresents the true reach of the program. Completing this data would strengthen the accuracy of this indicator. Table 7 summarizes missing population data by country.
#Note: Some ABM areas are in the footpring global dataset but not in the impact framework dataset (why?)
# Ensure numeric where needed
res <- res %>% mutate(score = as.numeric(score))
fp <- fp %>% mutate(population = as.numeric(population))
# Add Policy score
#unique(res$ma)
# Define the country-to-score mapping
policy_scores <- c(
"Brazil" = 3,
"Federated States of Micronesia" = 3,
"Guatemala" = 3,
"Honduras" = 4,
"Indonesia" = 3,
"Mozambique" = 4,
"Palau" = 3,
"Philippines" = 3
)
# Create a new dataframe with one row per unique `ma` and their country
res_policy <- res %>%
select(country, ma) %>%
distinct() %>%
mutate(
year = 2025,
name = "Coastal Fishery Policy and Governance",
score = policy_scores[country]
)
# Combine with the original dataset
res_updated <- bind_rows(res, res_policy)
#Get whole porgram scores
res_by_factor <- res_updated %>%
mutate(score = as.numeric(score)) %>% # ensure numeric
group_by(name) %>%
summarise(
avg_score = round(mean(score, na.rm = TRUE), 4)
) %>%
arrange(desc(avg_score))
res_by_factor <- res_by_factor %>%
add_row(
name = "Total Resilience Score (0–24)",
avg_score = sum(.$avg_score, na.rm = TRUE) # sums the rounded averages you have
)
res_by_factor$avg_score <- round(res_by_factor$avg_score, 1)
# 1) Collapse any duplicates within (country, ma, name)
abm_factor_scores <- res_updated %>%
group_by(country, ma, name) %>%
summarise(score = mean(score, na.rm = TRUE), .groups = "drop")
# 2) ABM-level score on a 0–24 scale (sum across factors)
abm_score_0_24 <- abm_factor_scores %>%
group_by(country, ma) %>%
summarise(
abm_score_0_24 = sum(score, na.rm = TRUE), # 0–24 (max 6 factors present)
factors = n_distinct(name), # # factors present for this ABM
.groups = "drop"
)
# 3) Country score on a 0–24 scale:
# For each country & factor, average across ABMs; then sum the factor averages across the 5 factors.
country_factor_avgs <- abm_factor_scores %>% # AVERAGE SCORES BY COUNTRY - NEED TO ACCOMODATE AND INCORPORATE OTHERS
group_by(country, name) %>%
summarise(
avg_factor_score = round(mean(score, na.rm = TRUE), 1), # 0–4 per factor
n_abm_with_factor = n_distinct(ma),
.groups = "drop"
)
country_score_0_24 <- country_factor_avgs %>% # COUNTRY SCORES 0-24
group_by(country) %>%
summarise(
country_score_0_24 = round(sum(avg_factor_score, na.rm = TRUE), 1), # 0–24 with 5 factors
factors = n_distinct(name),
.groups = "drop"
) %>%
arrange(desc(country_score_0_24))
country_score_0_24$factors[country_score_0_24$country == "Guatemala"] <- 4 # now is 0 because there's no data
# Optional "Resilient"
# 4) Resilient ABMs: summed ABM score > 12 (i.e., average > 2 across the 6 factors)
abm_resilient <- abm_score_0_24 %>%
mutate(resilient = abm_score_0_24 > 12) %>% # strictly greater than 12
filter(resilient) %>%
select(country, ma)
# 5) Communities per ABM (QA view only) — count DISTINCT (level2_name, level4_name)
communities_per_abm <- fp %>%
group_by(country, ma_name) %>%
summarise(
n_communities = n_distinct(level2_name, level4_name),
.groups = "drop"
)
# 6) Distinct communities in resilient ABMs (dedup across ABMs)
# Community ID = (country, level2_name, level4_name)
resilient_comm_list <- fp %>%
inner_join(abm_resilient, by = c("country" = "country", "ma_name" = "ma")) %>%
distinct(country, level2_name, level4_name)
all_comm <- abm_score_0_24 %>%
select(country, ma)
all_comm_list <- fp %>%
inner_join(all_comm, by = c("country" = "country", "ma_name" = "ma")) %>%
distinct(country, level2_name, level4_name)
# 7) % of communities in resilient ABMs (per country, deduped by (level2_name, level4_name))
total_comm_by_country <- all_comm_list %>%
distinct(country, level2_name, level4_name) %>%
count(country, name = "n_total_communities")
resilient_comm_by_country <- resilient_comm_list %>%
count(country, name = "n_resilient_communities")
resilient_communities_by_country <- total_comm_by_country %>% # % ABOVE 50% FOR RESILIENT FACTORS
left_join(resilient_comm_by_country, by = "country") %>%
mutate(
n_resilient_communities = replace_na(n_resilient_communities, 0),
pct_resilient_communities = if_else(
n_total_communities > 0,
round(100 * n_resilient_communities / n_total_communities, 0),
NA_real_
)
) %>%
arrange(desc(pct_resilient_communities))
# 8) People living in resilient communities (dedup at the community level)
# First, reduce to one population value per (country, level2_name, level4_name).
people_per_community <- fp %>%
group_by(country, level2_name, level4_name) %>%
summarise(
people = ifelse(all(is.na(population)), NA_real_, max(population, na.rm = TRUE)),
.groups = "drop"
)
# By country
people_in_resilient_by_country <- resilient_comm_list %>% #PEOPLE IN RESILIENT COMMUNITIES
inner_join(people_per_community, by = c("country", "level2_name", "level4_name")) %>%
group_by(country) %>%
summarise(
people_in_resilient = sum(people, na.rm = TRUE),
n_resilient_communities = n_distinct(level2_name, level4_name),
.groups = "drop"
) %>%
arrange(desc(people_in_resilient))
# Program-wide total
people_in_resilient_total <- resilient_comm_list %>% # TOTAL - add to previous
inner_join(people_per_community, by = c("country", "level2_name", "level4_name")) %>%
summarise(people_in_resilient_total = sum(people, na.rm = TRUE))
#Missing Population
# Collapse to unique communities by (country, level2_name, level4_name)
community_pop_status <- fp %>%
group_by(country, level2_name, level4_name) %>%
summarise(
# any strictly positive population across duplicates?
any_positive_pop = any(!is.na(population) & population > 0),
# optional: a representative population value if you need it later
max_population = ifelse(all(is.na(population)), NA_real_, max(population, na.rm = TRUE)),
.groups = "drop"
) %>%
mutate(missing_pop = !any_positive_pop) # TRUE if all entries are 0/NA
# Overall summary
overall_missing_pop <- community_pop_status %>%
summarise(
n_total_communities = n(),
n_missing = sum(missing_pop),
pct_missing = 100 * n_missing / n_total_communities
)
# By-country summary
missing_pop_by_country <- community_pop_status %>% # MISSING POPULATION
group_by(country) %>%
summarise(
n_total_communities = n(),
n_missing = sum(missing_pop),
pct_missing = round(100 * n_missing / n_total_communities, 0),
.groups = "drop"
) %>%
arrange(desc(pct_missing))
# (Optional) list of communities with missing population
# communities_missing_pop <- community_pop_status %>%
# filter(missing_pop) %>%
# arrange(country, level2_name, level4_name)
# Table
country_factor_avgs <- country_factor_avgs %>%
select(country, name, avg_factor_score)
country_factor_wide <- country_factor_avgs %>%
pivot_wider(
names_from = name,
values_from = avg_factor_score
)
country_factor_wide <- country_factor_avgs %>%
pivot_wider(
names_from = name,
values_from = avg_factor_score
)
country_factor_wide <- country_factor_wide %>%
mutate(across(
where(is.numeric),
~ ifelse(is.na(.x), 0, .x) %>%
round(1) %>%
format(nsmall = 1, trim = TRUE)
))
resilience_scored <- country_factor_wide %>%
mutate(across(
-country,
~ as.numeric(.x)
))
# Step 2: Add total score column
resilience_scored <- resilience_scored %>%
rowwise() %>%
mutate(`Total Resilience Score (0–24)` = sum(c_across(-country), na.rm = TRUE)) %>%
ungroup()
# Step 3: Optional – format scores again if needed
resilience_scored <- resilience_scored %>%
mutate(across(
-c(country, `Total Resilience Score (0–24)`),
~ ifelse(.x %% 1 == 0, as.character(as.integer(.x)), format(round(.x, 1), nsmall = 1))
))
total_col <- "Total Resilience Score (0–24)"
program_row <- res_by_factor %>%
filter(name != total_col) %>%
select(name, avg_score) %>%
pivot_wider(names_from = name, values_from = avg_score) %>%
mutate(`Total Resilience Score (0–24)` =
res_by_factor$avg_score[res_by_factor$name == total_col]) %>%
mutate(country = "All Countries", .before = 1) %>%
as.data.frame(check.names = FALSE)
cols <- c(
"Coastal Fishery Policy and Governance",
"Coastal Fishery Co-Management",
"Adaptive Capacity to Climate Change",
"Capacity for Collective Action",
"Sustainable Livelihoods & Food Security",
"Coastal Biodiversity & Ecosystem Services",
"Total Resilience Score (0–24)"
)
# Prepare table and match types
resilience_table_final <- resilience_scored %>%
select(country, all_of(cols)) %>%
mutate(across(all_of(cols), as.numeric)) %>%
bind_rows(
program_row %>% mutate(across(all_of(cols), as.numeric))
)
# Bold the entire Program Total row
resilience_table_final <- resilience_table_final %>%
# Bold the "All Countries" row first
# Then bold the Total Resilience column for rows other than "All Countries"
mutate(
`Total Resilience Score (0–24)` = ifelse(
country == "All Countries",
`Total Resilience Score (0–24)`, # keep the already bolded version
cell_spec(as.character(`Total Resilience Score (0–24)`), bold = TRUE)
)
) %>%
mutate(across(
everything(),
~ ifelse(country == "All Countries",
cell_spec(as.character(.), bold = TRUE),
as.character(.))
))
# Render kable
resilience_table_final %>%
kbl(
escape = FALSE,
caption = "Table 5: Average Resilience Factor Scores and Total Resilience Score (0–24) by Country",
col.names = c(
"Country",
"Coastal Fishery Policy and Governance",
"Coastal Fishery Co-Management",
"Adaptive Capacity to Climate Change",
"Capacity for Collective Action",
"Sustainable Livelihoods & Food Security",
"Coastal Biodiversity & Ecosystem Services",
"Total Resilience Score (0-24)"
),
align = "lccccccc",
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Coastal Fishery Policy and Governance | Coastal Fishery Co-Management | Adaptive Capacity to Climate Change | Capacity for Collective Action | Sustainable Livelihoods & Food Security | Coastal Biodiversity & Ecosystem Services | Total Resilience Score (0-24) |
|---|---|---|---|---|---|---|---|
| Brazil | 3 | 1.9 | 0 | 3.1 | 1.6 | 1.9 | 11.5 |
| Federated States of Micronesia | 3 | 3 | 0 | 2.4 | 3.8 | 2 | 14.2 |
| Guatemala | 3 | 1 | 0 | 2 | 2 | 1.5 | 9.5 |
| Honduras | 4 | 1.8 | 2.5 | 2.4 | 1.6 | 1.7 | 14 |
| Indonesia | 3 | 2.3 | 0 | 2.7 | 2 | 1.6 | 11.6 |
| Mozambique | 4 | 3.2 | 2 | 3.6 | 1.3 | 1.3 | 15.4 |
| Palau | 3 | 1 | 0 | 3 | 3 | 1 | 11 |
| Philippines | 3 | 3 | 3 | 3.3 | 1.3 | 1.2 | 14.8 |
| All Countries | 3.2 | 2.6 | 2.6 | 3.1 | 1.7 | 1.4 | 14.5 |
# #Table without All countries row
#
# # Reorder columns
# resilience_table <- resilience_scored %>%
# select(
# country,
# `Coastal Fishery Policy and Governance`,
# `Coastal Fishery Co-Management`,
# `Adaptive Capacity to Climate Change`,
# `Capacity for Collective Action`,
# `Sustainable Livelihoods & Food Security`,
# `Coastal Biodiversity & Ecosystem Services`,
# `Total Resilience Score (0–24)`
# ) %>%
# mutate(
# `Total Resilience Score (0–24)` = cell_spec(
# `Total Resilience Score (0–24)`,
# bold = TRUE
# )
# )
#
# # Create kable table with renamed column headers
# resilience_table %>%
# kbl(
# escape = FALSE,
# caption = "Table 5: Average Resilience Factor Scores and Total Resilience Score (0–24) by Country",
# col.names = c(
# "Country",
# "Coastal Fishery Policy and Governance",
# "Coastal Fishery Co-Management",
# "Adaptive Capacity to Climate Change",
# "Capacity for Collective Action",
# "Sustainable Livelihoods",
# "Coastal Biodiversity & Ecosystem Services",
# "Total Resilience Score (0-24)"
# ),
# align = "lccccccc",
# booktabs = TRUE
# ) %>%
# kable_styling(full_width = FALSE, position = "center")
# Join % column
people_in_resilient_joined <- people_in_resilient_by_country %>%
left_join(
resilient_communities_by_country %>%
select(country, pct_resilient_communities),
by = "country"
)
# Add total row (with total % = 653 / 2021)
people_in_resilient_joined %>%
select(
country,
n_resilient_communities,
pct_resilient_communities,
people_in_resilient
) %>%
bind_rows(
tibble(
country = "All Countries",
n_resilient_communities = 653,
pct_resilient_communities = 32.31, # calculated from full community count
people_in_resilient = 903867
)
) %>%
mutate(
people_in_resilient = comma(people_in_resilient),
pct_resilient_communities = paste0(round(pct_resilient_communities), "%"),
country = ifelse(country == "All Countries", cell_spec("All Countries", bold = TRUE), country),
n_resilient_communities = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(n_resilient_communities, bold = TRUE),
n_resilient_communities),
pct_resilient_communities = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(pct_resilient_communities, bold = TRUE),
pct_resilient_communities),
people_in_resilient = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(people_in_resilient, bold = TRUE),
people_in_resilient)
) %>%
kbl(
escape = FALSE,
caption = "Table 6: Communities Scoring Above 50% on Resilience (>12) by Country",
col.names = c(
"Country",
"Number of Resilient Communities",
"% Resilient Communities",
"People in Resilient Communities"
),
align = c("l", "c", "c", "r"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Number of Resilient Communities | % Resilient Communities | People in Resilient Communities |
|---|---|---|---|
| Philippines | 269 | 34% | 294,360 |
| Mozambique | 14 | 39% | 178,154 |
| Indonesia | 199 | 33% | 164,157 |
| Federated States of Micronesia | 36 | 100% | 34,720 |
| Honduras | 21 | 27% | 23,124 |
| All Countries | 653 | 32% | 903,867 |
missing_pop_by_country <- missing_pop_by_country %>%
select(country, pct_missing)
missing_pop_by_country %>%
arrange(desc(pct_missing)) %>%
mutate(
pct_missing = paste0(pct_missing, "%") # Add % symbol to the values
) %>%
kbl(
caption = "Table 7: Percent of Communities With Missing (zero) Population Values by Country",
col.names = c("Country", "% Missing Population"),
align = c("l", "c"),
escape = FALSE,
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | % Missing Population |
|---|---|
| Brazil | 52% |
| Palau | 33% |
| Philippines | 21% |
| Mozambique | 14% |
| Guatemala | 9% |
| Federated States of Micronesia | 0% |
| Honduras | 0% |
| Indonesia | 0% |
Definition: Area of ocean under conservation, defined as the estimated square kilometers covered by policies that recognize the preferential rights of coastal communities and delegate co-management authority, and where those policies are actively being implemented (Table 8).
This baseline is currently estimated using two components:
The total national area covered by relevant preferential rights and co-management policies.
The proportion of that area where implementation is occurring, approximated using the percentage of coastal provinces where Rare is working.
This approach, outlined in the Impact Framework, represents an initial method and is expected to evolve. Caution is advised when interpreting or comparing these numbers, as improvements to the methodology are likely.
# Create the data
country <- c(
"Brazil",
"Federated States of Micronesia",
"Guatemala",
"Honduras",
"Indonesia",
"Mozambique",
"Palau",
"Philippines"
)
implemented_policy <- c(
12908.07,
8489.57,
1269.94,
12193.57,
54286.09,
7986.75,
1582.42,
207731.43
)
# Create the dataframe
df_policy <- data.frame( #IMPLEMENTED POLICY - ADD TOTAL
country = country,
implemented_policy = implemented_policy
)
df_policy_total <- df_policy %>%
bind_rows(
summarise(.,
country = "All Countries",
implemented_policy = sum(implemented_policy, na.rm = TRUE))
)
df_policy_total %>%
mutate(
implemented_policy = comma(implemented_policy), # format with commas
country = ifelse(country == "All Countries",
cell_spec(country, bold = TRUE),
country),
implemented_policy = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(implemented_policy, bold = TRUE),
implemented_policy)
) %>%
kbl(
escape = FALSE,
caption = "Table 8: Area Under Implemented Co-management Policy (km²) by Country",
col.names = c("Country", "Area (km²)"),
align = c("l", "r"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Area (km²) |
|---|---|
| Brazil | 12,908 |
| Federated States of Micronesia | 8,490 |
| Guatemala | 1,270 |
| Honduras | 12,194 |
| Indonesia | 54,286 |
| Mozambique | 7,987 |
| Palau | 1,582 |
| Philippines | 207,731 |
| All Countries | 306,448 |
Definition: Area of critical coastal habitat (including coral reefs, mangroves, and seagrass beds) that is under formal protection or management (Table 9).
The table below presents, by country and in total:
The total area of critical habitat identified.
The area of that habitat currently under protection or management.
The percentage of critical habitat under protection or management.
# ---- 1) Load data ----
# Adjust paths if needed
chp <- readr::read_csv(here::here("data", "critical_habitat_protected.csv"))
# Quick sanity (optional)
# glimpse(chp)
# glimpse(fp)
# ---- 2) Cap percentage columns in the raw dataset to 100 ----
# Identify columns that look like percentages by name pattern
pct_cols <- names(chp)[str_detect(names(chp),
regex("(?:_pct$|_percentage$)", ignore_case = TRUE))]
# Make sure they're numeric and cap at 100 (keep NA as NA), then round to 2 decimals
chp_clean <- chp %>%
mutate(across(all_of(pct_cols), ~ suppressWarnings(as.numeric(.)))) %>%
mutate(across(all_of(pct_cols), ~ ifelse(is.na(.), NA_real_, round(pmin(., 100), 2))))
# ---- 3) Create a unique MA -> country lookup ----
ma_country_lookup <- fp %>%
select(ma_id, country, country_id, country_code) %>%
distinct(ma_id, .keep_all = TRUE)
# ---- 4) Compute protected/managed critical habitat area per MA ----
# Self-contained logic:
# - If self-contained: treat *all* critical habitat as protected/managed
# - Else: use the reserve-based protected area
# Also cap protected area at total habitat (so sums can't exceed 100%)
chp_with_calc <- chp_clean %>%
mutate(
# coerce to numeric where needed
total_habitat = suppressWarnings(as.numeric(total_habitat)),
total_protected_habitat = suppressWarnings(as.numeric(total_protected_habitat)),
# normalize is_self_contained to logical
is_self_contained_chr = str_to_lower(as.character(is_self_contained)),
is_self_contained_lgl = is_self_contained_chr %in% c("t","true","1","y","yes"),
protected_area_ma = if_else(
is_self_contained_lgl,
total_habitat,
total_protected_habitat
),
# cap protected at total_habitat
protected_area_ma = pmin(protected_area_ma, total_habitat, na.rm = TRUE),
total_crit_hab_ma = total_habitat
) %>%
select(-is_self_contained_chr) # cleanup helper column
# ---- 5) Join country info ----
chp_joined <- chp_with_calc %>%
left_join(ma_country_lookup, by = "ma_id")
# Add missing countries
ma_id <- readr::read_csv(here::here("data", "ma_ID.csv"))
#sum(is.na(chp_joined$country))
# Make sure the join keys are the same type
chp_joined <- chp_joined %>% mutate(ma_id = as.character(ma_id))
ma_id <- ma_id %>% mutate(ID = as.character(ID))
# Build a lookup table (one row per ID)
ma_lookup <- ma_id %>%
group_by(ID) %>%
summarise(country_from_ma = first(na.omit(Country)), .groups = "drop")
# Join and fill only the NAs in chp_joined$country
chp_joined <- chp_joined %>%
left_join(ma_lookup, by = c("ma_id" = "ID")) %>%
mutate(country = coalesce(country, country_from_ma)) %>%
select(-country_from_ma)
#unique(chp_joined$country)
chp_joined$country[chp_joined$country == "IDN"] <- "Indonesia"
chp_joined$country[chp_joined$country == "PHL"] <- "Philippines"
# ---- 6) Aggregate by country ----
by_country <- chp_joined %>%
group_by(country) %>%
summarise(
total_crit_hab_area = sum(total_crit_hab_ma, na.rm = TRUE),
protected_crit_hab_area = sum(protected_area_ma, na.rm = TRUE),
pct_protected = if_else(
total_crit_hab_area > 0,
100 * protected_crit_hab_area / total_crit_hab_area,
NA_real_
),
.groups = "drop"
) %>%
mutate(pct_protected = round(pct_protected, 0)) %>%
arrange(desc(protected_crit_hab_area))
# ---- 7) Add TOTAL row ----
totals <- chp_with_calc %>%
summarise(
total_crit_hab_area = sum(total_crit_hab_ma, na.rm = TRUE),
protected_crit_hab_area = sum(protected_area_ma, na.rm = TRUE),
pct_protected = if_else(
total_crit_hab_area > 0,
100 * protected_crit_hab_area / total_crit_hab_area,
NA_real_
)
) %>%
mutate(
country = "TOTAL",
pct_protected = round(pct_protected, 0)
) %>%
select(country, total_crit_hab_area, protected_crit_hab_area, pct_protected)
by_country_with_total <- bind_rows(by_country, totals)
by_country_with_total <- by_country_with_total %>%
mutate(
total_crit_hab_area = total_crit_hab_area / 100,
protected_crit_hab_area = protected_crit_hab_area / 100,
country = ifelse(country == "TOTAL", "All Countries", country)
)
by_country_with_total %>%
mutate(
total_crit_hab_area = comma(total_crit_hab_area),
protected_crit_hab_area = comma(protected_crit_hab_area),
pct_protected_label = paste0(round(pct_protected, 2), "%"), # Add % symbol to rounded values
country = ifelse(country == "All Countries", cell_spec("All Countries", bold = TRUE), country),
total_crit_hab_area = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(total_crit_hab_area, bold = TRUE),
total_crit_hab_area),
protected_crit_hab_area = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(protected_crit_hab_area, bold = TRUE),
protected_crit_hab_area),
pct_protected_label = ifelse(country == cell_spec("All Countries", bold = TRUE),
cell_spec(pct_protected_label, bold = TRUE),
pct_protected_label)
) %>%
select(country, total_crit_hab_area, protected_crit_hab_area, pct_protected_label) %>%
kbl(
escape = FALSE,
caption = "Table 9: Area of Critical Habitat Under Protection or Management (km²)",
col.names = c(
"Country",
"Total Critical Habitat Area (km²)",
"Critical Habitat Protected or Managed Area (km²)",
"Critical Habitat Protected or Managed (%)"
),
align = c("l", "r", "r", "c"),
booktabs = TRUE
) %>%
kable_styling(full_width = FALSE, position = "center")| Country | Total Critical Habitat Area (km²) | Critical Habitat Protected or Managed Area (km²) | Critical Habitat Protected or Managed (%) |
|---|---|---|---|
| Brazil | 2,957 | 2,411.0 | 82% |
| Honduras | 406 | 81.3 | 20% |
| Mozambique | 372 | 68.0 | 18% |
| Guatemala | 107 | 66.3 | 62% |
| Indonesia | 628 | 64.8 | 10% |
| Federated States of Micronesia | 219 | 52.9 | 24% |
| Philippines | 1,454 | 42.4 | 3% |
| Palau | 44 | 0.3 | 1% |
| All Countries | 6,187 | 2,786.9 | 45% |