---
title: "Self-serve funnel: 'the biggest leak' is two different questions"
subtitle: "Topic-15 worked example (LAT-2369) — the practitioner layer under the elementary video"
output:
  html_document:
    toc: true
    toc_float: true
    df_print: kable
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
options(digits = 7)
```

## The business question

A B2B software company sells self-serve. An account's path is five steps:

`visited_pricing` → `started_trial` → `activated` (first real use) → `invited_teammate`
→ `converted_paid`

One quarter of event data. The growth team has one sprint and has to point it at a step.
Someone asks the usual question: **where is the biggest leak?**

That question has two defensible answers that land on **different steps**, and a third
answer that only appears when the funnel is cut by acquisition channel. This worked
example produces all three.

## The data

One row per account per step reached — an event log, which is what the platform's funnel
tool consumes. Columns: `account_id`, `stage`, `event_at`, `channel`.

The dataset is CONSTRUCTED: per-channel counts at each stage are fixed, then day offsets
and row order are drawn with a fixed seed. Re-knitting reproduces `data.csv` byte-for-byte.

```{r generate}
set.seed(20260824)

stages   <- c("visited_pricing", "started_trial", "activated",
              "invited_teammate", "converted_paid")
channels <- c("paid_search", "direct", "partner")

# accounts reaching each stage, by channel (rows = channel, cols = stage)
counts <- rbind(
  paid_search = c(1200, 456, 274, 110, 82),
  direct      = c( 800, 344, 216,  97, 74),
  partner     = c( 500, 250, 190,  38, 24)
)
colnames(counts) <- stages

# days BETWEEN consecutive steps, drawn per account and accumulated, so an account's
# timestamps can never run backwards (a trial cannot activate before it starts)
gap_lo <- c(0, 0, 1, 2,  7)
gap_hi <- c(0, 2, 5, 9, 20)

start_pool <- as.Date("2026-04-01") + 0:75   # a quarter of first-touch dates

# distinct id prefix per channel — "paid_search" and "partner" share their first two
# letters, so a 2-char prefix silently collides 500 account ids across two channels
prefix <- c(paid_search = "psr", direct = "dir", partner = "ptn")

rows <- do.call(rbind, lapply(channels, function(ch) {
  n_top  <- counts[ch, 1]
  ids    <- sprintf("acct_%s_%04d", prefix[[ch]], seq_len(n_top))
  first  <- start_pool[sample(length(start_pool), n_top, replace = TRUE)]

  # cumulative day offsets per account: column s is days from the pricing visit to stage s
  gaps <- sapply(seq_along(stages), function(s)
    if (gap_hi[s] == gap_lo[s]) rep(gap_lo[s], n_top)
    else sample(gap_lo[s]:gap_hi[s], n_top, replace = TRUE))
  offs <- t(apply(gaps, 1, cumsum))

  # the first k accounts of each channel progress to each stage: deterministic nesting,
  # so every account's path is a genuine prefix of the funnel
  do.call(rbind, lapply(seq_along(stages), function(s) {
    k <- counts[ch, s]
    if (k == 0) return(NULL)
    data.frame(account_id = ids[seq_len(k)],
               stage      = stages[s],
               event_at   = first[seq_len(k)] + offs[seq_len(k), s],
               channel    = ch,
               stringsAsFactors = FALSE)
  }))
}))

rows <- rows[order(rows$account_id, rows$event_at), ]
rownames(rows) <- NULL
write.csv(rows, "data.csv", row.names = FALSE)

nrow(rows)
```

```{r peek}
head(rows, 8)
```

## The funnel

```{r funnel}
reached <- sapply(stages, function(s) sum(rows$stage == s))
lost    <- c(NA, head(reached, -1) - tail(reached, -1))
rate    <- c(NA, tail(reached, -1) / head(reached, -1))

wilson <- function(x, n) {
  if (is.na(x)) return(c(NA, NA))
  ct <- prop.test(x, n)          # Wilson score with continuity correction
  ct$conf.int * 100
}
ci <- t(sapply(seq_along(stages), function(i)
  if (i == 1) c(NA, NA) else wilson(reached[i], reached[i - 1])))

funnel_tbl <- data.frame(
  step        = c("—", paste(head(stages, -1), "→", tail(stages, -1))),
  reached     = as.integer(reached),
  lost_here   = lost,
  step_rate   = ifelse(is.na(rate), NA, sprintf("%.1f%%", 100 * rate)),
  ci_95       = ifelse(is.na(ci[, 1]), NA, sprintf("%.1f – %.1f", ci[, 1], ci[, 2]))
)
knitr::kable(funnel_tbl, align = "lrrrr",
             col.names = c("step", "accounts reaching", "lost at this step",
                           "step conversion", "95% CI (pp)"),
             caption = "Quarterly self-serve funnel. Two different columns answer 'biggest leak'.")
```

```{r answers}
biggest_loss_i <- which.max(lost)
worst_rate_i   <- which.min(rate)
cat("MOST ACCOUNTS LOST :", funnel_tbl$step[biggest_loss_i],
    "-", lost[biggest_loss_i], "accounts\n")
cat("WORST CONVERSION   :", funnel_tbl$step[worst_rate_i],
    "-", sprintf("%.1f%%", 100 * rate[worst_rate_i]), "\n")
cat("end to end         :", sprintf("%.1f%%", 100 * reached[5] / reached[1]), "\n")
```

Two honest answers, two different steps. The entry step bleeds the most accounts because
it starts with the most; the invite step converts worst.

Are those two rates actually distinguishable, or is one inside the other's error bar?

```{r overlap}
rbind(`visited→trial`    = wilson(reached[2], reached[1]),
      `activated→invite` = wilson(reached[4], reached[3]))
```

The intervals do not overlap, so the invite step is genuinely the worse-converting one —
not a ranking that a re-run could flip.

```{r chart-funnel, fig.height=4.6, fig.width=8}
par(mar = c(6.5, 5, 3, 1))
bp <- barplot(reached, col = "#5fa9dd", border = NA, las = 2, ylim = c(0, 2800),
              names.arg = gsub("_", "\n", stages), ylab = "accounts",
              main = "The funnel, with what each step costs")
text(bp, reached + 130, format(reached, big.mark = ","), font = 2, cex = 0.9)
for (i in 2:5) {
  segments(bp[i - 1], reached[i - 1], bp[i], reached[i], col = "#F97316", lwd = 2)
  text((bp[i - 1] + bp[i]) / 2, (reached[i - 1] + reached[i]) / 2 + 190,
       sprintf("-%s", format(lost[i], big.mark = ",")), col = "#F97316", font = 2, cex = 0.9)
}
```

## The same funnel, cut by acquisition channel

```{r bychannel}
ch_rate <- function(s_to, s_from) counts[, s_to] / counts[, s_from]
by_ch <- data.frame(
  channel                = channels,
  accounts               = as.integer(counts[, 1]),
  `visited→trial`        = sprintf("%.1f%%", 100 * ch_rate(2, 1)),
  `trial→activated`      = sprintf("%.1f%%", 100 * ch_rate(3, 2)),
  `activated→invited`    = sprintf("%.1f%%", 100 * ch_rate(4, 3)),
  `invited→paid`         = sprintf("%.1f%%", 100 * ch_rate(5, 4)),
  check.names = FALSE, row.names = NULL
)
knitr::kable(by_ch, align = "lrrrrr",
             caption = "Channel cut. Read the two middle columns together.")
```

Partner-sourced accounts are the **best** at activating (`r sprintf("%.1f%%", 100*ch_rate(3,2)["partner"])`
against paid search's `r sprintf("%.1f%%", 100*ch_rate(3,2)["paid_search"])`) and the
**worst** at inviting a teammate (`r sprintf("%.1f%%", 100*ch_rate(4,3)["partner"])`
against paid search's `r sprintf("%.1f%%", 100*ch_rate(4,3)["paid_search"])`). The
aggregate invite rate of `r sprintf("%.1f%%", 100*rate[4])` is an average over a channel
that is twice as good and a channel that is half as good.

```{r reversal-tests}
# partner vs paid_search at the activation step
act <- prop.test(c(counts["partner", 3], counts["paid_search", 3]),
                 c(counts["partner", 2], counts["paid_search", 2]))
# partner vs paid_search at the invite step
inv <- prop.test(c(counts["partner", 4], counts["paid_search", 4]),
                 c(counts["partner", 3], counts["paid_search", 3]))
c(activation_p = act$p.value, invite_p = inv$p.value)
act$conf.int * 100
inv$conf.int * 100
```

Both directions of the reversal are far beyond chance.

```{r chart-reversal, fig.height=4.4, fig.width=8}
par(mar = c(4, 5, 3, 1))
m <- rbind(`trial→activated`   = 100 * ch_rate(3, 2),
           `activated→invited` = 100 * ch_rate(4, 3))
bp2 <- barplot(m, beside = TRUE, col = c("#3fbf6f", "#F97316"), border = NA,
               ylim = c(0, 108), ylab = "step conversion (%)",   # headroom: at 90 the 76% label collided with the legend
               main = "The reversal: best at one step, worst at the next")
text(bp2, m + 4, sprintf("%.0f%%", m), cex = 0.85)
legend("top", rownames(m), fill = c("#3fbf6f", "#F97316"), bty = "n", border = NA,
       horiz = TRUE, inset = c(0, -0.02), xpd = TRUE)   # horizontal, above the plot: never over a bar label
abline(h = 100 * rate[4], lty = 2, col = "#918e98")
text(par("usr")[2], 100 * rate[4] + 3, "aggregate invite rate", adj = c(1, 0),
     col = "#918e98", cex = 0.8)
```

## The chooser the lesson teaches

1. **"Biggest leak" is two questions.** *Which step loses the most accounts* is a
   question about volume and is answered by the loss column. *Which step converts worst*
   is a question about the step itself and is answered by the rate column. On this funnel
   they name different steps, and both answers are correct.
2. **The volume answer is partly arithmetic.** The first step will usually lose the most
   simply because it holds the most accounts. That does not make it the broken one.
3. **Check the intervals before you rank steps.** Two step rates whose confidence
   intervals overlap are not reliably ordered. Here they do not overlap, so the ranking
   holds.
4. **An aggregate rate is an average over segments that may point opposite ways.** The
   invite step looks uniformly weak until it is cut by channel, at which point partner
   accounts turn out to be the whole problem — and the same channel is the *best*
   performer one step earlier. Fixing "the invite step" for everyone would be the wrong
   sprint; fixing partner onboarding is the right one.