inst/doc/rolescry.R

In rolescry: Name-Blind Variable-Role Detection by Data Signature

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(rolescry)
set.seed(1)

## ----example------------------------------------------------------------------
set.seed(1)
pre  <- rnorm(100, 10, 2)          # a measurement, before ...
d <- data.frame(
  arm  = rep(c("control", "treatment"), each = 50),  # a balanced 2-level grouping
  pre  = pre,
  post = pre + rnorm(100, 1, 1)                       # ... and again after (paired with pre)
)

res <- detect_roles(d)
res
summary(res)

## ----blind--------------------------------------------------------------------
d_blind <- setNames(d, paste0("col_", seq_along(d)))
pos <- function(r, dat) match(r$roles$paired_pairs$columns, names(dat))
identical(pos(detect_roles(d), d), pos(detect_roles(d_blind), d_blind))

## ----breakdown----------------------------------------------------------------
res$roles$paired_pairs$components[[1]]

## ----nmi----------------------------------------------------------------------
set.seed(2)
g <- sample(c("A", "B", "C"), 300, replace = TRUE)
y <- ifelse(g == "A", "event", sample(c("event", "none"), 300, replace = TRUE))
compute_nmi(g, y)          # > 0: g informs y
compute_nmi(g, sample(g))  # ~ 0: shuffled -> independent

## ----coupled------------------------------------------------------------------
set.seed(3)
n <- 300; arm <- rep(0:1, each = n / 2)
end <- rnorm(n, 150, 15) - 10 * arm
rct <- data.frame(arm = arm, sbp_end = end,
                  resp = rbinom(n, 1, plogis(0.05 * (end - 140))))
cp <- detect_roles(rct)$roles$coupled_pair
cp$columns
cp$interpretations

## ----finance------------------------------------------------------------------
set.seed(5)
px <- data.frame(dt = as.Date("2024-01-02") + 0:199,
                 price = 500 + cumsum(rnorm(200)), volume = rlnorm(200, 11, 0.5))
detect_roles(px)$roles$time_index$columns

## ----namebonus----------------------------------------------------------------
set.seed(4)
clin <- data.frame(
  site    = rep(c("north", "south"), length.out = 160),  # perfectly balanced (the math pick)
  treated = sample(c("no", "yes"), 160, replace = TRUE, prob = c(0.62, 0.38))
)
detect_roles(clin)$roles$group_var$columns                                  # data alone -> "site"
detect_roles(clin, name_bonus = rolescry_default_name_bonus())$roles$group_var$columns  # name nudge -> "treated"

## ----verify-------------------------------------------------------------------
set.seed(21); n <- 300
arm <- rep(c("drug", "placebo"), each = n / 2)
base <- rnorm(n, 150, 15)
rct <- data.frame(id = sample.int(99999, n), arm, age = round(rnorm(n, 60, 10)),
                  sbp_base = base, sbp_end = base - 10 * (arm == "drug") + rnorm(n, 0, 8))
rct$y <- rbinom(n, 1, plogis(-1 + 0.05 * (rct$sbp_end - 140)))
verify_roles(rct, list(subject_id = "id", group_var = "arm", paired_pairs = c("age", "sbp_end"),
                       outcome_binary = "y"))

## ----harmonize----------------------------------------------------------------
site <- function(seed, nm, n = 200, code = 0:1) {
  set.seed(seed); b <- rnorm(n, 150, 15); t <- rweibull(n, 1.3, exp(5 - rnorm(n)))
  cens <- runif(n, 0, quantile(t, .9))
  d <- data.frame(sample.int(99999, n), sample(c("a", "b"), n, TRUE), b, b - 5 + rnorm(n, 0, 6),
                  round(pmin(t, cens), 1), code[1 + (t <= cens)])
  setNames(d, nm)
}
north <- site(1, c("id", "arm", "sbp_base", "sbp_end", "time", "dead"))
south <- site(2, c("pid", "group", "bp0", "bp1", "ftime", "status"), code = 1:2)[, c(3, 1, 6, 2, 5, 4)]
harmonize_roles(list(north = north, south = south))