Demo_Manuscript/3_Minute-by-Minute_Agreement.R

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

  rm(list = ls()) # Clear memory
  library(magrittr) # Attach magrittr package (makes code more readable)
  library(ggplot2) # Attach ggplot2 package (for plotting)
  source("Demo_Manuscript/zz_merge_helpers.R") # Load code etc.
  source("Demo_Manuscript/zz_load_d.R") # Load data
  source("Demo_Manuscript/zz_summary_helpers.R") # Load functions
  source("Demo_Manuscript/zz_regression_analyses.R") # Load code etc.
  source("Demo_Manuscript/zz_regression_plots.R") # Load code etc.

  if (!dir.exists("Demo_Manuscript/output")) {
    dir.create("Demo_Manuscript/output") %>%
    invisible(.)
  }

# Analysis ----------------------------------------------------------------

  # d <-
  #   "Demo_Manuscript/_merged_data/60s" %>%
  #   list.files("rds$", full.names = TRUE) %>%
  #   lapply(regression_wrapper, var_pairs = var_pairs) %>%
  #   c(make.row.names = FALSE) %>%
  #   do.call(rbind, .) %T>%
  #   saveRDS("Demo_Manuscript/output/slopes_etc.rds") %T>%
  #   {cat("\n")}

  d <-
    readRDS("Demo_Manuscript/output/slopes_etc.rds") %>%
    {data.frame(
      d[match(.$id, d$id), demo_vars],
      .[ ,setdiff(names(.), "id")],
      stringsAsFactors = FALSE,
      row.names = NULL
    )}

  paste(d$sex, d$age) %>%
  split(d, .) %>%
  c(
    total = list(d), sex = split(d, d$sex),
    age = split(d, d$age), .
  ) %>%
  {mapply(
    d_sum, d = ., description = get_names(.), SIMPLIFY = FALSE
  )} %>%
  c(make.row.names = FALSE) %>%
  do.call(rbind, .) %>%
  data.table::fwrite(
    "Demo_Manuscript/output/slopes_etc_summary.csv"
  )

  ## Summarize slopes etc.

    paste(d$xvar, d$yvar) %>%
    split(d, .) %>%
    lapply(function(x) {
      varsum(x) %>%
      data.frame(
        xvar = x$xvar[1],
        yvar = x$yvar[1],
        .,
        stringsAsFactors = FALSE,
        row.names = NULL
      )
    }) %>%
    c(make.row.names = FALSE) %>%
    do.call(rbind, .) %>%
    data.table::fwrite(
      "Demo_Manuscript/output/regression_summaries.csv"
    )

  ## Summarize within participants

    agg <-
      c("intercept", "slope", "r2_adjusted") %>%
      d[ ,.] %>%
      aggregate(by = list(id = d$id), FUN = mean)

    # > agg$id[which.min(agg$r2_adjusted)]
    # [1] "F3B054"
    # > agg$id[which(agg$r2_adjusted == median(agg$r2_adjusted))]
    # [1] "F3B033"
    # > agg$id[which.max(agg$r2_adjusted)]
    # [1] "F3B013"

# Plot --------------------------------------------------------------------

  ## Set up

    files <-
      "Demo_Manuscript/_merged_data/60s" %>%
      list.files("rds$", full.names = TRUE) %>%
      {.[
        gsub("_merged_60s.rds$", "", basename(.)) %in%
          c("F3B054", "F3B033", "F3B013")
      ]}

    var_pairs <-
      c("act24_kcal", "AG_kcal", "swa_kcal") %>%
      combn(2, simplify = FALSE) %>%
      do.call(rbind, .) %>%
      data.frame(stringsAsFactors = FALSE) %>%
      stats::setNames(c("yvar", "xvar")) %>%
      as.list(.)

  ## Execution

    # (NOTE: warnings about missing values should only be problematic for
    # geom_point; not a problem for geom_smooth, and should be a side effect of
    # `fullrange = TRUE`)

    "Demo_Manuscript/output/Figure_1.tif" %>%
    tiff(12, 10, "in", res = 1200, compression = "lzw")
      mapply(
        file_plot,
        file = rev(files),
        labels = list(
          LETTERS[1:3], LETTERS[4:6], LETTERS[7:9]
        ),
        MoreArgs = list(var_pairs = var_pairs),
        SIMPLIFY = FALSE
      ) %>%
      c(nrow = 3) %>%
      do.call(gridExtra::grid.arrange, .)
    dev.off()
PAHPLabResearch/FLASH documentation built on May 15, 2020, 7:08 p.m.