FIES_calculation.R

library(tidyverse)
library(RM.weights)

# Import example dataset from RM.weights package
data("data.FAO_country1")

# Severity thresholds for moderate and severe food insecurity
# Using the global standard according to FAO, see p9-11 of doc linked below
# https://elearning.fao.org/pluginfile.php/491591/mod_scorm/content/5/
#   story_content/external_files/SDG2.1.2_lesson4.pdf
# Using methods defined here:
# https://www.sesric.org/imgs/news/1752_Manual_on_RM_Weights_Package_EN.pdf
global_severities <- c(
  -1.2230564, -0.847121, -1.1056616, 0.3509848,
  -0.3117999, 0.5065051, 0.7546138, 1.8755353
)

# Fit Rasch model
FIES_RM.w <- data.FAO_country1 |> 
  select(WORRIED:WHLDAY) |> 
  RM.w(.w = data.FAO_country1$wt)

# Normalize the global item severity standards to this survey
std_global_severities <- ((global_severities - mean(global_severities)) /
  sd(global_severities) * sd(FIES_RM.w$b)) + mean(FIES_RM.w$b)

# Calculate differences between original and normalized global severities
std_diffs <- abs(FIES_RM.w$b - std_global_severities)

# Use std_diffs to filter out too-large differences
uniqueness_threshold <- 0.5
std_diffs_filter <- std_diffs < uniqueness_threshold

# Recalculate vectors above using this filter
re_std_global_severities <- (
  (global_severities - mean(global_severities[std_diffs_filter])) /
  sd(global_severities[std_diffs_filter]) * sd(FIES_RM.w$b[std_diffs_filter])
) + mean(FIES_RM.w$b[std_diffs_filter])

# Calculate moderate & severe thresholds based on ATELESS and WHLDAY
thresholds <- c(re_std_global_severities[5], re_std_global_severities[8])

# Find moderate & severe food insecurity likelihoods
moderate_prob <- c(0, map_dbl(
  2:9,
  \(x) pnorm(thresholds[1], FIES_RM.w$a[x], FIES_RM.w$se.a[x], F)
))
severe_prob <- c(0, map_dbl(
  2:9,
  \(x) pnorm(thresholds[2], FIES_RM.w$a[x], FIES_RM.w$se.a[x], F)
))
moderate_final <- sum(FIES_RM.w$wt.rel.rs * moderate_prob)
severe_final <- sum(FIES_RM.w$wt.rel.rs * severe_prob)

# Find each observation's severity score (not really an approved use of FIES)
FIES <- data.FAO_country1 |> 
  filter(!if_any(WORRIED:WHLDAY, is.na)) |> 
  mutate(
    FIES_raw_score = rowSums(pick(WORRIED:WHLDAY), na.rm=T),
    FIES_severity = FIES_RM.w$a[FIES_raw_score + 1],
    FIES_moderate = if_else(FIES_severity > thresholds[1], 1,0),
    FIES_severe = if_else(FIES_severity > thresholds[2], 1,0)
  )