{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# Computing FCS, HHS and rCSI from raw components\n",
    "\n",
    "*Food security survey, 2024 · R*\n",
    "\n",
    "Cassion · data-analysis.cassion.dev\n",
    "\n",
    "[![Open In Colab](https://colab.research.google.com/assets/colab-badge.svg)](https://colab.research.google.com/github/thecassion/cassion-learning-platform/blob/main/apps/data-analysis/public/datasets/examples/food-security-survey-2024/composite-indicators.r.en.ipynb)"
   ],
   "id": "cell-000"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## What this produces\n",
    "\n",
    "The same three composite indicators as the Python example, built with dplyr —\n",
    "including the exclusion rule for incomplete Household Hunger Scale responses,\n",
    "which is the step most implementations get wrong.\n",
    "\n",
    "Every dataset on this platform is synthetic. No real household is described.\n",
    "\n",
    "## Setup"
   ],
   "id": "cell-001"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "#| message: false\n",
    "library(readr)\n",
    "library(dplyr)\n",
    "library(tidyr)\n",
    "\n",
    "URL <- paste0(\n",
    "  \"https://data-analysis.cassion.dev/datasets/files/\",\n",
    "  \"food-security-survey-2024.v1.csv\"\n",
    ")\n",
    "\n",
    "fs <- read_csv(URL, col_types = cols(\n",
    "  household_id = col_character(),\n",
    "  .default     = col_guess()\n",
    "))\n",
    "\n",
    "glimpse(fs)"
   ],
   "id": "cell-002"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Range-check before you score\n",
    "\n",
    "Twenty-three records hold a consumption value above seven days, impossible\n",
    "against a seven-day recall."
   ],
   "id": "cell-003"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "components <- c(\n",
    "  \"fcs_cereals_tubers\", \"fcs_pulses\", \"fcs_vegetables\", \"fcs_fruit\",\n",
    "  \"fcs_meat_fish_eggs\", \"fcs_dairy\", \"fcs_oils_fats\", \"fcs_sugar\"\n",
    ")\n",
    "\n",
    "fs |>\n",
    "  summarise(across(all_of(components), list(min = ~min(.x, na.rm = TRUE),\n",
    "                                            max = ~max(.x, na.rm = TRUE)))) |>\n",
    "  pivot_longer(everything())"
   ],
   "id": "cell-004"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Out of range is not a measurement. NA rather than clipping to 7 — clipping\n",
    "# invents a value the enumerator never recorded.\n",
    "fs <- fs |>\n",
    "  mutate(across(all_of(components), ~ if_else(.x >= 0 & .x <= 7, .x, NA_real_)))\n",
    "\n",
    "cat(\"blank or out-of-range cells:\", sum(is.na(fs[components])), \"\\n\")"
   ],
   "id": "cell-005"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## The blank that is not a zero\n",
    "\n",
    "`rowSums(..., na.rm = TRUE)` is the trap. It treats a blank as zero days, scores\n",
    "the household as eating less than it did, and gives no warning of any kind. The\n",
    "components most often blank carry the heaviest weights — dairy and meat are 4\n",
    "each.\n",
    "\n",
    "Matrix multiplication is used here rather than `rowSums` precisely because it\n",
    "propagates `NA` by default: an incomplete household gets no score, which is the\n",
    "correct outcome."
   ],
   "id": "cell-006"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "weights <- c(\n",
    "  fcs_cereals_tubers = 2, fcs_pulses = 3, fcs_vegetables = 1, fcs_fruit = 1,\n",
    "  fcs_meat_fish_eggs = 4, fcs_dairy = 4, fcs_oils_fats = 0.5, fcs_sugar = 0.5\n",
    ")\n",
    "\n",
    "observed <- as.matrix(fs[, names(weights)])\n",
    "zeroed   <- observed\n",
    "zeroed[is.na(zeroed)] <- 0\n",
    "\n",
    "fs <- fs |>\n",
    "  mutate(\n",
    "    fcs_complete    = if_all(all_of(components), ~ !is.na(.x)),\n",
    "    fcs             = as.vector(observed %*% weights),\n",
    "    fcs_zero_filled = as.vector(zeroed   %*% weights)\n",
    "  )\n",
    "\n",
    "fs |>\n",
    "  summarise(\n",
    "    incomplete           = sum(!fcs_complete),\n",
    "    mean_complete        = round(mean(fcs[fcs_complete]), 1),\n",
    "    mean_zero_filled     = round(mean(fcs_zero_filled[!fcs_complete]), 1)\n",
    "  )"
   ],
   "id": "cell-007"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The zero-filled households average about six points below those that answered\n",
    "fully. That gap is the blanks being counted as days of not eating, not a finding\n",
    "about their diet."
   ],
   "id": "cell-008"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "share <- function(scores, poor, borderline) {\n",
    "  s <- scores[!is.na(scores)]\n",
    "  tibble(\n",
    "    households   = length(s),\n",
    "    poor_pct     = round(100 * mean(s <= poor), 2),\n",
    "    borderline_pct = round(100 * mean(s > poor & s <= borderline), 2)\n",
    "  )\n",
    "}\n",
    "\n",
    "bind_rows(\n",
    "  share(fs$fcs, 21, 35)             |> mutate(treatment = \"exclude incomplete\", thresholds = \"21/35\"),\n",
    "  share(fs$fcs_zero_filled, 21, 35) |> mutate(treatment = \"zero-fill and keep\", thresholds = \"21/35\"),\n",
    "  share(fs$fcs, 28, 42)             |> mutate(treatment = \"exclude incomplete\", thresholds = \"28/42\"),\n",
    "  share(fs$fcs_zero_filled, 28, 42) |> mutate(treatment = \"zero-fill and keep\", thresholds = \"28/42\")\n",
    ") |>\n",
    "  select(thresholds, treatment, households, poor_pct, borderline_pct)"
   ],
   "id": "cell-009"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "At 21/35 the distortion is small. At 28/42 it is not: thirty-two of the\n",
    "incomplete households are classified as having poor food consumption on scores\n",
    "that are artificially low, and every one of them would be counted in a caseload.\n",
    "\n",
    "## Both threshold sets, side by side"
   ],
   "id": "cell-010"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "consumption_group <- function(score, poor, borderline) {\n",
    "  case_when(\n",
    "    is.na(score)       ~ NA_character_,\n",
    "    score <= poor      ~ \"poor\",\n",
    "    score <= borderline ~ \"borderline\",\n",
    "    TRUE               ~ \"acceptable\"\n",
    "  )\n",
    "}\n",
    "\n",
    "valid <- fs |> filter(fcs_complete)\n",
    "\n",
    "bind_rows(\n",
    "  valid |> count(group = consumption_group(fcs, 21, 35)) |>\n",
    "    mutate(thresholds = \"21/35\", pct = round(100 * n / sum(n), 1)),\n",
    "  valid |> count(group = consumption_group(fcs, 28, 42)) |>\n",
    "    mutate(thresholds = \"28/42\", pct = round(100 * n / sum(n), 1))\n",
    ") |>\n",
    "  select(thresholds, group, n, pct) |>\n",
    "  arrange(thresholds, group)"
   ],
   "id": "cell-011"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Choosing the 28/42 set is a judgement about the food system — it is used where\n",
    "oil and sugar are consumed near-universally — and it moves the headline from\n",
    "about 1% poor to about 7%. State which set you used, in the same sentence as the\n",
    "number.\n",
    "\n",
    "## The Household Hunger Scale, with its exclusion rule"
   ],
   "id": "cell-012"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "hhs_items <- c(\n",
    "  \"hhs_no_food_in_house\", \"hhs_sleep_hungry\",\n",
    "  \"hhs_day_and_night_without_eating\"\n",
    ")\n",
    "\n",
    "fs <- fs |>\n",
    "  mutate(\n",
    "    hhs_complete = if_all(all_of(hhs_items), ~ !is.na(.x)),\n",
    "    hhs = if_else(\n",
    "      hhs_complete,\n",
    "      rowSums(pick(all_of(hhs_items)), na.rm = FALSE),\n",
    "      NA_real_\n",
    "    ),\n",
    "    hhs_category = cut(\n",
    "      hhs, c(-1, 1, 3, 6),\n",
    "      labels = c(\"little to none\", \"moderate\", \"severe\")\n",
    "    )\n",
    "  )\n",
    "\n",
    "cat(\"partial responses excluded:\", sum(!fs$hhs_complete), \"\\n\")\n",
    "\n",
    "fs |>\n",
    "  filter(hhs_complete) |>\n",
    "  count(hhs_category) |>\n",
    "  mutate(pct = round(100 * n / sum(n), 1))"
   ],
   "id": "cell-013"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "`na.rm = FALSE` is doing the work, and the `if_else` on `hhs_complete` makes the\n",
    "exclusion explicit rather than implicit. Set `na.rm = TRUE` and a household that\n",
    "answered two of three questions scores as though it answered zero to the third —\n",
    "which is to say, as food secure.\n",
    "\n",
    "## The reduced Coping Strategies Index"
   ],
   "id": "cell-014"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "rcsi_weights <- c(\n",
    "  rcsi_less_preferred_food = 1, rcsi_borrowed_food = 2,\n",
    "  rcsi_limit_portion_size = 1, rcsi_restrict_adult_consumption = 3,\n",
    "  rcsi_reduce_meal_numbers = 1\n",
    ")\n",
    "\n",
    "fs <- fs |>\n",
    "  mutate(\n",
    "    rcsi = as.vector(as.matrix(pick(all_of(names(rcsi_weights)))) %*% rcsi_weights)\n",
    "  )\n",
    "\n",
    "summary(fs$rcsi)"
   ],
   "id": "cell-015"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## They are not proxies for one another"
   ],
   "id": "cell-016"
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "valid <- fs |> filter(fcs_complete)\n",
    "cor(valid$fcs, valid$rcsi) |> round(3)"
   ],
   "id": "cell-017"
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "About -0.45. A household can eat monotonously without yet resorting to coping\n",
    "strategies, and another can be coping heavily while eating a varied diet on\n",
    "borrowed food. Reporting one as a stand-in for the other loses real information.\n",
    "\n",
    "## What this does and does not produce\n",
    "\n",
    "Food consumption evidence used **in** an IPC analysis — not an IPC phase. A phase\n",
    "is assigned by a technical working group convening several outcome indicators\n",
    "against contributing factors, and printing \"Phase 3\" out of an FCS distribution\n",
    "skips the entire process the classification exists to represent."
   ],
   "id": "cell-018"
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "name": "R",
   "file_extension": ".r"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 5
}