In alainapearce/kellertools: Keller Lab Data Tools

#install.packages('gtsummary')
library(gtsummary)
theme_gtsummary_compact()

#need to load the package also or it wont work
library(kellertools)

knitr::opts_chunk$set(tidy = TRUE, tidy.opts = list(comment = FALSE), echo=TRUE, warning=FALSE, message=FALSE, comment = NA)

#also need .Rmd related packages loaded/installed
library(knitr)
library(kableExtra)

define functions

# convert 'haven_labelled' datatypes - your loop didn't change/update the 'Table1_vars', only the df in the dfList so that tables were not able to be created. This is where it is important that it is run fully independently/with cleared environment to ensure it works. By making your loop a function, you can apply it directly to your tables and return the changes. As we move forward, it may be a good idea to make these types of functions part of the package since they aren't super common in datasets typically needed with R.

convertHaven <- function(df){
  for (v in 1:ncol(df)) {
    var_name <- names(df)[v]
    class <- class(df[[var_name]])
    if (grepl("haven_labelled", class[1])  ) {
      df[[var_name]] <- labelled::unlabelled(df[[var_name]])
    }
  }

  return(df)
}

#this path is specific to your laptop - we should try to create some fake/simulated data that we can rely on for examples
data_path <- '/Users/azp271/OneDrive - The Pennsylvania State University/b-childfoodlab_Shared/Active_Studies/RO1_Brain_Mechanisms_IRB_5357/Participant_Data/untouchedRaw/Qualtrics_Raw/'

#will probably want to do individually for each table so get the data needed for each part separately - may need to change some of these to the user-interface wrappers once they are done

# Load data
data_v1 <- util_fbs_merge_v1(child_file_pattern = 'Child_V1', parent_file_pattern = 'Parent_V1', data_path = data_path)

Table 1a: Demographic Characteristics by Risk Status (all V1)

# select variables
## CHANGE RISK VARIABLES TO risk_status_mom / risk_status_both
Table1_vars <- data_v1[['data']][c('age_yr', 'sex', 'risk_status_mom','risk_status_both', 'bmi_screenout')]


Table1_vars <- convertHaven(Table1_vars)

# make Table 1

Table1 <- 
  tbl_summary(
    Table1_vars,
    statistic = list(all_continuous() ~ "{mean} ({sd})",
                     all_categorical() ~ "{n} ({p}%)"),
    label = list(age_yr ~ "Age (years)",
                 sex ~ "Sex",
                 risk_status_mom ~ "Risk (mom)",
                 risk_status_both ~ "Risk (mom and dad)",
                 bmi_screenout ~ "Child BMI screenout")
  ) %>%
  # update the column header
  #modify_header(label = "**Variable**") %>%
  bold_labels()

``` {r Table1_disp, results = 'asis'} as_kable_extra(Table1, caption = 'Demographic Characteristics by Risk Status', format = "latex", booktabs = TRUE, longtable = FALSE) %>% kableExtra::kable_styling(latex_options = "hold_position", full_width = FALSE)

# Table 1b: Demographic Characteristics by Risk Status (elligible after V1)

# Table 2: V1 elligibility breakdown
<!-- Add narrative for Table 2 prep -->
```r

## CHANGE RISK VARIABLE TO risk_status_mom
# select variables
Table2_vars <- data_v1[['data']][c('bmi_screenout', 'risk_status_mom')]

Table2_vars <- convertHaven(Table2_vars)

# make eligibility variable based on parent and child weight status
Table2_vars$elligible <- ifelse((Table2_vars$bmi_screenout == 0 & (Table2_vars$risk_status_mom == "Low Risk" | Table2_vars$risk_status_mom == "High Risk")), "Yes", "No")

Table2 <- 
  tbl_summary(
    Table2_vars,
    # split table by eligibility
    by = elligible,
    statistic = list(all_continuous() ~ "{mean} ({sd})",
                     all_categorical() ~ "{n} ({p}%)"),
    label = list(bmi_screenout ~ "Child BMI screenout",
                 risk_status_mom ~ "Risk status")
  ) %>%
  # update the column header
  modify_header(label = "**Elligible after V1**") %>%
  bold_labels()

as_kable_extra(Table2, caption = 'ADD CAPTION', format = "latex", booktabs = TRUE, longtable = FALSE) %>%
  kableExtra::kable_styling(latex_options = "hold_position",  full_width = FALSE)

Table 3: Demographics by visit

# Load data
# util_fbexample <- matrix(c(1,2,3))
# View(example)
#data_v1 <- util_fbs_merge_v1(child_file_pattern = 'Child_V1', parent_file_pattern = 'Parent_V1', data_path = data_path)
data_v2 <- util_fbs_merge_v2(child_file_pattern = 'Child_V2', parent_file_pattern = 'Parent_V2', parentV4_file_pattern = 'Parent_V4', data_path = data_path)
data_v3 <- util_fbs_merge_v3(child_file_pattern = 'Child_V3', parent_file_pattern = 'Parent_V3', data_path = data_path, model_DD = FALSE)
data_v4 <- util_fbs_merge_v4(child_file_pattern = 'Child_V4', parent_file_pattern = 'Parent_V4', data_path = data_path)
data_v5 <- util_fbs_merge_v5(child_file_pattern = 'Child_V5', parent_file_pattern = 'Parent_V5', data_path = data_path)
data_v6 <- util_fbs_merge_v6(child_file_pattern = 'Child_V6', parent_file_pattern = 'Parent_V6', data_path = data_path)
data_v7 <- util_fbs_merge_v7(child_file_pattern = 'Child_V7', parent_file_pattern = 'Parent_V7', data_path = data_path)

#' Extract id, start_date, visit number from list[["data"]]
#' @param list a list with data saved in a dataframe 'data' (e.g., output of running util_fbs_merge scripts)
#' @return a dataframe with ids, startdates, and visit number
#' @examples 
#' #if output of merge script saved as 'data_v3': E.g.) data_v3 <- util_fbs_merge_v3(child_file_pattern = 'Child_V3', parent_file_pattern = 'Parent_V3', data_path = data_path)
#' extractIDs(data_v3)

extractIDs <- function(list){
  # save name of list as a string
  dataframe_name <- deparse(substitute(list))

  # get visit number 
  visit_num <- substr(dataframe_name, 7, 7) 

  # Extract ID and assign to list_name
  dataframe_name <- list[["data"]][c('id','start_date')]

  # Add visit column
  dataframe_name$visit <- visit_num

  return(dataframe_name)
}


#' Add demo data (risk_cat, sex, age) to a dataframe by matching IDs with a reference dataframe
#' @param df dataframe with 'id' column 
#' @param reference_df dataframe 'id' and demographic variables (sex, risk_status_mom, risk_status_both, dob)
#' @return dataframe with id, sex, risk_cat, and age_yr columns 

addDemo <- function(df, reference_df){
  for (row in 1:nrow(df)) {
    row_id = df$id[row]

    # Add risk status
    df$risk_status_mom[row] <- reference_df$risk_status_mom[reference_df$id == 
                          row_id]
    df$risk_status_both[row] <- reference_df$risk_status_both[reference_df$id == 
                          row_id]
    # Add sex
    df$sex[row] <- reference_df$sex[reference_df$id == row_id]

    # Calculate age at visit 
    df$age_yr[row] <- round(lubridate::`%--%`(reference_df$dob[reference_df$id == row_id], 
                          df$start_date[row])/lubridate::years(1), digits = 2)

    }

  return(df)
}

# Extract IDs and demo variables from V1 database
V1 <- data_v1[["data"]][c('id', 'risk_status_mom','risk_status_both','sex', 'dob', 'age_yr')]
V1$visit <- "1"

# Extract IDs from V2-V7 databases and add visit column (use extractIDs())
V2 <- extractIDs(data_v2)
V3 <- extractIDs(data_v3)
V4 <- extractIDs(data_v4)
V5 <- extractIDs(data_v5)
V6 <- extractIDs(data_v6)
V7 <- extractIDs(data_v7)

# Add demo data to V2-V7 dataframes by referencing V1
nonV1_list <- list(V2, V3, V4, V5, V6, V7)
nonV1_list <- lapply(nonV1_list, addDemo, reference_df = V1)
nonV1_dat <- do.call('rbind', nonV1_list)

nonV1_dat <- nonV1_dat[names(V1[c(1:4, 6:7)])]

# Convert 'haven_labelled' datatypes 
V1 <- convertHaven(V1)

nonV1_dat$risk_status_mom <- ifelse(nonV1_dat$risk_status_mom == 0, 'Low Risk', ifelse(nonV1_dat$risk_status_mom == 1, 'High Risk', 'Neither'))
nonV1_dat$risk_status_mom  <- as.factor(nonV1_dat$risk_status_mom)

nonV1_dat$risk_status_both <- ifelse(nonV1_dat$risk_status_both == 0, 'Low Risk', ifelse(nonV1_dat$risk_status_both == 1, 'High Risk', 'Neither'))
nonV1_dat$risk_status_both <- as.factor(nonV1_dat$risk_status_both)

nonV1_dat$sex <- ifelse(nonV1_dat$sex == 0, 'Male', 'Female')
nonV1_dat$sex <- as.factor(nonV1_dat$sex)

# Combine visit dataframes
V1_7 <- rbind.data.frame(V1[c(1:4, 6:7)], nonV1_dat)

# Select variables to include in table
V1_7 <- V1_7[c('risk_status_mom', 'risk_status_both', 'sex', 'age_yr', 'visit')]

# make Table 3
Table3 <- 
  tbl_summary(
    V1_7,
    by = visit, # split table by group
    label = list(sex ~ "Sex",
                 risk_status_mom ~ "Risk status (mom)",
                 risk_status_both ~ "Risk status (both)",
                 age_yr ~ "Age (years)"),
    statistic = list(all_continuous() ~ "{mean} ({sd})",
                     all_categorical() ~ "{n} ({p}%)")
  ) %>%
  modify_header(label = "**Visit**") %>% # update the column header
  bold_labels()

no demo

V1_7_nodemo <- V1_7[c('risk_status_mom', 'risk_status_both', 'visit')]

# make Table 3
Table3c <- 
  tbl_summary(
    V1_7_nodemo,
    by = visit, # split table by group
    label = list(risk_status_mom ~ "Risk status (based on maternal BMI)",
                 risk_status_both ~ "Risk status (based on maternal and paternal BMI)"),
    statistic = list(all_continuous() ~ "{mean} ({sd})",
                     all_categorical() ~ "{n}")
  ) %>%
  modify_header(label = "**Visit**") %>% # update the column header
  bold_labels()

#### Risk defined by maternal BMI ####
# risk_low
tbl_low_mom_dat <- V1_7[V1_7$risk_status_mom == 'Low Risk', c('sex', 'age_yr', 'visit')]

tbl_low_mom <-
  tbl_summary(
    tbl_low_mom_dat,
    by = visit,
    label = list(sex ~ "Sex",
                 age_yr ~ "Age (years)")) %>%
  modify_header(all_stat_cols() ~ "**{level}**")

# risk_high
tbl_high_mom_dat <- V1_7[V1_7$risk_status_mom == 'High Risk', c('sex', 'age_yr', 'visit')]

tbl_high_mom <-
  tbl_summary(
    tbl_high_mom_dat,
    by = visit,
    label = list(sex ~ "Sex",
                 age_yr ~ "Age (years)")) %>%
  modify_header(all_stat_cols() ~ "**{level}**")

visit_byrisk_mom <-
  tbl_stack(
    list(tbl_low_mom, tbl_high_mom), 
    group_header = c("Low Risk", "High Risk")
    ) %>%
  modify_header(label = "**Visit**") %>% # update the column header
  bold_labels() 

#### Risk defined by maternal and paternal BMI ####
# risk_low
tbl_low_both_dat <- V1_7[V1_7$risk_status_both == 'Low Risk', c('sex', 'age_yr', 'visit')]

tbl_low_both <-
  tbl_summary(
    tbl_low_both_dat,
    by = visit,
    label = list(sex ~ "Sex",
                 age_yr ~ "Age (years)")) %>%
  modify_header(all_stat_cols() ~ "**{level}**")

# risk_high
tbl_high_both_dat <- V1_7[V1_7$risk_status_both == 'High Risk', c('sex', 'age_yr', 'visit')]

tbl_high_both <-
  tbl_summary(
    tbl_high_both_dat,
    by = visit,
    label = list(sex ~ "Sex",
                 age_yr ~ "Age (years)")) %>%
  modify_header(all_stat_cols() ~ "**{level}**")

visit_byrisk_both <-
  tbl_stack(
    list(tbl_low_both, tbl_high_both), 
    group_header = c("Low Risk", "High Risk")
    ) %>%
  modify_header(label = "**Visit**") %>% # update the column header
  bold_labels()

as_kable_extra(Table3, caption = 'Demographics by Visit', format = "latex", booktabs = TRUE, longtable = FALSE) %>%
  kableExtra::kable_styling(latex_options = "hold_position",  full_width = FALSE)

mri <- data_v6[["data"]][c('id', 'start_date', 'notes_mri_mprage','notes_mri_restingstate','notes_mri_run1', 'notes_mri_run2', 'notes_mri_run3','notes_mri_run4', 'notes_mri_run5', 'childnotes')]


intero <- data_v5[["data"]][c('id', 'start_date', 'hrv_dur', 'hrv_starttime', 'child_notes')]