Merge pull request #3 from uclahs-cds/lyl-presto1-revision

LYL add PRESTO1 analysis code
uclahs-cds · Feb 8, 2024 · 2dc7292 · 2dc7292
2 parents 8bd6d49 + b2692b3
commit 2dc7292
Show file tree

Hide file tree

Showing 19 changed files with 302 additions and 74 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,25 +1,22 @@
-Package: EXONC.DEXP
+Package: EXOC.DPEx
 Type: Package
-Title: A Digital, Decentralized Clinical Trial of Exercise Therapy in Cancer (EXONC.DEXP)
-Version: 0.1.0
-Author: Who wrote it
-Maintainer: Stefan Eng <[email protected]>
-Description: Code for 'A Digital, Decentralized Clinical Trial of Exercise Therapy in Cancer (EXONC.DEXP)'
-Depends: 
-    R (>= 2.10)
-Suggests: 
-    performance,
-    testthat (>= 3.0.0),
-    fs
+Title: Decentralized Clinical Trial of Exercise Therapy in Cancer
+Version: 0.2.0
+Author: Stefan Eng, Lydia Y Liu
+Maintainer: Zhuyu Qiu <[email protected]>
+Description: Code for 'Phase 1a, Decentralized Trial of Neoadjuvant Exercise Therapy in Prostate Cancer (PRESTO1)' and 'A Digital, Decentralized Clinical Trial of Exercise Therapy in Cancer (DPEx)'
+Depends: R (>= 2.10)
+Suggests: performance,
+  testthat (>= 3.0.0),
+  fs
 Config/testthat/edition: 3
 License: GPL-2
 Encoding: UTF-8
 LazyData: true
-Imports:
-    latticeExtra,
-    BoutrosLab.plotting.general,
-    plyr,
-    lsr,
-    lmerTest,
-    slider
+Imports: latticeExtra,
+  BoutrosLab.plotting.general,
+  plyr,
+  lsr,
+  lmerTest,
+  slider
 RoxygenNote: 7.2.1
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
-# EXONC.DEXP 0.1.0
+# EXOC.DPEx 0.1.0
 
-* Initial plot and code changes for EXONC.DEXP: A Digital, Decentralized Clinical Trial of Exercise Therapy in Cancer
+- Initial plot and code changes for DPEx: A Digital, Decentralized Clinical Trial of Exercise Therapy in Cancer
+
+# EXOC.DPEx 0.2.0
+
+- Addition of supplementary table code for PRESTO1: Phase 1a, Decentralized Trial of Neoadjuvant Exercise Therapy in Prostate Cancer
diff --git a/R/calculate_daily_summary_mean_delta.R b/R/calculate_daily_summary_mean_delta.R
@@ -0,0 +1,103 @@
+mean.delta.analysis <- function(daily.summary, dosage, results.path) {
+
+    diff.list <- lapply(split(daily.summary, daily.summary$patient), function(x) calculate.daily.summary.mean.delta(x, plot_vars))
+
+    diff.df <- plyr::rbind.fill(diff.list)
+    diff.df <- cbind(patient = patients, diff.df)
+    print(summary(diff.df))
+
+    # merge with dose
+    diff.df <- merge(
+        x = diff.df,
+        y = dosage[, c('patient', 'dose', 'relative.dose.intensity')],
+        by = 'patient',
+        all.x = TRUE
+        )
+
+    # calculate delta per variable
+    doses <- sort(unique(dosage$dose), na.last = NA)
+    diff.df$dose.fct <- factor(diff.df$dose, levels = doses)
+
+    # output in table
+    diff.output <- lapply(plot_vars, function(x) {
+
+        # table for each dose level
+        dose.diff.model <- lm(diff.df[, x] ~ 0 + diff.df$dose.fct)
+        dose.diff.table <- cbind.data.frame(dose = doses, summary(dose.diff.model)$coefficient)
+
+        # table for all patients
+        dose.diff.model.all <- lm(diff.df[, x] ~ 1)
+        dose.diff.table.all <- cbind.data.frame(dose = 0, summary(dose.diff.model.all)$coefficient)
+        dose.diff.table <- rbind(dose.diff.table.all, dose.diff.table)
+
+        dose.diff.string <- paste0(round(dose.diff.table$Estimate, 1),
+                                    ' (', round(dose.diff.table$Estimate - dose.diff.table[, 'Std. Error'] * 1.96, 1),
+                                    ' - ', round(dose.diff.table$Estimate + dose.diff.table[, 'Std. Error'] * 1.96, 1),
+                                    ')')
+        dose.diff.df <- as.data.frame(matrix(dose.diff.string, ncol = length(dose.diff.string)))
+        colnames(dose.diff.df) <- dose.diff.table$dose
+
+        dose.diff.df
+    })
+
+    dose.diff.df <- plyr::rbind.fill(diff.output)
+    colnames(dose.diff.df) <- paste0('Dose: ', colnames(dose.diff.df), ' (minutes)')
+    dose.diff.df <- cbind(Variable = vars_nice_names, dose.diff.df)
+
+    filename <- print(file.path(
+        results.path,
+        generate.filename(
+            'phase1_0b-prostate', 'daily_summary_before7_after7_diff_mean_ci', 'tsv'
+            )
+        ))
+    write.table(dose.diff.df, filename, quote = F, sep = '\t', row.names = F, col.names = T)
+
+}
+
+
+calculate.daily.summary.mean.delta <- function(daily.summary, vars,
+                                        days = 7) {
+
+    print(vars[!vars %in% colnames(daily.summary)])
+    vars <- vars[vars %in% colnames(daily.summary)]
+
+    res <- sapply(vars, function(v) {
+
+        x <- daily.summary$nday
+        y <- daily.summary[, v]
+
+        # TODO: adhoc dealing with duplicated x for now
+        if (any(duplicated(x))) {
+            which.dup <- which(duplicated(x) | duplicated(x, fromLast = T))
+            if (v %in% c('sleep_length')) {
+                z <- sum(y[which.dup])
+                y <- c(z, y[-which.dup])
+            } else {
+                # includes start.diff.midnight, take first value
+                y <- y[-which.dup[length(which.dup)]]
+            }
+
+            x <- x[!duplicated(x)]
+            stopifnot(length(x) == length(y))
+        }
+
+        before <- y[1:days]
+        before.mean <- mean(before, na.rm = T)
+
+        # actually takes the last days + 1
+        after <- y[(length(y) - days + 1):length(y)]
+        after.mean <- mean(after, na.rm = T)
+
+        # print(y)
+        # print(c(before.mean, after.mean))
+
+        res <- after.mean - before.mean
+
+    })
+
+    res <- as.data.frame(matrix(res, nrow = 1, byrow = T))
+    colnames(res) <- vars
+
+    return(res)
+
+}
diff --git a/R/cost_analysis.R b/R/cost_analysis.R
@@ -1,4 +1,4 @@
-#' Creates the estimated study hours plot for EXONC.DEXP
+#' Creates the estimated study hours plot for EXOC.DPEx
 
 #' @param cost.data the cost data frame.
 #' @param plot.path path to the plot output
@@ -17,13 +17,13 @@ study.hours.plot <- function(
   suffix = '',
   ...) {
   write.plot <- ! is.null(plot.path);
-  EXONC.DEXP.hours <- cbind(cost.data[, c('Patient', 'patient.id', 'EXONC.DEXP.Time.total.hrs')], study = 1);
-  colnames(EXONC.DEXP.hours) <- c('Patient', 'patient.id', 'hours', 'study');
+  EXOC.DPEx.hours <- cbind(cost.data[, c('Patient', 'patient.id', 'EXOC.DPEx.Time.total.hrs')], study = 1);
+  colnames(EXOC.DPEx.hours) <- c('Patient', 'patient.id', 'hours', 'study');
   trad.hours <- cbind(cost.data[, c('Patient', 'patient.id', 'Traditional.Time.total.hrs')], study = 0);
   colnames(trad.hours) <- c('Patient', 'patient.id', 'hours', 'study');
 
   time.df <- rbind(
-    EXONC.DEXP.hours,
+    EXOC.DPEx.hours,
     trad.hours
     );
 
@@ -34,13 +34,13 @@ study.hours.plot <- function(
   method <- 'pooled'
 
   t.test.results <- stats::t.test(
-    x = cost.data$EXONC.DEXP.Time.total.hrs,
+    x = cost.data$EXOC.DPEx.Time.total.hrs,
     y = cost.data$Traditional.Time.total.hrs,
     paired = paired
     );
 
   cohens.d <- lsr::cohensD(
-    x = cost.data$EXONC.DEXP.Time.total.hrs,
+    x = cost.data$EXOC.DPEx.Time.total.hrs,
     y = cost.data$Traditional.Time.total.hrs,
     method = method
     );
@@ -86,7 +86,7 @@ study.hours.plot <- function(
     panel.x <- 1.9;
     panel.y <- 155;
     t.test.layer <- ttest.plot.text(
-      x = cost.data$EXONC.DEXP.Time.total.hrs,
+      x = cost.data$EXOC.DPEx.Time.total.hrs,
       y = cost.data$Traditional.Time.total.hrs,
       panel.x = panel.x,
       panel.y = panel.y,
@@ -124,7 +124,7 @@ study.hours.plot <- function(
     }
   }
 
-#' Creates the estimated total cost boxplot plot for EXONC.DEXP
+#' Creates the estimated total cost boxplot plot for EXOC.DPEx
 
 #' @param cost.data the cost data frame.
 #' @param extension the extension for the plot
@@ -145,7 +145,7 @@ total.cost.plot <- function(
   write.plot <- ! is.null(plot.path);
   cost.data$phase0b <- ifelse(cost.data$Patient <= 3, FALSE, TRUE);
   phase.0b.costs <- cbind(cost.data[cost.data$phase0b, 'Total.Cost', drop = FALSE], group = 1);
-  # Add the EXONC.DEXP costs as '0'
+  # Add the EXOC.DPEx costs as '0'
   phase.0b.costs <- rbind(phase.0b.costs, c(0, 2));
 
   # phase.0b.costs

diff --git a/R/submax_analysis.R b/R/submax_analysis.R
@@ -129,3 +129,37 @@ submax.analysis <- function(
 
   invisible(submax.plot);
   }
+
+submax.delta.summary <- function(submax.long.data, dosage, results.path) {
+
+  doses <- sort(unique(dosage$dose), na.last = NA)
+
+  submax.long.data$dose.fct <- factor(submax.long.data$dose, levels = doses)
+
+  dose.diff.model <- lm(delta ~ 0 + dose.fct, data = submax.long.data)
+  dose.diff.table <- cbind.data.frame(dose = doses, summary(dose.diff.model)$coefficient)
+
+  dose.diff.model.all <- lm(delta ~ 1, data = wide.phase1.0b.submax)
+  dose.diff.table.all <- cbind.data.frame(dose = 'All', summary(dose.diff.model.all)$coefficient)
+  dose.diff.table <- rbind(dose.diff.table, dose.diff.table.all)
+
+  # reformat table for output
+  dose.diff.table$dose.fct <- factor(dose.diff.table$dose, levels = c('All', doses))
+  dose.diff.table <- dose.diff.table[order(dose.diff.table$dose.fct), ]
+  dose.diff.string <- paste0(round(dose.diff.table$Estimate, 1),
+                              ' (', round(dose.diff.table$Estimate - dose.diff.table[, 'Std. Error'] * 1.96, 1),
+                              ' - ', round(dose.diff.table$Estimate + dose.diff.table[, 'Std. Error'] * 1.96, 1),
+                              ')')
+  dose.diff.df <- as.data.frame(matrix(dose.diff.string, ncol = length(dose.diff.string)))
+  colnames(dose.diff.df) <- paste0('Dose: ', dose.diff.table$dose, ' (minutes)')
+  dose.diff.df <- cbind(Variable = 'Seconds to Submax', dose.diff.df)
+
+  filename <- print(file.path(
+      results.path,
+      generate.filename(
+          'phase1_0b-prostate', 'submax_diff_mean_ci', 'tsv'
+          )
+      ))
+  write.table(dose.diff.df, filename, quote = F, sep = '\t', row.names = F, col.names = T)
+
+}
diff --git a/README.md b/README.md
@@ -1,26 +1,25 @@
-# Project/Repo Title
+# Decentralized Trial of Exercise Therapy in Cancer
 
-Template Repository for the Boutros Lab R package repos. Describe a simple overview of use/purpose here.
+This repository contains analysis code for the following projects
 
-## How to Use This Template
+- PRESTO1: Phase 1a, Decentralized Trial of Neoadjuvant Exercise Therapy in Prostate Cancer
+- DPEx: A Digital, Decentralized Trial of Exercise Therapy in Patients with Cancer
 
-- Replace all placeholder text in the sections below.
-
-- Update metadata.yaml and DESCRIPTION with your project title, contributors, etc.
+## Description
 
-- Replace all occurrences of `BoutrosLabTemplate` in .github/workflows/R-CMD-check.yaml with your project title (same as title in in DESCRIPTION).
+### PRESTO1
 
-## Description
+Analysis of lifestyle states and physiological outcomes
 
-An in-depth paragraph about your project and overview of use.
+- summary tables generated by `inst/scripts/submax_delta.R` and `inst/scripts/daily_summary_mean_diff.R`
 
 ## License
 
-Author: Name1([email protected]), Name2([email protected])
+Author: Stefan Eng, Lydia Y Liu
 
-[This project] is licensed under the GNU General Public License version 2. See the file LICENSE.md for the terms of the GNU GPL license.
+EXOC.Analysis is licensed under the GNU General Public License version 2. See the file LICENSE.md for the terms of the GNU GPL license.
 
-<one line to give the project/program's name and a brief idea of what it does.>
+Data analysis and visualization code for decentrailized trial of exercise therapy in cancer
 
 Copyright (C) 2021 University of California Los Angeles ("Boutros Lab") All rights reserved.
 

diff --git a/inst/create_adherence_perc.R b/inst/create_adherence_perc.R
@@ -1,9 +1,9 @@
 ## code to prepare `adherence.perc.phase0a` and `adherence.perc.phase0b` dataset goes here
 
-adherence.phase0a <- read.table(system.file('extdata', 'adherence_phase0a.tsv', package = 'EXONC.DEXP'), header = TRUE, sep = '\t');
-adherence.phase0b <- read.table(system.file('extdata', 'adherence_phase0b.tsv', package = 'EXONC.DEXP'), header = TRUE, sep = '\t');
+adherence.phase0a <- read.table(system.file('extdata', 'adherence_phase0a.tsv', package = 'EXOC.DPEx'), header = TRUE, sep = '\t');
+adherence.phase0b <- read.table(system.file('extdata', 'adherence_phase0b.tsv', package = 'EXOC.DPEx'), header = TRUE, sep = '\t');
 
-cancer.types <- read.table(system.file('extdata', 'patient_cancer_types.tsv', package = 'EXONC.DEXP'), header = TRUE, sep = '\t');
+cancer.types <- read.table(system.file('extdata', 'patient_cancer_types.tsv', package = 'EXOC.DPEx'), header = TRUE, sep = '\t');
 
 # adherence.phase0b$Patient.ID <- c('EX004', 'EX005', 'EX006', 'EX008',
 #                                   'EX010', 'EX011', 'EX012', 'EX014', 'EX015', 'EX016', 'EX017',
@@ -31,14 +31,14 @@ adherence.perc.phase0b <- merge(adherence.perc.phase0b, cancer.types, by = 'Pati
 
 write.table(
   x = adherence.perc.phase0a,
-  file = system.file('extdata', 'adherence_perc_phase0a.tsv', package = 'EXONC.DEXP'),
+  file = system.file('extdata', 'adherence_perc_phase0a.tsv', package = 'EXOC.DPEx'),
   sep = '\t',
   row.names = FALSE
   );
 
 write.table(
   x = adherence.perc.phase0b,
-  file = system.file('extdata', 'adherence_perc_phase0b.tsv', package = 'EXONC.DEXP'),
+  file = system.file('extdata', 'adherence_perc_phase0b.tsv', package = 'EXOC.DPEx'),
   sep = '\t',
   row.names = FALSE
   );
diff --git a/inst/daily_summary_mean_delta.R b/inst/daily_summary_mean_delta.R
@@ -0,0 +1,47 @@
+library(EXOC.DPEx);
+library(BoutrosLab.plotting.general);
+library(lme4);
+library(lmerTest);
+
+script.name <- 'daily_summary_mean_diff';
+data.folder <- Sys.getenv('EXONC_HOME');
+if (data.folder == '') data.folder <- 'DEXP_results';
+plot.path <- file.path(data.folder, 'digIT-EX', 'plots', script.name);
+results.path <- file.path(data.folder, 'digIT-EX', 'results', script.name);
+extension <- 'png';
+
+analysis.init(
+  data.folder = data.folder,
+  script.name = script.name,
+  split.stdout = TRUE,
+  expr = {
+    daily.summary <- read.table(
+      # TODO: Fix paths
+      system.file('extdata', 'daily_summary.tsv', package = 'EXOC.DPEx'),
+      sep = '\t',
+      header = TRUE
+      );
+
+    # load dosage file
+    dosage <- read.table(
+        file.path(data.folder, 'raw_data', 'Phase1', 'Dose_finding', 'PRESTO_Dose_levels.tsv'),
+        sep = '\t',
+        header = TRUE
+        );
+    dosage$patient <- sprintf('EX%03d', dosage$patient.identifier);
+
+    # merge with dosage
+    daily.summary <- merge(
+        x = daily.summary,
+        y = dosage[, c('patient', 'dose', 'relative.dose.intensity')],
+        by = 'patient',
+        all.x = TRUE
+        )
+
+    mean.delta.analysis(daily.summary,
+      dosage,
+      results.path = results.path
+      )
+
+    }
+  );
diff --git a/inst/extdata/patient_cost_hours.tsv b/inst/extdata/patient_cost_hours.tsv
@@ -1,4 +1,4 @@
-"patient.id"	"Patient"	"Total.Cost"	"EXONC.DEXP.Time.total.hrs"	"Traditional.Time.total.hrs"	"Cancer.Type"	"plot.color"
+"patient.id"	"Patient"	"Total.Cost"	"EXOC.DPEx.Time.total.hrs"	"Traditional.Time.total.hrs"	"Cancer.Type"	"plot.color"
 "EX001"	1	143	33	61.6	"Breast"	"orange"
 "EX002"	2	170.5	39.1666666666667	54.6666666666667	"Breast"	"orange"
 "EX003"	3	154	36.3333333333333	80.2	"Breast"	"orange"

diff --git a/inst/plot_adherence.R b/inst/plot_adherence.R
@@ -1,4 +1,4 @@
-library(EXONC.DEXP);
+library(EXOC.DPEx);
 library(BoutrosLab.plotting.general);
 
 script.name <- 'adherence';
@@ -17,8 +17,8 @@ analysis.init(
     # Boxplot with the points shown (stripplot with a barplot overlaid), with columns for each data-type,
     # and then outlier points labeled with their patient numbers
     # Make a copy of the adherence data for Phase 0a patients
-    # perc.phase0a.long <- read.table(system.file('extdata', 'adherence_perc_phase0a.tsv', package = 'EXONC.DEXP'), header = TRUE, sep = '\t');
-    # perc.phase0b.long <- read.table(system.file('extdata', 'adherence_perc_phase0b.tsv', package = 'EXONC.DEXP'), header = TRUE, sep = '\t');
+    # perc.phase0a.long <- read.table(system.file('extdata', 'adherence_perc_phase0a.tsv', package = 'EXOC.DPEx'), header = TRUE, sep = '\t');
+    # perc.phase0b.long <- read.table(system.file('extdata', 'adherence_perc_phase0b.tsv', package = 'EXOC.DPEx'), header = TRUE, sep = '\t');
     #
     # perc.phase0a.long <- perc.phase0a.long[perc.phase0a.long$Variable != 'Sleep', ];
     # perc.phase0b.long <- perc.phase0b.long[perc.phase0b.long$Variable != 'Sleep', ];