Market Basket (Association Rules)

Shows which items are bought together: every pairing with its support, confidence and lift, a chi-square test adjusted for testing many pairs, the pairings ranked, and what the baskets look like.

VERSION · v1.0.0
RUN DATE · 15 September 2026
DATA · 2,059 rows
Objective

Which items sell together in these baskets, and which pairings are worth acting on?

This report contains
  • Summary MetricsThe few supporting numbers, read at a glance.
  • Top RulesWhich group is larger, and by how much.
  • Rule ScatterWhether two things vary together.
  • Pair MatrixWhich pairs move together, across all of them.
  • Item FrequencyWhich group is larger, and by how much.
  • Rules TableThe actual numbers, in full.
  • Basket SizeWhat the spread looks like, and whether it is skewed.
  • Assumption ChecksWhich assumptions hold, which are strained, and which are violated, each with the test behind it.
  • Basket MethodHow it was produced, and what would make it wrong.
1 / 9
Market Basket (Association Rules)

What sells together

Butter and bread pair strongest together

Butter and bread rise far above other pairings, clearly the most worth acting on.

The first two rows show butter and bread leading all other rules by a clear margin.

High confidence rules cluster at modest support

Strongest pairings appear rarely; many weak ones occur often. Few rules are both common and reliable.

Upper left corner shows two points with high confidence and moderate support, standing apart from the dense lower cluster.

2 / 9
Market Basket (Association Rules)

The pairings

Bread butter pair stands out distinctly

Bread and butter pair far above chance; most other pairings cluster near or below random.

Bread with butter shows the highest lift value, far ahead of all other item combinations in the matrix.

3 / 9
Market Basket (Association Rules)

The pairings

Bananas and milk lead basket frequency

Bananas and milk appear in far more baskets than other items, setting the baseline for pairing confidence.

Bananas and milk in the top rows show clear separation from eggs and bread below them.

4 / 9
Market Basket (Association Rules)

Every rule worth reading

Butter and bread pair strongly, others lack proof

Butter and bread move together with strong statistical confidence; all other pairings rest on too few baskets.

Butter and bread are the only rules that survive statistical scrutiny; every other pairing either fails the p-value test or rests on weak support.

5 / 9
Market Basket (Association Rules)

How the baskets look

Most baskets hold multiple items

Baskets center on three items with some larger ones, enabling pairing analysis across most orders.

The distribution shows the median and middle half of baskets, revealing typical basket composition.

6 / 9
Market Basket (Association Rules)

Assumptions

Checks: one strained, four hold

Strained: baskets behind the weakest kept rule.

Holding: enough baskets, baskets with more than one item, every item is in the pairings, many pairs tested.

7 / 9
Market Basket (Association Rules)

How it was done

Market basket analysis of 600 baskets reconstructed from 2059 rows of order_id and item (one row per item per basket, an item counted once per basket), 17 distinct items, median basket 3 items. Every item is in the pairings. Support is the share of baskets holding both items; confidence is the share of baskets holding the first that also hold the second, so it is directional; lift is support divided by what it would be if the two were unrelated, so 1 is no association. 136 pairs were tested with a chi-square on the 2 by 2 table (continuity corrected) and the p-values adjusted across pairs by Benjamini-Hochberg. Rules kept: support at least 1% of baskets and confidence at least 20%; 111 rules qualified and the table shows the 20 with the highest lift. Columns not used: quantity, store.

2059 of 2059 rows · order_id → item

caveatBaskets behind the weakest rule strain the analysis; the leading pairings held firm.

8 / 9
Market Basket (Association Rules)

The code behind this report

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

`standard_market_basket_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.
  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)))))
  }
  #' A p-value under 0.0001 leaves as 1e-12 so the four-decimal serializer does not print 0 (LAT-3181).
  p_cell <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < 1e-4, 1e-12, signif(p, 3))) }
  fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))

  inputs <- pf$taskList$inputs
  params <- inputs$module_parameters %||% list()
  question <- (inputs$userContext %||% list())$objective %||% "Which items sell together, and which pairings are worth acting on?"

  #' ## Column mapping
  #' A transaction log: one row per item per basket. `order_id` is the basket, `item` is what was in it.
  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)
  }
  order_name <- human("order_id"); item_name <- human("item")
  for (sem in c("order_id", "item"))
    if (!(sem %in% names(df))) stop(sprintf("column_mapping must map '%s' (%s was not found).", sem, human(sem)))
  n_in <- nrow(df)

  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))))
  ignored_note <- if (length(ignored_cols)) sprintf("Columns not used: %s.", paste(ignored_cols, collapse = ", ")) else ""

  #' ## Parameters
  min_support <- suppressWarnings(as.numeric(params$min_support %||% 0.01))
  min_conf <- suppressWarnings(as.numeric(params$min_confidence %||% 0.2))
  max_items <- suppressWarnings(as.integer(params$max_items %||% 40L))
  max_rules <- suppressWarnings(as.integer(params$max_rules %||% 20L))
  if (!is.finite(min_support) || min_support <= 0 || min_support >= 1) stop("module_parameters$min_support must be a share between 0 and 1, such as 0.01")
  if (!is.finite(min_conf) || min_conf < 0 || min_conf > 1) stop("module_parameters$min_confidence must be between 0 and 1, such as 0.2")
  if (!is.finite(max_items) || max_items < 2) max_items <- 40L
  if (!is.finite(max_rules) || max_rules < 1) max_rules <- 20L

  #' ## Baskets
  #' Blank orders and items are excluded and counted; an item repeated in one basket counts once.
  norm <- function(v) { x <- trimws(as.character(v)); x[is.na(x) | x == "" | tolower(x) %in% c("na", "n/a", "null", "nan")] <- NA; x }
  ord <- norm(df$order_id); itm <- norm(df$item)
  keep <- !is.na(ord) & !is.na(itm)
  n_bad <- sum(!keep)
  ord <- ord[keep]; itm <- itm[keep]
  pair_key <- paste(ord, itm, sep = "\r")
  n_dup <- sum(duplicated(pair_key))
  ord <- ord[!duplicated(pair_key)]; itm <- itm[!duplicated(pair_key)]
  n_used <- length(ord)
  if (n_used == 0) stop(sprintf("Every row was missing an %s or an %s, so no basket could be read.", order_name, item_name))
  basket_sizes <- as.integer(table(ord))
  n_baskets <- length(basket_sizes)
  if (n_baskets < 10) stop(sprintf("Only %d basket%s reconstructed from %s; market basket analysis needs at least 10.", n_baskets, if (n_baskets == 1) "" else "s", order_name))
  item_count <- sort(table(itm), decreasing = TRUE)
  n_items_all <- length(item_count)
  if (n_items_all < 2) stop(sprintf("Only one distinct %s appears across the baskets; a pairing needs at least two.", item_name))
  if (sum(basket_sizes >= 2) == 0) stop(sprintf("No basket holds two different %ss, so nothing was bought together.", item_name))

  #' ## The items the pairings cover: the most common, capped, with the rest named on the method card
  kept_items <- names(item_count)[seq_len(min(max_items, n_items_all))]
  dropped_items <- setdiff(names(item_count), kept_items)
  inb <- itm %in% kept_items
  ordk <- ord[inb]; itmk <- itm[inb]
  #' The basket by item incidence, then the co-occurrence counts: crossprod on a 0/1 matrix, base R throughout.
  om <- table(factor(ordk), factor(itmk, levels = kept_items))
  inc <- matrix(as.integer(om > 0), nrow = nrow(om), dimnames = list(rownames(om), colnames(om)))
  co <- crossprod(inc)                                  # items by items, diagonal = baskets holding the item
  n_item_baskets <- diag(co)
  support_item <- n_item_baskets / n_baskets

  #' ## Every pair as two rules, with a chi-square on the 2 by 2 table and a Benjamini-Hochberg adjustment
  ii <- which(upper.tri(co), arr.ind = TRUE)
  a_idx <- ii[, 1]; b_idx <- ii[, 2]
  both <- co[ii]
  a_only <- n_item_baskets[a_idx] - both
  b_only <- n_item_baskets[b_idx] - both
  neither <- n_baskets - both - a_only - b_only
  sup_pair <- both / n_baskets
  lift <- sup_pair / (support_item[a_idx] * support_item[b_idx])
  chi <- suppressWarnings(mapply(function(w, x, y, z) {
    m <- matrix(c(w, x, y, z), nrow = 2)
    if (any(is.na(m)) || sum(m) == 0 || any(rowSums(m) == 0) || any(colSums(m) == 0)) return(NA_real_)
    stats::chisq.test(m, correct = TRUE)$p.value
  }, both, a_only, b_only, neither))
  p_adj <- stats::p.adjust(chi, method = "BH")
  pairs_tested <- length(both)
  pair_df <- data.frame(item_a = colnames(co)[a_idx], item_b = colnames(co)[b_idx], baskets = as.integer(both),
                        support = sup_pair, lift = as.numeric(lift), p_value = as.numeric(p_adj),
                        conf_ab = both / n_item_baskets[a_idx], conf_ba = both / n_item_baskets[b_idx],
                        stringsAsFactors = FALSE)
  #' Each pair is two directional rules: confidence is directional, lift is not.
  rules <- rbind(
    data.frame(if_they_buy = pair_df$item_a, they_also_buy = pair_df$item_b, baskets = pair_df$baskets,
               support = pair_df$support, confidence = pair_df$conf_ab, lift = pair_df$lift, p_value = pair_df$p_value,
               stringsAsFactors = FALSE),
    data.frame(if_they_buy = pair_df$item_b, they_also_buy = pair_df$item_a, baskets = pair_df$baskets,
               support = pair_df$support, confidence = pair_df$conf_ba, lift = pair_df$lift, p_value = pair_df$p_value,
               stringsAsFactors = FALSE))
  kept <- rules[is.finite(rules$lift) & rules$support >= min_support & rules$confidence >= min_conf, , drop = FALSE]
  kept <- kept[order(-kept$lift, -kept$confidence), , drop = FALSE]
  n_rules_kept <- nrow(kept)
  if (n_rules_kept == 0)
    stop(sprintf("No pairing reached a support of %s of baskets and a confidence of %s. Lower min_support or min_confidence, or check that %s repeats across baskets.",
                 paste0(signif(100 * min_support, 3), "%"), paste0(signif(100 * min_conf, 3), "%"), item_name))
  top <- utils::head(kept, max_rules)
  best <- top[1, ]

  #' ## Results
  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(
    n_baskets = n_baskets, n_items = n_items_all, median_basket_size = stats::median(basket_sizes),
    pairs_tested = pairs_tested, rules_kept = n_rules_kept, best_lift = tidy(best$lift),
    p_value = p_cell(best$p_value)), lead = "best_lift", place = "summary_metrics")

  rule_label <- function(d) sprintf("%s then %s", d$if_they_buy, d$they_also_buy)
  top_df <- data.frame(rule = rule_label(top), lift = tidy(top$lift), stringsAsFactors = FALSE)
  top_df <- utils::head(top_df, 10)
  results$top_rules <- place_comparison(top_df, category = "rule", value = "lift", place = "top_rules")

  scat <- data.frame(support_pct = tidy(100 * kept$support), confidence_pct = tidy(100 * kept$confidence),
                     lift = tidy(kept$lift), stringsAsFactors = FALSE)
  if (nrow(scat) > 1000) { set.seed(42); scat <- scat[sample.int(nrow(scat), 1000), , drop = FALSE] }
  results$rule_scatter <- place_relationship(scat, x = "support_pct", y = "confidence_pct", size = "lift", place = "rule_scatter")

  mat_items <- utils::head(kept_items, min(12L, length(kept_items)))
  mat_rows <- pair_df[pair_df$item_a %in% mat_items & pair_df$item_b %in% mat_items, , drop = FALSE]
  mat_df <- data.frame(item_a = c(mat_rows$item_a, mat_rows$item_b), item_b = c(mat_rows$item_b, mat_rows$item_a),
                       lift = tidy(c(mat_rows$lift, mat_rows$lift)), stringsAsFactors = FALSE)
  results$pair_matrix <- place_matrix(mat_df, x = "item_a", y = "item_b", z = "lift", place = "pair_matrix")

  freq_df <- data.frame(item = names(item_count)[seq_len(min(15L, n_items_all))],
                        baskets = as.integer(item_count[seq_len(min(15L, n_items_all))]), stringsAsFactors = FALSE)
  results$item_frequency <- place_comparison(freq_df, category = "item", value = "baskets", place = "item_frequency")

  table_df <- data.frame(if_they_buy = top$if_they_buy, they_also_buy = top$they_also_buy, baskets = top$baskets,
                         support_pct = tidy(100 * top$support), confidence_pct = tidy(100 * top$confidence),
                         lift = tidy(top$lift), p_value = p_cell(top$p_value), stringsAsFactors = FALSE)
  results$rules_table <- place_table(table_df, place = "rules_table")

  results$basket_size <- place_distribution(data.frame(items_in_basket = basket_sizes), x = "items_in_basket", place = "basket_size")

  two_plus <- sum(basket_sizes >= 2)
  min_baskets_rule <- max(2L, as.integer(ceiling(min_support * n_baskets)))
  weakest_kept <- min(kept$baskets)
  verdict_p <- function(p) if (is.na(p)) "unknown" else if (p < 0.05) "holds" else "strained"
  checks_df <- data.frame(
    check = c("Enough baskets", "Baskets with more than one item", "Baskets behind the weakest kept rule",
              "Every item is in the pairings", "Many pairs tested"),
    statistic = c(sprintf("%d baskets", n_baskets),
                  sprintf("%d of %d baskets (%s%%)", two_plus, n_baskets, signif(100 * two_plus / n_baskets, 3)),
                  sprintf("%d baskets; the leading rule rests on %d, the support floor on %d",
                          weakest_kept, as.integer(best$baskets), min_baskets_rule),
                  if (length(dropped_items)) sprintf("%d of %d items kept", length(kept_items), n_items_all) else sprintf("all %d items kept", n_items_all),
                  sprintf("%d pairs, Benjamini-Hochberg adjusted", pairs_tested)),
    p_value = c("", "", "", "", fmt_p(best$p_value)),
    verdict = c(if (n_baskets >= 200) "holds" else if (n_baskets >= 50) "strained" else "violated",
                if (two_plus / n_baskets >= 0.5) "holds" else if (two_plus / n_baskets >= 0.2) "strained" else "violated",
                if (weakest_kept >= 30) "holds" else if (weakest_kept >= 10) "strained" else "violated",
                if (length(dropped_items) == 0) "holds" else "strained",
                verdict_p(best$p_value)),
    note = c("few baskets make every rule unstable",
             "a basket with one item can support no pairing",
             "this is the weakest rule kept, not the leading ones; a rule resting on a handful of baskets reads as strong on lift and means little",
             if (length(dropped_items)) sprintf("the least common items are left out: %s", paste(utils::head(dropped_items, 8), collapse = ", ")) else "no item was left out of the pairings",
             "the p-value is adjusted for testing every pair; an unadjusted one would call chance pairings real"),
    stringsAsFactors = FALSE)
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")

  excluded_rows <- c(if (n_bad > 0) sprintf("%d row%s missing an %s or an %s", n_bad, if (n_bad > 1) "s" else "", order_name, item_name),
                     if (n_dup > 0) sprintf("%d repeat%s of an item already in its basket", n_dup, if (n_dup > 1) "s" else ""))
  method <- paste0(
    "Market basket analysis of ", n_baskets, " baskets reconstructed from ", n_in, " rows of ", order_name, " and ", item_name,
    " (one row per item per basket, an item counted once per basket), ", n_items_all, " distinct items, median basket ",
    stats::median(basket_sizes), " items. ",
    if (length(excluded_rows)) paste0("Excluded: ", paste(excluded_rows, collapse = "; "), ". ") else "",
    if (length(dropped_items)) sprintf("The pairings cover the %d most common items; %d less common item%s left out (%s). ",
                                       length(kept_items), length(dropped_items), if (length(dropped_items) > 1) "s were" else " was",
                                       paste(utils::head(dropped_items, 8), collapse = ", ")) else "Every item is in the pairings. ",
    "Support is the share of baskets holding both items; confidence is the share of baskets holding the first that also hold the second, so it is directional; ",
    "lift is support divided by what it would be if the two were unrelated, so 1 is no association. ",
    pairs_tested, " pairs were tested with a chi-square on the 2 by 2 table (continuity corrected) and the p-values adjusted across pairs by Benjamini-Hochberg. ",
    "Rules kept: support at least ", signif(100 * min_support, 3), "% of baskets and confidence at least ", signif(100 * min_conf, 3), "%; ",
    n_rules_kept, " rule", if (n_rules_kept == 1) "" else "s", " qualified and the table shows the ", nrow(top), " with the highest lift. ", ignored_note)
  answer <- list(best_rule = sprintf("%s then %s", best$if_they_buy, best$they_also_buy),
                 best_lift = round(best$lift, 4), best_confidence_pct = round(100 * best$confidence, 2),
                 best_support_pct = round(100 * best$support, 2), best_baskets = as.integer(best$baskets),
                 best_p_value = signif(best$p_value, 3), rules_kept = n_rules_kept, pairs_tested = pairs_tested,
                 n_baskets = n_baskets, n_items = n_items_all)

  results$basket_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n_used, excluded = as.list(excluded_rows),
    # LAT-3181: the method card's "rows - x to y" line reads these; unset, it printed a bare arrow
    x_column = order_name, y_column = item_name,
    assumptions = list(
      "A pairing is an association in the baskets, not proof that one purchase causes the other.",
      "Confidence is directional: 'if they buy A, they also buy B' is a different claim from the reverse, and the table carries both.",
      "Lift near 1 means the items appear together about as often as chance; a high lift on very few baskets is noise, which the adjusted p-value is there to catch.",
      "Baskets are whatever the order column groups; if it is a customer rather than a visit, the rules describe a lifetime, not a trip.",
      "Items must repeat across baskets for a rule to mean anything; a catalogue where every item is bought once supports none.")))

  objects <- list()
  list(answer = answer, method = method, n = n_baskets, results = results, objects = objects,
       json_output = list(answer = answer, method = method, n = n_baskets))
}
Want to run this analysis on your own data? Upload CSV — Free Analysis See Pricing