Rater Agreement (Kappa)

Shows how well two raters agree on categories beyond what chance would give, with weighted kappa when the categories have an order, which categories they agree on least, and where their disagreements fall.

VERSION · v1.0.0
RUN DATE · 14 September 2026
DATA · 220 rows
Objective

How well do our two reviewers agree when they grade case severity, and where do they disagree?

This report contains
  • SummaryKappa, the raw agreement and the agreement chance alone would give.
  • Kappa with its rangeEach kappa with its likely range.
  • Who said whatHow many items each pair of categories received; the diagonal is agreement.
  • Agreement on each categoryOf the times either rater chose a category, how often both did.
  • How each rater uses the categoriesThe share of items each rater put in each category, side by side.
  • Which agreement figure to reportEvery agreement statistic with its range, band and what it answers.
  • Where the raters disagreeThe category pairs the raters disagree on most, with example items.
  • What the results rely onEach condition the agreement figures depend on, and whether it holds.
  • How it was doneThe method, the data used, and what to keep in mind.
1 / 7
Rater Agreement (Kappa)

How well the raters agree

Weighted kappas rise above unweighted form

Weighted kappas pull clearly higher, showing most disagreements are near misses rather than opposite judgments.

Compare the three estimate points left to right: Cohen's kappa sits lowest, linear-weighted above it, quadratic-weighted highest.

Agreement strong on None and Mild, weaker on Moderate

Reviewers agree clearly on None and Mild cases, but Moderate cases split between raters, limiting overall agreement.

The diagonal shows agreement concentrated in None and Mild; Moderate cases scatter across the Moderate and Severe columns.

2 / 7
Rater Agreement (Kappa)

Where agreement is weak

None ratings show strongest agreement

Agreement varies across categories, strongest on None and weakest on Moderate severity ratings.

The None bar rises clearly ahead, while Moderate sits lowest; the other two fall between.

Reviewers use categories in similar proportions

Both raters favour None and Mild categories similarly, with closely aligned distributions across all severity levels.

None and Mild rows show both raters cluster in the same ranges, while Severe differs slightly between them.

3 / 7
Rater Agreement (Kappa)

The numbers

Reviewers agree strongly, near misses matter less

Reviewers agree well beyond chance; weighted kappa shows near-miss disagreements matter little for severity grades.

Quadratic-weighted kappa rises notably higher than linear-weighted kappa, showing far disagreements are rarer than near ones.

4 / 7
Rater Agreement (Kappa)

The numbers

Raters diverge most on mild versus none

Reviewer A and Reviewer B disagree most when one rates none and the other rates mild, usually one step apart.

Disagreements stay one step apart except for two rare pairs that jump two steps, suggesting raters mostly differ by adjacent categories rather than far apart.

5 / 7
Rater Agreement (Kappa)

Assumptions and method

All five checks hold

All five assumption checks hold, so nothing here limits how far the results can be trusted.

Holding: enough items, every category used by both raters, raters use categories equally often, no single category dominates, and one more.

Cohen's kappa between Reviewer A and Reviewer B over 216 items rated by both, from the 4 by 4 table of their categories (None, Mild, Moderate, Severe); 95% intervals from the Fleiss, Cohen and Everitt standard error; bands after Landis and Koch; categories read as ordered (the labels all sit on a severity scale: None < Mild < Moderate < Severe), so linear- and quadratic-weighted kappa give near misses partial credit; excluded or merged: 4 items missing a rating from either rater; 2 labels differing only in case merged; not used: Batch, Notes (not mapped); the prevalence- and bias-adjusted kappa and the highest kappa the category shares allow are reported beside kappa.

216 of 220 rows · Reviewer A → Reviewer B

caveatCategories read as ordered severity scale; linear and quadratic weighting give partial credit for near misses.

6 / 7
Rater Agreement (Kappa)

The code behind this report

The code that produced every figure in this report, exactly as it ran. Fingerprint 731726ade8fe3097. The same code on the same data gives the same report.

`standard_kappa_v2` <- function(pf) {
  `%||%` <- function(a, b) if (!is.null(a)) a else b
  #' Readable figures (LAT-3180, LAT-3181): whole numbers from a thousand up, one decimal from a hundred, two from
  #' one, three significant figures below one. A cell carries what the value needs, not what R prints.
  tidy <- function(x) {
    x <- as.numeric(x)
    ifelse(is.na(x), NA_real_,
      ifelse(abs(x) >= 1000, round(x, 0),
        ifelse(abs(x) >= 100, round(x, 1),
          ifelse(abs(x) >= 1, round(x, 2), signif(x, 3)))))
  }
  #' P-values below 0.0001 leave as text (LAT-3181): the four-decimal serializer rounds 1.4e-05 to 0.
  p_text <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else format(signif(p, 3))
  inputs <- pf$taskList$inputs
  params <- inputs$module_parameters %||% list()
  # THE QUESTION this tool answers: the customer's objective, verbatim, when given.
  question <- (inputs$userContext %||% list())$objective %||%
    "How well do these two raters agree beyond chance, and where do they disagree?"

  #' ## Column mapping
  #' Wide format, one row per item: `first_rater` and `second_rater` hold each rater's category for the same item, and an
  #' optional `item_label` names the item. Semantic names inside; the customer's own headers live in `col_map`.
  col_map <- inputs$column_mapping %||% list()
  df <- renderObject.taskFunction.init(inputs, col_map)   # df has SEMANTIC names
  human <- function(sem) {
    v <- col_map[[sem]]
    if (is.null(v) || !nzchar(as.character(v))) sem else as.character(v)
  }
  r1_name <- human("first_rater"); r2_name <- human("second_rater")
  for (sem in c("first_rater", "second_rater"))
    if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
  has_label <- "item_label" %in% names(df)
  n_in <- nrow(df)

  #' ## The columns this tool did not look at, read from the raw rows (init narrows `df` to the mapped columns)
  raw_names <- local({
    ds <- inputs$dataset %||% inputs$df
    if (is.data.frame(ds)) return(names(ds))
    if (is.list(ds) && length(ds) > 0) {
      rows <- ds[seq_len(min(length(ds), 50))]
      nm <- unique(unlist(lapply(rows, function(r) if (is.list(r)) names(r) else NULL)))
      if (length(nm)) return(nm)
      if (!is.null(names(ds)) && all(nzchar(names(ds)))) return(names(ds))
    }
    character(0)
  })
  mapped_actual <- unique(as.character(unlist(col_map)))
  ignored_cols <- setdiff(raw_names, unique(c(mapped_actual, make.names(mapped_actual))))

  #' ## Parameters
  #' `categories_ordered`: auto (the default: an order is read from the labels when they are numbers, start with a
  #' number, or all sit on one recognised ordinal scale), yes (weighted kappa when an order can be read) or no.
  ord_param <- tolower(as.character(params$categories_ordered %||% "auto"))
  if (!(ord_param %in% c("auto", "yes", "no"))) stop("module_parameters$categories_ordered must be auto, yes or no")

  #' ## Data preparation
  #' Labels are trimmed, and labels that differ only in case are one category (counted). An item missing either
  #' rating is excluded and counted. At least 10 paired items and 2 categories are required; more than 20 categories
  #' is refused (numeric scores belong in the ICC tool).
  norm <- function(v) { x <- trimws(as.character(v)); x[is.na(x) | x == "" | tolower(x) %in% c("na", "n/a", "null", "nan")] <- NA; x }
  a <- norm(df$first_rater); b <- norm(df$second_rater)
  item <- if (has_label) { l <- trimws(as.character(df$item_label)); l[is.na(l) | l == ""] <- paste0("Row ", which(is.na(l) | l == "")); l } else paste0("Row ", seq_len(n_in))
  both <- !is.na(a) & !is.na(b)
  n_missing <- sum(!both)
  if (sum(both) < 10) stop(sprintf("Only %d items carry a rating from both raters; kappa needs at least 10.", sum(both)))
  a <- a[both]; b <- b[both]; item <- item[both]; n <- length(a)
  labs_all <- c(a, b); keys_all <- tolower(labs_all)
  disp <- labs_all[!duplicated(keys_all)]; names(disp) <- keys_all[!duplicated(keys_all)]
  n_recased <- length(unique(labs_all)) - length(unique(keys_all))
  keys <- names(disp)
  if (length(keys) < 2) stop("Every rating is the same category; agreement beyond chance cannot be measured with one category.")
  if (length(keys) > 20) stop(sprintf("%d distinct categories; this tool compares categorical ratings with up to 20 categories. Numeric scores belong in the ICC tool.", length(keys)))

  #' ## Category order: read from the labels, never assumed (three rules, the first that fires is named)
  detect_order <- function(levs) {
    clean <- trimws(levs)
    num <- suppressWarnings(as.numeric(clean))
    if (!anyNA(num) && length(unique(num)) == length(num))
      return(list(ordered = TRUE, order = levs[order(num)], rule = "the labels are numbers"))
    lead <- suppressWarnings(as.numeric(sub("^\\s*([-+]?[0-9]+(\\.[0-9]+)?)\\s*[-=.):|].*$", "\\1", clean)))
    has_lead <- grepl("^\\s*[-+]?[0-9]+(\\.[0-9]+)?\\s*[-=.):|]", clean)
    if (all(has_lead) && !anyNA(lead) && length(unique(lead)) == length(lead))
      return(list(ordered = TRUE, order = levs[order(lead)], rule = "every label starts with a number"))
    scales <- list(
      "an agreement scale" = c("strongly disagree", "disagree", "somewhat disagree", "slightly disagree", "neutral", "neither agree nor disagree", "slightly agree", "somewhat agree", "agree", "strongly agree"),
      "a quality scale" = c("very poor", "poor", "below average", "fair", "average", "satisfactory", "good", "very good", "excellent", "outstanding"),
      "a frequency scale" = c("never", "rarely", "seldom", "sometimes", "occasionally", "often", "frequently", "usually", "always"),
      "a severity scale" = c("none", "minimal", "mild", "moderate", "severe", "very severe", "extreme", "critical"),
      "a magnitude scale" = c("very low", "low", "medium", "moderate", "high", "very high"),
      "a satisfaction scale" = c("very dissatisfied", "dissatisfied", "neutral", "satisfied", "very satisfied"),
      "a likelihood scale" = c("very unlikely", "unlikely", "possible", "likely", "very likely", "certain"),
      "a priority scale" = c("trivial", "minor", "moderate", "major", "critical", "blocker"))
    low <- tolower(clean)
    if (length(levs) >= 3 && !any(duplicated(low)))
      for (nm in names(scales)) if (all(low %in% scales[[nm]]))
        return(list(ordered = TRUE, order = levs[order(match(low, scales[[nm]]))], rule = paste0("the labels all sit on ", nm)))
    list(ordered = FALSE, order = sort(levs), rule = "no numbers, numeric prefixes or recognised ordinal wording in the labels")
  }
  det <- detect_order(unname(disp))
  levs <- det$order; K <- length(levs); lev_keys <- tolower(levs)
  ordered <- ord_param != "no" && det$ordered
  order_sentence <- if (ordered && K >= 3) sprintf("categories read as ordered (%s: %s), so linear- and quadratic-weighted kappa give near misses partial credit", det$rule, paste(levs, collapse = " < ")) else
    if (ordered) sprintf("categories read as ordered (%s), but with two categories every disagreement is the largest possible, so weighted kappa equals kappa and is not reported", det$rule) else
    if (ord_param == "no") "categories treated as unordered as requested, so no weighted kappa" else
    sprintf("categories treated as unordered (%s), so no weighted kappa", det$rule)

  #' ## Kappa: Cohen's in its general weighted form, Fleiss, Cohen and Everitt (1969) standard error
  N <- matrix(as.numeric(table(factor(tolower(a), levels = lev_keys), factor(tolower(b), levels = lev_keys))), K, K)
  p <- N / n
  kappa_general <- function(p, W, n) {
    rowm <- rowSums(p); colm <- colSums(p)
    po <- sum(p * W); pe <- sum(W * outer(rowm, colm))
    if (!is.finite(pe) || (1 - pe) <= 1e-12) return(list(kappa = NA_real_, po = po, pe = pe, se = NA_real_))
    k <- (po - pe) / (1 - pe)
    M <- outer(as.vector(W %*% colm), as.vector(t(W) %*% rowm), "+")
    inner <- sum(p * (W - M * (1 - k))^2) - (k - pe * (1 - k))^2
    list(kappa = k, po = po, pe = pe, se = if (is.finite(inner) && inner > 0) sqrt(inner / (n * (1 - pe)^2)) else NA_real_)
  }
  ci <- function(k, s) if (is.na(k) || is.na(s)) c(NA_real_, NA_real_) else c(max(-1, k - stats::qnorm(0.975) * s), min(1, k + stats::qnorm(0.975) * s))
  band <- function(x) if (is.na(x)) "not estimable" else if (x < 0) "worse than chance" else if (x <= 0.20) "slight" else
    if (x <= 0.40) "fair" else if (x <= 0.60) "moderate" else if (x <= 0.80) "substantial" else "almost perfect"
  base <- kappa_general(p, diag(K), n)
  kappa <- base$kappa; po <- base$po; pe <- base$pe; kci <- ci(kappa, base$se)
  weighted <- ordered && K >= 3
  if (weighted) {
    d <- abs(outer(seq_len(K), seq_len(K), "-")) / (K - 1)
    kl <- kappa_general(p, 1 - d, n); kq <- kappa_general(p, 1 - d^2, n)
  }
  pabak <- (K * po - 1) / (K - 1)
  rowm <- rowSums(p); colm <- colSums(p)
  kmax <- if ((1 - pe) > 1e-12) (sum(pmin(rowm, colm)) - pe) / (1 - pe) else NA_real_

  #' ## The frames for the places
  interval_df <- data.frame(form = "Cohen's kappa", estimate = round(kappa, 3), low = round(kci[1], 3), high = round(kci[2], 3), stringsAsFactors = FALSE)
  if (weighted) {
    lci <- ci(kl$kappa, kl$se); qci <- ci(kq$kappa, kq$se)
    interval_df <- rbind(interval_df,
      data.frame(form = "Linear-weighted kappa", estimate = round(kl$kappa, 3), low = round(lci[1], 3), high = round(lci[2], 3), stringsAsFactors = FALSE),
      data.frame(form = "Quadratic-weighted kappa", estimate = round(kq$kappa, 3), low = round(qci[1], 3), high = round(qci[2], 3), stringsAsFactors = FALSE))
  }
  conf_df <- data.frame(rater_1_category = rep(levs, times = K), rater_2_category = rep(levs, each = K),
                        items = as.integer(as.vector(N)), stringsAsFactors = FALSE)
  spec_agree <- ifelse(rowSums(N) + colSums(N) > 0, 200 * diag(N) / (rowSums(N) + colSums(N)), NA_real_)
  cat_df <- data.frame(category = levs, agreement_pct = round(spec_agree, 1), stringsAsFactors = FALSE)
  marg_df <- data.frame(category = rep(levs, 2), share_pct = round(100 * c(rowm, colm), 1),
                        rater = rep(c(r1_name, r2_name), each = K), stringsAsFactors = FALSE)
  table_df <- data.frame(
    statistic = c("Observed agreement (%)", "Agreement expected by chance (%)", "Cohen's kappa"),
    estimate = c(tidy(100 * po), tidy(100 * pe), round(kappa, 3)),
    low = c(NA, NA, round(kci[1], 3)), high = c(NA, NA, round(kci[2], 3)),
    band = c("", "", band(kappa)),
    reading = c("share of items both raters put in the same category", "share two raters with these category shares would match by chance",
                "agreement beyond chance, every disagreement counted the same"), stringsAsFactors = FALSE)
  if (weighted) table_df <- rbind(table_df, data.frame(
    statistic = c("Linear-weighted kappa", "Quadratic-weighted kappa"), estimate = round(c(kl$kappa, kq$kappa), 3),
    low = round(c(lci[1], qci[1]), 3), high = round(c(lci[2], qci[2]), 3), band = c(band(kl$kappa), band(kq$kappa)),
    reading = c("near misses get partial credit in proportion to their distance", "far misses count much more heavily than near misses"), stringsAsFactors = FALSE))
  table_df <- rbind(table_df, data.frame(
    statistic = c("Highest kappa these category shares allow", "Prevalence- and bias-adjusted kappa (PABAK)"),
    estimate = round(c(kmax, pabak), 3), low = NA, high = NA, band = c(band(kmax), band(pabak)),
    reading = c("the ceiling set by how differently the two raters use the categories", "what kappa would be if every category were used equally often by both"), stringsAsFactors = FALSE))

  off <- which(N > 0 & row(N) != col(N), arr.ind = TRUE)
  n_disagree <- sum(N) - sum(diag(N))
  dis_df <- if (nrow(off) > 0) {
    o <- off[order(-N[off]), , drop = FALSE][seq_len(min(nrow(off), 10)), , drop = FALSE]
    ex <- vapply(seq_len(nrow(o)), function(i) {
      hit <- which(tolower(a) == lev_keys[o[i, 1]] & tolower(b) == lev_keys[o[i, 2]])
      paste(utils::head(item[hit], 3), collapse = ", ")
    }, character(1))
    data.frame(rater_1_says = levs[o[, 1]], rater_2_says = levs[o[, 2]], items = as.integer(N[o]),
               share_pct = round(100 * N[o] / n_disagree, 1),
               steps_apart = if (ordered) as.integer(abs(o[, 1] - o[, 2])) else NA_integer_,
               example_items = ex, stringsAsFactors = FALSE)
  } else NULL

  #' ## Assumption checks (LAT-3138)
  bowker <- local({
    idx <- which(upper.tri(N) & (N + t(N)) > 0)
    if (!length(idx)) return(list(stat = 0, df = 0, p = 1))
    chi <- sum((N[idx] - t(N)[idx])^2 / (N[idx] + t(N)[idx]))
    list(stat = chi, df = length(idx), p = stats::pchisq(chi, df = length(idx), lower.tail = FALSE))
  })
  used_both <- sum(rowSums(N) > 0 & colSums(N) > 0)
  top_share <- max((rowm + colm) / 2)
  miss_share <- n_missing / n_in
  checks_df <- data.frame(
    check = c("Enough items", "Every category used by both raters", "Raters use categories equally often",
              "No single category dominates", "Ratings paired and complete"),
    statistic = c(sprintf("%d items rated by both", n), sprintf("%d of %d categories used by both", used_both, K),
                  sprintf("Bowker symmetry test, %d pairs", bowker$df), sprintf("largest category holds %s%% of ratings", format(round(100 * top_share, 1))),
                  sprintf("%d of %d items missing a rating", n_missing, n_in)),
    p_value = c("", "", p_text(bowker$p), "", ""),
    verdict = c(if (n >= 50) "holds" else if (n >= 20) "strained" else "violated",
                if (used_both == K) "holds" else if (used_both == K - 1) "strained" else "violated",
                if (bowker$p >= 0.05) "holds" else if (bowker$p >= 0.01) "strained" else "violated",
                if (top_share <= 0.7) "holds" else if (top_share <= 0.9) "strained" else "violated",
                if (miss_share <= 0.05) "holds" else if (miss_share <= 0.15) "strained" else "violated"),
    note = c("few items leave kappa with a wide interval",
             "a category one rater never uses cannot be agreed on, and it caps kappa",
             "one rater choosing some categories more often than the other (bias) lowers kappa even when their ratings track each other",
             "when one category holds most ratings, chance agreement is high and kappa sits low beside the raw agreement",
             "items missing a rating are left out; if they were the hard ones, agreement is overstated"),
    stringsAsFactors = FALSE)

  #' ## Method, assumptions, answer
  excluded <- c(if (n_missing > 0) sprintf("%d item%s missing a rating from either rater", n_missing, if (n_missing > 1) "s" else ""),
                if (n_recased > 0) sprintf("%d label%s differing only in case merged", n_recased, if (n_recased > 1) "s" else ""))
  method <- paste0(
    "Cohen's kappa between ", r1_name, " and ", r2_name, " over ", n, " items rated by both, from the ", K, " by ", K,
    " table of their categories (", paste(levs, collapse = ", "), "); 95% intervals from the Fleiss, Cohen and Everitt standard error; bands after Landis and Koch; ",
    order_sentence,
    if (length(excluded)) paste0("; excluded or merged: ", paste(excluded, collapse = "; ")) else "",
    if (length(ignored_cols)) paste0("; not used: ", paste(utils::head(ignored_cols, 12), collapse = ", "), " (not mapped)") else "",
    "; the prevalence- and bias-adjusted kappa and the highest kappa the category shares allow are reported beside kappa.")
  assumptions <- list(
    "The two raters rated the same items independently; a rater who saw the other's call inflates agreement.",
    "The categories are exhaustive and mutually exclusive, and both raters used the same definitions.",
    "Kappa depends on how often each category occurs: the same two raters score lower where one category dominates.",
    "Weighted kappa means something only when the categories have a real order.",
    "The Landis and Koch bands are a convention, not a decision rule.")
  answer <- list(kappa = round(kappa, 3), kappa_low = round(kci[1], 3), kappa_high = round(kci[2], 3), band = band(kappa),
                 percent_agreement = round(100 * po, 1), chance_agreement = round(100 * pe, 1),
                 kappa_linear = if (weighted) round(kl$kappa, 3) else NULL, kappa_quadratic = if (weighted) round(kq$kappa, 3) else NULL,
                 pabak = round(pabak, 3), ordered = ordered, categories = levs, n = n)

  results <- list()
  #' The verdict and the headline are NOT places of a library tool (LAT-3130): the last mile writes them.
  results$summary_metrics <- place_metric(list(kappa = round(kappa, 3), percent_agreement = round(100 * po, 1),
    chance_agreement = round(100 * pe, 1), pabak = round(pabak, 3), items = n, categories = K), lead = "kappa", place = "summary_metrics")
  results$kappa_interval <- place_interval(interval_df, term = "form", value = "estimate", low = "low", high = "high", place = "kappa_interval")
  results$confusion_matrix <- place_matrix(conf_df, x = "rater_2_category", y = "rater_1_category", z = "items", place = "confusion_matrix")
  results$category_agreement <- place_comparison(cat_df, category = "category", value = "agreement_pct", place = "category_agreement")
  results$rater_marginals <- place_comparison(marg_df, category = "category", value = "share_pct", series = "rater", place = "rater_marginals")
  results$kappa_table <- place_table(table_df, place = "kappa_table")
  if (!is.null(dis_df)) {
    results$top_disagreements <- place_table(dis_df, place = "top_disagreements")
  } else {
    results$top_disagreements <- place_dropped("the two raters put every item in the same category, so there is no disagreement to list", place = "top_disagreements")
  }
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
  results$agreement_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n, excluded = as.list(excluded), assumptions = assumptions,
    x_column = r1_name, y_column = r2_name),
    value_order = list("n_used", "n_in"))

  objects <- list()   # filled by the object layer, not here
  list(answer = answer, method = method, n = n, results = results, objects = objects,
       json_output = list(answer = answer, method = method, n = n))
}
Want to run this analysis on your own data? Upload CSV — Free Analysis See Pricing