Demo_Manuscript/zz_bland_altman_helpers.R

ba_analyzer <- function(d, var_pairs) {

  paste(d$sex, d$age) %>%
  split(d, .) %>%
  c(
    total = list(d), sex = split(d, d$sex),
    age = split(d, d$age), .
  ) %>%
  {mapply(
    get_ba, d = .,
    description = get_names(.),
    MoreArgs = list(var_pairs = var_pairs),
    SIMPLIFY = FALSE
  )} %>%
  c(make.row.names = FALSE) %>%
  do.call(rbind, .)

}

get_ba <- function(d, description, var_pairs) {

  var_pairs %>%
  lapply(function(x) {

    stopifnot(length(x) == 2)

    x[2:1] %>%
    d[ ,.] %>%
    apply(1, diff) %>%
    {data.frame(
      mean_bias = mean(.), sd_bias = stats::sd(.)
    )} %>%
    within({
      loa_upper = mean_bias + (1.96 * sd_bias)
      loa_lower = mean_bias - (1.96 * sd_bias)
      sd_bias = NULL
    }) %>%
    data.frame(
      yvar = x[1], xvar = x[2], .,
      stringsAsFactors = FALSE
    )

  }) %>%
  do.call(rbind, .) %>%
  data.frame(
    description = description, .,
    stringsAsFactors = FALSE
  )

}

ba_plotter <- function(z, d, label = "DEFAULT") {

  stopifnot(
    length(z) == 2,
    all(grepl("kcal", z))
  )

  z2 <- sapply(z, function(a) switch(
    a,
    "AG_kcal" = "Sojourn",
    "act24_kcal" = "ACT24",
    "swa_kcal" = "SWA"
  ))

  PAutilities::ba_plot(
    d,
    paste0("(", z[1], " + ", z[2], ") / 2"),
    paste0(z[1], " - ", z[2]),
    paste0("mean(", z2[1], ", ", z2[2], ")"),
    paste0(z2[1], " - ", z2[2]),
    axis.text.x = element_text(angle = 45, hjust = 1)
  ) +
  scale_x_continuous(
    name = paste0("mean(", z2[1], ", ", z2[2], ")"),
    breaks = seq(1000,8000,1000),
    limits = c(900, 8100)
  ) +
  scale_y_continuous(
    name = paste0(z2[1], " - ", z2[2]),
    breaks = seq(-2500, 2500, 500),
    limits = c(-2500, 2500)
  ) +
  geom_text(
    label = label,
    x = -Inf, y = Inf,
    hjust = -1, vjust = 1,
    fontface = "bold", size = 6
  )

}
PAHPLabResearch/FLASH documentation built on May 15, 2020, 7:08 p.m.