svysmd

rhc <- readr::read_csv("https://biostat.app.vumc.org/wiki/pub/Main/DataSets/rhc.csv")
rhc$swang1 <- factor(rhc$swang1, levels = c("No RHC", "RHC"))

psModel <- glm(
  formula = swang1 ~ age + sex + race + edu + income + ninsclas +
    cat1 + das2d3pc + dnr1 + ca + surv2md1 + aps1 + scoma1 +
    wtkilo1 + temp1 + meanbp1 + resp1 + hrt1 + pafi1 +
    paco21 + ph1 + wblc1 + hema1 + sod1 + pot1 + crea1 +
    bili1 + alb1 + resp + card + neuro + gastr + renal +
    meta + hema + seps + trauma + ortho + cardiohx + chfhx +
    dementhx + psychhx + chrpulhx + renalhx + liverhx + gibledhx +
    malighx + immunhx + transhx + amihx,
  family = binomial(link = "logit"),
  data = rhc
)
rhc$pRhc <- predict(psModel, type = "response")
rhc$pNoRhc <- 1 - rhc$pRhc
rhc$pAssign[rhc$swang1 == "RHC"] <- rhc$pRhc[rhc$swang1 == "RHC"]
rhc$pAssign[rhc$swang1 == "No RHC"] <- rhc$pNoRhc[rhc$swang1 == "No RHC"]
rhc$pMin <- pmin(rhc$pRhc, rhc$pNoRhc)
rhc$mw <- rhc$pMin / rhc$pAssign

vars <- c(
  "swang1", "age", "sex", "race", "edu", "income", "ninsclas", "cat1", "das2d3pc", "dnr1",
  "ca", "surv2md1", "aps1", "scoma1", "wtkilo1", "temp1", "meanbp1", "resp1",
  "hrt1", "pafi1", "paco21", "ph1", "wblc1", "hema1", "sod1", "pot1", "crea1",
  "bili1", "alb1", "resp", "card", "neuro", "gastr", "renal", "meta", "hema",
  "seps", "trauma", "ortho", "cardiohx", "chfhx", "dementhx", "psychhx",
  "chrpulhx", "renalhx", "liverhx", "gibledhx", "malighx", "immunhx",
  "transhx", "amihx", "mw"
)

rhcSvy <- survey::svydesign(ids = ~1, data = rhc[, vars], weights = ~mw, strata = ~swang1)
smd::smd(rhcSvy$variables$age, rhcSvy$strata$swang1, weights(rhcSvy))

# check similarity to tableone
library(tableone)
vars2 <- vars[2:51]

get_smd <- function(.x) {
  smd::smd(rhcSvy$variables[.x], rhcSvy$strata$swang1, weights(rhcSvy))
}

svy_smds <- purrr::map_dfr(vars2, get_smd)
tabWeighted <- svyCreateTableOne(vars = vars2, strata = "swang1", data = rhcSvy, test = FALSE)

dplyr::bind_cols(ExtractSmd(tabWeighted), svy_smds)