---
title: "Referral completion and where the pathway breaks"
subtitle: "Protection referrals, 2024 · R"
author: "Cassion · data-analysis.cassion.dev"
format:
  html:
    toc: true
    code-fold: false
---

## Before any code

Synthetic data modelling protection and GBV cases. No real person is described,
and this file must never be used as a template for storing real case data — the
safe version of that is a consent-governed case management system.

The same decomposition as the Python example, in dplyr, with the contradictory
and missing records handled explicitly rather than dropped silently.

## Setup

```{r}
#| message: false
library(readr)
library(dplyr)
library(tidyr)

URL <- paste0(
  "https://data-analysis.cassion.dev/datasets/files/",
  "protection-referrals-2024.v1.csv"
)

cases <- read_csv(URL, col_types = cols(
  case_id  = col_character(),
  .default = col_guess()
))

glimpse(cases)
```

## Consent gates the denominator

```{r}
cases |>
  summarise(
    cases            = n(),
    consented        = sum(consent_to_refer),
    consent_rate     = round(mean(consent_to_refer), 3)
  )
```

```{r}
consenting <- cases |> filter(consent_to_refer)

consenting |>
  summarise(
    denominator = n(),
    completed   = sum(referral_accepted),
    completion  = round(mean(referral_accepted), 3)
  )
```

The completion denominator is cases that consented, not all cases. Counting a
non-consenting case as a pathway failure both misstates performance and
misrepresents a person's decision — the pathway did what it should when someone
declined.

## Handle the contradictions explicitly

```{r}
cases |>
  summarise(
    time_but_not_accepted   = sum(!referral_accepted & !is.na(days_to_first_service)),
    time_but_no_referral    = sum(!referral_made & !is.na(days_to_first_service)),
    time_but_no_consent     = sum(!consent_to_refer & !is.na(days_to_first_service)),
    accepted_but_no_time    = sum(referral_accepted & is.na(days_to_first_service))
  ) |>
  pivot_longer(everything(), names_to = "contradiction", values_to = "cases")
```

Eleven records carry a service time with no accepted referral behind it, and six
of those show no referral made at all. Forty accepted referrals have no time
recorded, which means **the timeliness denominator is smaller than the completion
denominator** — using one for both misstates both.

```{r}
cases <- cases |>
  mutate(contradictory = !referral_accepted & !is.na(days_to_first_service))

cat("flagged, not dropped:", sum(cases$contradictory), "\n")
```

Flagging rather than dropping matters here. In case management a contradictory
record is an entry issue to send back to the caseworker, and deleting it destroys
the only trace that the case existed.

## Normalise disability before disaggregating

```{r}
count(cases, disability_reported)
```

```{r}
cases <- cases |>
  mutate(
    disability = case_when(
      tolower(trimws(disability_reported)) %in% c("true", "yes") ~ TRUE,
      tolower(trimws(disability_reported)) %in% c("false", "no")  ~ FALSE,
      TRUE ~ NA
    )
  )

consenting <- cases |> filter(consent_to_refer)
count(consenting, disability)
```

One area used `Yes` and `No`. Left alone the disaggregation fragments into four
categories, two of them from that single area and too small to interpret.

## Where the pathway breaks

```{r}
completion <- function(df, by) {
  df |>
    group_by(across(all_of(by))) |>
    summarise(
      cases      = n(),
      completed  = sum(referral_accepted),
      completion = round(mean(referral_accepted), 3),
      .groups = "drop"
    ) |>
    arrange(completion)
}

completion(consenting, "service_requested")
```

```{r}
completion(consenting, "admin2")
```

Livelihood support completes at about 23% against health at about 62%. That is
not caseworker performance — it is which services exist and have capacity. An
analysis that stops at the overall 46% hides the whole finding.

```{r}
grid <- consenting |>
  group_by(admin2, service_requested) |>
  summarise(cases = n(), completion = round(mean(referral_accepted), 2), .groups = "drop") |>
  mutate(completion = if_else(cases >= 20, completion, NA_real_)) |>
  select(-cases) |>
  pivot_wider(names_from = service_requested, values_from = completion)

grid
```

Cells below twenty cases are blanked. A rate on eight cases is not a finding, and
in protection work a small cell is a disclosure risk as well as a statistical one.

## The equity finding

```{r}
by_disability <- consenting |>
  filter(!is.na(disability)) |>
  completion("disability")

by_disability
```

```{r}
tbl <- table(
  consenting$disability[!is.na(consenting$disability)],
  consenting$referral_accepted[!is.na(consenting$disability)]
)
chisq.test(tbl)
```

Cases where a disability was reported complete about seventeen points lower, and
the difference is unlikely to be chance. What it does not tell you is *why* —
whether services are physically inaccessible, whether pathways assume mobility
some clients do not have, or something else. That is answered by asking
caseworkers, not by this table.

## Small cells are a protection risk

```{r}
consenting |>
  count(admin2, case_category) |>
  filter(n < 20)
```

This check returns nothing here — every area-by-category cell clears twenty — and
that empty result is the point of running it. A district cell of three GBV cases
can identify a survivor to anyone who knows the area, so the check goes in the
pipeline permanently rather than being run once. Set the threshold with the case
management agency, not as a formatting choice.

## What to report

Completion on the consent-gated denominator, decomposed far enough to locate the
failing node, contradictions flagged and counted, the disability gap stated
plainly — and nothing at a granularity that could identify a person.