Demo_Manuscript/zz_regression_plots.R

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

format_variables <- function(vars, labels) {

  variables <- data.frame(
    varname = vars,
    varlabel = labels,
    stringsAsFactors = FALSE,
    row.names = NULL
  )

  result <- lapply(
    utils::combn(seq(nrow(variables)), 2, simplify = FALSE),
    function(x) stats::setNames(
      cbind(variables[x[1], ], variables[x[2], ]),
      paste(names(variables), c("a", "a", "b", "b"), sep = "_")
    )
  )
  do.call(rbind, c(result, make.row.names = FALSE))

}

get_labels <- function(xvar, yvar) {

  xvar %<>% switch(
    "act24_kcal" = "ACT24",
    "AG_kcal" = "Sojourn",
    "swa_kcal" = "SWA"
  )

  xlab <- paste0(xvar, " - mean(", xvar, ")")

  ylab <-
    switch(
      yvar,
      "act24_kcal" = "ACT24",
      "AG_kcal" = "Sojourn",
      "swa_kcal" = "SWA"
    ) %>%
    paste0(., " - mean(", xvar, ")")

  list(xlab = xlab, ylab = ylab)

}

single_plot <- function(file, xvar, yvar, label, ...) {

  labs <- get_labels(xvar, yvar)

  read_format(file) %>%
  ggplot(aes(
    x = eval(parse(text = xvar)) -
      mean(eval(parse(text = xvar))),
    y = eval(parse(text = yvar)) -
      mean(eval(parse(text = xvar)))
  )) +
  geom_point(shape = 1) +
  theme_minimal() +
  theme(
    axis.title = element_text(size = 14, face = "bold"),
    axis.text = element_text(size = 12)
  ) +
  scale_x_continuous(
    name = labs$xlab,
    limits = c(-5,15)
  ) +
  scale_y_continuous(
    name = labs$ylab,
    limits = c(-5,15)
  ) +
  geom_smooth(
    method = "lm", se = FALSE,
    colour = "black", fullrange = TRUE,
    linetype = "dashed"
  ) +
  stat_function(
    fun = function(x) x,
    colour = "black"
  ) +
  geom_text(
    x = -Inf, y = Inf,
    hjust = -1, vjust = 1,
    size = 8, label = label
  ) +
  geom_vline(xintercept = 0, size = 0.5) +
  geom_hline(yintercept = 0, size = 0.5)

}

file_plot <- function(file, var_pairs, labels) {

  mapply(
    single_plot,
    xvar = var_pairs$xvar,
    yvar = var_pairs$yvar,
    label = labels,
    MoreArgs = list(file = file),
    SIMPLIFY = FALSE
  ) %>%
  c(nrow = 1) %>%
  do.call(gridExtra::grid.arrange, .)

}