Demo_Manuscript/6_BA_Plots.R

In PAHPLabResearch/FLASH: FLASH: Free Living Activity Study for Health

# Setup -------------------------------------------------------------------

  rm(list = ls()) # Clear memory
  library(magrittr) # Attach magrittr package (makes code more readable)
  library(ggplot2) # Attach ggplot2 package (for figure tweaking)
  source("Demo_Manuscript/zz_merge_helpers.R") # Load code/variables
  source("Demo_Manuscript/zz_summary_helpers.R") # Load code
  source("Demo_Manuscript/zz_load_d.R") # Load data into object called `d`
  source("Demo_Manuscript/zz_equivalence_helpers.R") # Load code
  source("Demo_Manuscript/zz_bland_altman_helpers.R") # Load code

  var_pairs <- list(
    c("act24_kcal", "AG_kcal"),
    c("act24_kcal", "swa_kcal"),
    c("AG_kcal", "swa_kcal")
  )

# Spot outliers -----------------------------------------------------------

  outliers <-
    d[ ,c("act24_kcal", "AG_kcal", "swa_kcal")] %>%
    apply(1, function(x) any(x > 6500)) %>%
    which(.)

  outliers <-
    var_pairs %>%
    sapply(function(x) {
      apply(d[ ,x], 1, diff) %>%
      {which(. > 1450)}
    }) %>%
    do.call(c, .) %>%
    union(outliers)

# Bland-Altman Analyses ---------------------------------------------------

  ba <-
    ba_analyzer(d, var_pairs) %>%
    within({outliers = TRUE})

  ba_analyzer(d[-outliers, ], var_pairs) %>%
  within({outliers = FALSE}) %>%
  rbind(ba, .) %>%
  data.table::fwrite("Demo_Manuscript/output/Bland_Altman.csv")

# Bland-Altman Plots ------------------------------------------------------

  top <-
    var_pairs %>%
    mapply(
      ba_plotter,
      z = ., label = c("A", "B", "C"),
      MoreArgs = list(d = d),
      SIMPLIFY = FALSE
    )

  bottom <-
    var_pairs %>%
    mapply(
      ba_plotter,
      z = ., label = c("D", "E", "F"),
      MoreArgs = list(d = d[-outliers, ]),
      SIMPLIFY = FALSE
    )

# Write the tif -----------------------------------------------------------

  "Demo_Manuscript/output/Figure_2.tif" %>%
  tiff(12, 8, "in", compression = "lzw", res = 1200)

    c(top, bottom) %>%
    lapply(ggplotGrob) %>%
    gridExtra::grid.arrange(grobs = ., nrow = 2)

  dev.off()