Demo_Manuscript/zz_summary_helpers.R

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

# Demographic summary functions -------------------------------------------

  demo_summarize <- function(d, varname) {

    varname %<>% paste0(" (n = ", nrow(d), ")")

    setdiff(demo_vars, "id") %>%
    d[ ,.] %>%
    as.list(.) %>%
    sapply(variable_summarize, simplify = FALSE) %>%
    do.call(c, .) %>%
    data.frame(stringsAsFactors = FALSE) %T>%
    {stopifnot(ncol(.) == 1)} %>%
    stats::setNames("value") %>%
    {data.frame(
      variable = row.names(.), value = .$value,
      stringsAsFactors = FALSE, row.names = NULL
    )} %>%
    stats::setNames(., gsub("^value$", varname, names(.)))

  }

  variable_summarize <- function(x, ...) {
    UseMethod("variable_summarize", x)
  }

  variable_summarize.numeric <- function(x, ...) {
    PAutilities::mean_sd(
      x, digits = 1, nsmall = 1, give_df = FALSE
    )
  }

  variable_summarize.factor <- function(x, ...) {
    levels(x) %>%
    sapply(function(y) sum(x==y))
  }

# Descriptive summary functions -------------------------------------------

  get_means <- function(d, description) {

    names(d) %>%
    .[grepl("kcal", .)] %>%
    d[ ,.] %>%
    sapply(
      PAutilities::mean_sd,
      digits = 0,
      nsmall = 0,
      simplify = FALSE
    ) %>%
    do.call(rbind, .) %>%
    {data.frame(
      Description = description,
      method = row.names(.),
      .,
      stringsAsFactors = FALSE,
      row.names = NULL
    )} %>%
    within({
      method = factor(
        method,
        c("act24_kcal", "AG_kcal", "swa_kcal"),
        c("ACT24", "Sojourn", "SWA")
      )
      ymin = mean - sd
      ymax = mean + sd
    }) %>%
    reshape2::recast(...~method, id.var = c("Description", "method"))

  }

  get_mape <- function(d, description) {

    names(d) %>%
    .[grepl("kcal", .)] %>%
    combn(2, simplify = FALSE) %>%
    lapply(function(x) {

      diffs <-
        d[ ,x] %>%
        apply(1, diff) %>%
        abs(.)

      x %>%
      sapply(function(y) {
        (diffs/d[ ,y]) %>%
        mean(.) %>%
        {.*100} %>%
        round(1) %>%
        paste0("%")
      }, USE.NAMES = FALSE) %>%
      {data.frame(
        comparison = rev(x),
        criterion = paste0(x, "_criterion"),
        mape = .,
        stringsAsFactors = FALSE,
        row.names = NULL
      )}

    }) %>%
    do.call(rbind, .) %>%
    within({criterion = factor(criterion)}) %>%
    .[order(.$criterion), ] %>%
    reshape2::dcast(
      ...~comparison+criterion, value.var = "mape"
    ) %>%
    stats::setNames(
      ., gsub("^\\.$", "Description", names(.))
    ) %>%
    within({Description = description})

  }

  get_names <- function(d) {

    d %>%
    sapply(function(x) length(unique(x$id))) %>%
    paste0(
      names(d), " (n = ",
      ., ")"
    ) %>%
    gsub("^.*\\.", "", .)

  }