Correlation

Shows which measures rise and fall together, how strongly and in which direction, and how certain each relationship is.

VERSION · v1.0.0
RUN DATE · 14 September 2026
DATA · 1,030 rows
Objective

Which concrete ingredients move together, and which pair is most strongly related to compressive strength?

This report contains
  • SummaryThe strongest relationship, and how many relationships are clear.
  • All relationships at a glanceEvery pair of measures and how strongly they move together.
  • The strongest pairThe data points behind the strongest relationship.
  • Relationships rankedEvery pair ordered from strongest to weakest, with its direction.
  • How certain each relationship isThe likely range of each of the strongest relationships.
  • Full resultsEvery pair with its strength, likely range and significance.
  • What the results rely onEach condition the analysis depends on, and whether it holds.
  • How it was doneThe method, the data used, and what to keep in mind.
1 / 8
Correlation

What moves together

Cement leads strength, water and superplasticizer move opposite

Cement correlates strongest with compressive strength, while water and superplasticizer move together inversely, pulling strength down.

The csMPa row shows cement ahead of superplasticizer, and water pulling negative; the water row shows tight inverse pairing with superplasticizer.

2 / 8
Correlation

What moves together

Water and superplasticizer move in opposite directions

Water and superplasticizer are inversely related, the strongest pair, yet the pattern is mixed with notable outliers.

The lower water values cluster at high superplasticizer levels; higher water values show superplasticizer near zero.

3 / 8
Correlation

Strength and certainty

Water and superplasticizer move strongest together

Water and superplasticizer move inversely strongest; cement drives compressive strength most, but weakly.

Top row shows water versus superplasticizer with the largest magnitude correlation; csMPa versus cement ranks second.

4 / 8
Correlation

Strength and certainty

Cement strongest for strength, water pulls down

Cement and strength move together most reliably; water opposes strength and superplasticizer. Cement's interval is tightest.

Start at csMPa vs cement and water vs superplasticizer rows; their intervals are tightest and exclude zero clearly.

5 / 8
Correlation

The numbers

Cement strengthens concrete, water weakens it

Cement and superplasticizer rise with strength; water falls. Cement is the strongest driver.

Water and superplasticizer form the strongest pair overall, yet neither directly dominates strength as much as cement does alone.

6 / 8
Correlation

Assumptions and method

All four checks hold

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

Holding: enough rows per pair, shape matches the method, outliers on the strongest pair, signal beyond chance.

Pearson correlation across 8 measures (csMPa, cement, slag, flyash, water, superplasticizer, fineaggregate, coarseaggregate), 28 pairs, pairwise-complete rows (1030 of 1030 rows complete on every measure); 95% confidence intervals from cor.test; p-values test r = 0 per pair, not adjusted for the number of pairs.

1030 of 1030 rows · csMPa, cement, slag, flyash, water, superplasticizer, fineaggregate, coarseaggregate → 28 pairs

caveatPearson correlation on complete rows assumes linear relationships; unadjusted p-values risk false positives across many pairs.

7 / 8
Correlation

The code behind this report

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

`standard_correlation_v2` <- function(pf) {
  `%||%` <- function(a, b) if (!is.null(a)) a else b
  #' A p-value of exactly 0 is double-precision UNDERFLOW, not certainty (LAT-3181, as group comparison's LAT-3105):
  #' a table printed "0" for csMPa vs slag. Report the floor instead.
  P_FLOOR <- 2e-16
  #' P-VALUES BELOW 0.0001 LEAVE AS A FLOOR (LAT-3181). The results serialize at four decimal digits, which rounds a p of
  #' 1.4e-05 to 0 and 6e-05 up to 0.0001; a table printed "p-value 0". 1e-12 survives the serializer and the mapper shows
  #' any p under 0.0001 as "<0.0001", which is what the reader should see. Table and tile cells only; the answer keeps p.
  p_cell <- function(p) { p <- as.numeric(p); ifelse(is.na(p), NA_real_, ifelse(p < 1e-4, 1e-12, 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 %||%
    "Which measures move together, how strongly, and in which direction?"

  #' ## Column mapping
  #' The customer maps two to eight numeric `feature_N` columns. Semantic names are
  #' used inside; the customer's own headers are carried in `col_map` so every
  #' table, pair and axis names the columns the reader knows.
  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)
  }

  #' ## Data preparation
  #' Every mapped feature is coerced to numeric (text that is 95% numeric is
  #' converted, anything else is excluded); constant and identifier-like columns
  #' are excluded; correlations use pairwise-complete rows, so one blank does not
  #' drop the whole row. At least two usable features and ten complete pairs are
  #' required.
  n_in <- nrow(df)
  feat_cols <- grep("^feature_[0-9]+$", names(df), value = TRUE)
  feat_cols <- feat_cols[order(as.integer(sub("^feature_", "", feat_cols)))]
  if (length(feat_cols) < 2) stop("column_mapping must map at least two feature columns (feature_1, feature_2)")
  dropped <- character(0); why <- character(0)
  for (fc in feat_cols) {
    v <- df[[fc]]
    if (!is.numeric(v)) {
      conv <- suppressWarnings(as.numeric(as.character(v)))
      n_orig <- sum(!is.na(v) & as.character(v) != "")
      if (n_orig > 0 && sum(!is.na(conv)) >= 0.95 * n_orig) df[[fc]] <- conv
      else { dropped <- c(dropped, fc); why <- c(why, "not numeric"); next }
    }
    v <- df[[fc]]
    if (sum(!is.na(v)) < 10) { dropped <- c(dropped, fc); why <- c(why, "fewer than 10 values"); next }
    if (isTRUE(var(v, na.rm = TRUE) == 0) || is.na(var(v, na.rm = TRUE))) { dropped <- c(dropped, fc); why <- c(why, "constant"); next }
    if (length(unique(v[!is.na(v)])) == sum(!is.na(v)) && all(v[!is.na(v)] == round(v[!is.na(v)])) && sum(!is.na(v)) > 50 &&
        isTRUE(all(diff(sort(v[!is.na(v)])) == 1))) { dropped <- c(dropped, fc); why <- c(why, "identifier-like (a running index)"); next }
  }
  use_cols <- setdiff(feat_cols, dropped)
  if (length(use_cols) < 2) stop(sprintf("Only %d usable numeric feature column(s) remained after cleaning; two are required.", length(use_cols)))
  X <- as.data.frame(lapply(df[, use_cols, drop = FALSE], as.numeric))
  names(X) <- use_cols
  n_used <- sum(complete.cases(X))

  #' ## Correlation
  #' Pearson by default (`module_parameters$method = "spearman"` for rank
  #' correlation when the relationship is monotone but not linear, or when
  #' outliers dominate). Every pair gets r, its 95% confidence interval and a
  #' p-value from `cor.test` on the rows complete for that pair. Strength bands:
  #' |r| < 0.1 negligible, < 0.3 weak, < 0.5 moderate, < 0.7 strong, else very strong.
  method_name <- tolower(as.character(params$method %||% "pearson"))
  if (!method_name %in% c("pearson", "spearman")) method_name <- "pearson"
  band <- function(a) ifelse(a < 0.1, "negligible", ifelse(a < 0.3, "weak", ifelse(a < 0.5, "moderate", ifelse(a < 0.7, "strong", "very strong"))))
  k <- length(use_cols)
  pair_rows <- list()
  for (i in seq_len(k - 1)) for (j in (i + 1):k) {
    a <- X[[i]]; b <- X[[j]]
    ok <- !is.na(a) & !is.na(b)
    n_pair <- sum(ok)
    if (n_pair < 10) next
    ct <- suppressWarnings(cor.test(a[ok], b[ok], method = method_name, exact = FALSE))
    r <- unname(ct$estimate)
    if (method_name == "pearson" && !is.null(ct$conf.int)) {
      lo <- ct$conf.int[1]; hi <- ct$conf.int[2]
    } else {
      # Fisher z interval on the rank correlation (an approximation, stated in the method)
      z <- atanh(r); se <- 1 / sqrt(n_pair - 3)
      lo <- tanh(z - 1.96 * se); hi <- tanh(z + 1.96 * se)
    }
    pair_rows[[length(pair_rows) + 1]] <- data.frame(
      var_a = human(use_cols[i]), var_b = human(use_cols[j]),
      r = round(r, 3), low = round(lo, 3), high = round(hi, 3),
      p_value = p_cell(unname(ct$p.value)), n = n_pair,
      strength = band(abs(r)), direction = if (r >= 0) "positive" else "negative",
      sem_a = use_cols[i], sem_b = use_cols[j],
      stringsAsFactors = FALSE)
  }
  if (length(pair_rows) == 0) stop("No pair of feature columns had at least 10 complete rows in common.")
  pairs <- do.call(rbind, pair_rows)
  pairs <- pairs[order(-abs(pairs$r)), , drop = FALSE]
  rownames(pairs) <- NULL
  pairs$pair <- paste(pairs$var_a, "vs", pairs$var_b)
  top <- pairs[1, ]
  n_sig <- sum(pairs$p_value < 0.05)
  n_strong <- sum(abs(pairs$r) >= 0.5)

  #' ## The full matrix (long form, both orders and the diagonal, for the heatmap)
  cm <- suppressWarnings(cor(X, use = "pairwise.complete.obs", method = method_name))
  hn <- vapply(use_cols, human, character(1))
  mat_df <- data.frame(
    var_a = rep(hn, times = k), var_b = rep(hn, each = k),
    r = round(as.vector(cm), 2), stringsAsFactors = FALSE)
  mat_df <- mat_df[!is.na(mat_df$r), , drop = FALSE]

  #' ## The strongest pair as points (sampled to 1 000 rows)
  set.seed(42)
  a <- X[[top$sem_a]]; b <- X[[top$sem_b]]
  ok <- which(!is.na(a) & !is.na(b))
  keep <- if (length(ok) > 1000) sort(sample(ok, 1000)) else ok
  scatter <- data.frame(x = round(a[keep], 4), y = round(b[keep], 4))
  names(scatter) <- c(top$var_a, top$var_b)
  scatter_cols <- c(top$var_a, top$var_b)

  #' ## Ranked pairs, intervals, the table
  rank_df <- data.frame(pair = pairs$pair, r = pairs$r, p_value = pairs$p_value, n = pairs$n, stringsAsFactors = FALSE)
  int_n <- min(nrow(pairs), 12)
  int_df <- data.frame(term = pairs$pair[1:int_n], estimate = pairs$r[1:int_n], low = pairs$low[1:int_n], high = pairs$high[1:int_n], stringsAsFactors = FALSE)
  table_df <- pairs[, c("var_a", "var_b", "r", "low", "high", "p_value", "n", "strength", "direction")]

  #' ## Method text and the answer
  method <- paste0(
    if (method_name == "pearson") "Pearson" else "Spearman rank", " correlation across ", k, " measures (",
    paste(hn, collapse = ", "), "), ", nrow(pairs), " pairs, pairwise-complete rows (", n_used, " of ", n_in,
    " rows complete on every measure",
    if (length(dropped)) paste0("; excluded: ", paste(paste0(vapply(dropped, human, character(1)), " (", why, ")"), collapse = ", ")) else "",
    "); 95% confidence intervals ", if (method_name == "pearson") "from cor.test" else "by the Fisher z approximation",
    "; p-values test r = 0 per pair, not adjusted for the number of pairs.")
  statement <- sprintf("%s and %s move together most (%s %s, r = %s, n = %d)",
                       top$var_a, top$var_b, top$strength, top$direction, format(top$r, nsmall = 2), top$n)
  answer <- list(
    strongest_pair = top$pair, r = top$r, r_low = top$low, r_high = top$high, p_value = top$p_value,
    direction = top$direction, strength = top$strength, n_pairs = nrow(pairs),
    n_significant = n_sig, n_strong = n_strong, n_measures = k, n = n_used)

  # ── Results: one entry per place. `columns` carries column order past jsonb's key
  #    sort (LAT-2999); `value_order` says which number leads a headline or metric. ──
  #' ## Summary metrics and assumption checks (LAT-3138): the figures that summarise the
  #' whole analysis as one metrics row, and one verdict per assumption of the method,
  #' each with the statistic behind it. holds / strained / violated are rules of thumb a
  #' reader can re-derive from the statistic shown beside them. Base R throughout.
  verdict_p <- function(p, soft = 0.05, hard = 0.001) if (is.na(p)) "unknown" else if (p >= soft) "holds" else if (p >= hard) "strained" else "violated"
  fmt_p <- function(p) if (is.na(p)) "" else if (p < 1e-4) "<0.0001" else as.character(signif(p, 3))
  summary_vals <- list(strongest_r = round(top$r, 3), n_pairs = nrow(pairs), n_significant = n_sig, n_strong = n_strong, n_measures = k, n = n_used)
  rp <- suppressWarnings(cor(a, b, method = "pearson", use = "complete.obs")); rs <- suppressWarnings(cor(a, b, method = "spearman", use = "complete.obs"))
  shape_gap <- abs(rp - rs)
  beyond3 <- function(v) { v <- v[is.finite(v)]; if (length(v) < 3 || sd(v) == 0) 0 else mean(abs(v - mean(v)) > 3 * sd(v)) }
  out_share <- max(beyond3(a), beyond3(b))
  min_n <- if ("n" %in% names(pairs)) min(pairs$n, na.rm = TRUE) else n_used
  expected_false <- 0.05 * nrow(pairs)
  checks_df <- data.frame(
    check = c("Enough rows per pair", "Shape matches the method", "Outliers on the strongest pair", "Signal beyond chance"),
    statistic = c(paste0("smallest pair n = ", min_n),
                  paste0("|Pearson - Spearman| = ", round(shape_gap, 3), " on the strongest pair"),
                  paste0(round(100 * out_share, 1), "% of points beyond 3 SD"),
                  paste0(n_sig, " clear pairs against ", round(expected_false, 1), " expected by chance")),
    p_value = c("", "", "", ""),
    verdict = c(if (min_n >= 30) "holds" else if (min_n >= 10) "strained" else "violated",
                if (is.na(shape_gap)) "unknown" else if (shape_gap < 0.1) "holds" else if (shape_gap < 0.2) "strained" else "violated",
                if (out_share < 0.01) "holds" else if (out_share < 0.03) "strained" else "violated",
                if (n_sig >= max(1, 2 * expected_false)) "holds" else if (n_sig >= 1) "strained" else "violated"),
    note = c("a pair on few rows has a wide interval whatever its r",
             "a large gap means a curve or a few points are driving Pearson r",
             "outliers pull Pearson r toward or away from zero",
             "with many pairs some small p-values arise by chance alone"),
    stringsAsFactors = FALSE)

  results <- list()
  #' The verdict and the headline are NOT places of a library tool (LAT-3130): a
  #' library tool supplies data objects; the answer is written by the last mile,
  #' which is the first stage that reads the objects together.
  #' ## summary_metrics: the whole analysis at a glance (LAT-3138)
  results$summary_metrics <- place_metric(summary_vals, lead = "strongest_r", place = "summary_metrics")
  #' ## assumption_checks: a verdict per assumption (a `checks` place, table-shaped)
  results$assumption_checks <- place_table(checks_df, place = "assumption_checks")
  #' ## correlation_matrix: every pair's r as a grid
  results$correlation_matrix <- place_matrix(mat_df, x = "var_a", y = "var_b", z = "r",
    place = "correlation_matrix")
  #' ## strongest_pair: the points behind the headline
  results$strongest_pair <- place_relationship(scatter, x = scatter_cols[1], y = scatter_cols[2],
    draws = "dataset", place = "strongest_pair")
  #' ## pair_ranking: pairs ranked by |r|
  results$pair_ranking <- place_comparison(rank_df, category = "pair", value = "r",
    place = "pair_ranking")
  #' ## pair_interval: how sure, per pair (top twelve)
  results$pair_interval <- place_interval(int_df, term = "term", value = "estimate",
    low = "low", high = "high", place = "pair_interval")
  #' ## pair_table: every pair with r, interval, p, n, strength and direction
  results$pair_table <- place_table(table_df, place = "pair_table")
  #' ## correlation_method: how it was done
  results$correlation_method <- list(kind = "metric", values = list(
    method = method, n_in = n_in, n_used = n_used,
    excluded = if (length(dropped)) as.list(unname(vapply(dropped, human, character(1)))) else list(),
    # LAT-3181: the method card's column line reads these; a correlation has measures and no outcome
    # the arrow reads "measures -> what they produce": the method card prints x_column -> y_column unconditionally
    x_column = paste(hn, collapse = ", "), y_column = sprintf("%d pairs", nrow(pairs)),
    assumptions = list(
      if (method_name == "pearson") "Pearson r measures LINEAR association; a curved relationship can score near zero." else "Spearman rho measures MONOTONE association on ranks.",
      "Correlation is not causation: a third factor can move both measures.",
      "Outliers pull Pearson r; check the strongest pair's points before acting on it.",
      "p-values are per pair and unadjusted; with many pairs expect some small p-values by chance.")))

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