Data update & bug fixes

This update to show data for task OHDSI#5 & various bug fixes

PioneerWatchfulWaiting/changeLog.Rmd

@@ -21,5 +21,8 @@ Now showing task #3 results from 8 databases with correct time-to-event data.
 ## 2021-Apr-30: Adding pre-task#4 results
 Now showing results for pre-task#4 for 7 databases.
 
+## 2021-Jul-15: Adding task #5 results & bug fixes
+Now shoing results for task #5 for 5 databases.
+Some bug fixed from the previous version.
 ------
 

PioneerWatchfulWaiting/changeLog.html

@@ -81,6 +81,12 @@ <h2>2021-Apr-30: Data Update and Correction</h2>
 <hr />
 </div>
 
+<div id="Jul-15-data-update" class="section level2">
+<h2>2021-Jul-15: Adding task #5 results & bug fixes</h2>
+<p>Now shoing results for task #5 for 5 databases. Some bug fixed from the previous version.</p>
+<hr />
+</div>
+
 <!-- code folding -->
 
 

PioneerWatchfulWaiting/cohorts.csv

@@ -1 +1,66 @@
-cohortId,name,atlasId,circeDef
+cohortId, name, atlasID, circeDef
+101,[PIONEER T1] Newly diagnosed Pca, 47, TRUE
+103,[PIONEER T2] PCa treated right away, 49, TRUE
+111,[PIONEER T3] PCa under conservative management,137,TRUE
+117,[PIONEER T4] PCa treated after conservative management ,143,TRUE
+105,[PIONEER T3.1] PCa high/intermediate risk conservative management,138,TRUE
+107,[PIONEER T3.2] PCa low risk grade conservative management and no intense monitoring,139,TRUE
+109,[PIONEER T3.3] PCa low risk grade conservative management and intense monitoring,140,TRUE
+113,[PIONEER T4.1] Delayed Curative Management,144,TRUE
+115,[PIONEER T4.2] Delayed Palliative Management,145,TRUE
+102,[PIONEER T1a] Newly diagnosed Pca_broad,141,TRUE
+104,[PIONEER T2a] PCa treated right away_broad,142,TRUE
+112,[PIONEER T3a] PCa under conservative management_broad,125,TRUE
+118,[PIONEER T4a] PCa treated after conservative management_broad,129,TRUE
+106,[PIONEER T3.1a] PCa high/intermediate risk conservative managemetn_broad,126,TRUE
+108,[PIONEER T3.2a] PCa low risk grade conservative management and no intense monitoring_broad,127,TRUE
+110,[PIONEER T3.3a] PCa low risk grade conservative management and intense monitoring_broad,128,TRUE
+114,[PIONEER T4.1a] Delayed Curative Management_broad,131,TRUE
+116,[PIONEER T4.2a] Delayed Palliative Management_broad,132,TRUE
+119,[PIONEER T5] Symptom post conservative management ,168,TRUE
+120,[PIONEER T5a] Symptom post conservative management_broad,167,TRUE
+202,[PIONEER O1] Death,46,TRUE
+201,[PIONEER O2] Symptomatic progression ,45,TRUE
+203,[PIONEER O3] Treatment initiation,61,TRUE
+204,[PIONEER O4] Curative treatment,73,TRUE
+205,[PIONEER O5] Palliative treatment ,74,TRUE
+206,[PIONEER O6] Hospitalization,87,TRUE
+207,[PIONEER O7] ED visit,90,TRUE
+301,[PIONEER S1] EAU High Risk,52,TRUE
+302,[PIONEER S2] EAU Low Risk,53,TRUE
+303,[PIONEER S3] EAU Intermediate Risk,54,TRUE
+304,[PIONEER S4] Metastatic PCa,55,TRUE
+305,[PIONEER S5] Locally Advanced PCa,56,TRUE
+306,[PIONEER S6] localized PCa,57,TRUE
+307,[PIONEER S7] PSA >20 at Diagnosis ,58,TRUE
+308,[PIONEER S8] PSA <10 at Diagnosis,59,TRUE
+309,[PIONEER S9] PSA 10-20 at Diagnosis,60,TRUE
+310,[PIONEER S10] Stage cT1 at Dx,63,TRUE
+311,[PIONEER S11] Stage cT2 at Dx,64,TRUE
+312,[PIONEER S12] Stage cT3/cT4 at Dx,65,TRUE
+313,[PIONEER S13] Physical Therapy/Exercise,112,TRUE
+314,[PIONEER S14] Grade 1 (GS 2-6),67,TRUE
+315,[PIONEER S15] Grade 2 (GS 3+4),68,TRUE
+316,[PIONEER S16] Grade 3 (GS 4+3),69,TRUE
+317,[PIONEER S17] Grade 4 (GS 8),70,TRUE
+318,[PIONEER S18] Grade 5 (GS 9-10),71,TRUE
+319,[PIONEER S19] Family history of Prostate cancer or history of family history of germline mutations,72,TRUE
+"320,""[PIONEER S20] Mutation (germline or somatic) in BRCA2, BRCA1, ATM, MLH1, MSH1, MSH2, MSH6, CHEK2, RAD51B and PALB2 "",83,TRUE"
+321,[PIONEER S21] Age at diagnosis <55,111,TRUE
+322,[PIONEER S22] Age at diagnosis 55-80,110,TRUE
+323,[PIONEER S23] Age at diagnosis >80,109,TRUE
+324,[PIONEER S24] Charlson CCI=0,120,TRUE
+325,[PIONEER S25] Charlson CCI=1,121,TRUE
+326,[PIONEER S26] Charlson CCI>=2,122,TRUE
+"327,""[PIONEER S27] Any malignancy, except malignant neoplasm of skin"",81,TRUE"
+334,[PIONEER S28] Performance status ECOG=0,164,TRUE
+335,[PIONEER S29] Performance status ECOG=1,165,TRUE
+336,[PIONEER S30] Performance status ECOG=2+,166,TRUE
+328,[PIONEER S31] Total Cardiovascular Disease Event,152,TRUE
+329,[PIONEER S32] Stroke,153,TRUE
+330,[PIONEER S33] Type 2 Diabetes,154,TRUE
+331,[PIONEER S34] Hypertension,155,TRUE
+332,[PIONEER S35] Obesity,156,TRUE
+333,[PIONEER S36] VTE,157,TRUE
+337,[PIONEER S37] Anxiety,158,TRUE
+338,[PIONEER S38] Prevalent Asthma or Chronic obstructive pulmonary disease (COPD),159,TRUE

PioneerWatchfulWaiting/ggsurvtable.R

@@ -0,0 +1,261 @@
+cb_palette <- c("#000000", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+ggsurvtable_custom <- function (fit, data = NULL, survtable = c("cumevents",  "cumcensor", "risk.table"),
+                         risk.table.type = c("absolute", "percentage", "abs_pct", "nrisk_cumcensor", "nrisk_cumevents"),
+                         title = NULL, risk.table.title = NULL, cumevents.title = title, cumcensor.title = title,
+                         color = "black", palette = cb_palette, break.time.by = NULL,  xlim = NULL,
+                         xscale = 1, xlab = "Time", ylab = "Strata",
+                         xlog = FALSE, legend = "top",
+                         legend.title = "Strata", legend.labs = NULL,
+                         y.text = TRUE, y.text.col = TRUE,
+                         fontsize = 4.5, font.family = "",
+                         axes.offset = TRUE,
+                         ggtheme = theme_survminer(),
+                         tables.theme = ggtheme, ...)
+{
+
+  if(is.data.frame(fit)){}
+  else if(.is_list(fit)){
+    if(!all(c("time", "table") %in% names(fit)))
+      stop("fit should contain the following component: time and table")
+  }
+  else if(!.is_survfit(fit))
+    stop("Can't handle an object of class ", class(fit))
+
+  # Define time axis breaks
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  xmin <- ifelse(xlog, min(c(1, fit$time)), 0)
+  if(is.null(xlim)) xlim <- c(xmin, max(fit$time))
+  times <- .get_default_breaks(fit$time, .log = xlog)
+  if(!is.null(break.time.by) &!xlog) times <- seq(0, max(c(fit$time, xlim)), by = break.time.by)
+
+
+
+  # Surv summary at specific time points
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  # if(.is_survfit(fit)){
+  #   data <- .get_data(fit, data = data)
+  #   survsummary <- .get_timepoints_survsummary(fit, data, times)
+  # }
+  # else if(.is_list(fit)){
+  #   survsummary <- fit$table
+  # }
+  else if(inherits(fit, "data.frame")){
+    survsummary <- as.data.frame(.get_timepoints_survsummary(fit, data, times))
+  }
+
+  opts <- list(
+    survsummary = survsummary, times = times,
+    survtable = survtable, risk.table.type = risk.table.type,  color = color, palette = cb_palette,
+    xlim = xlim, xscale = xscale,
+    title = title, xlab = xlab, ylab = ylab, xlog = xlog,
+    legend = legend, legend.title = legend.title, legend.labs = legend.labs,
+    y.text = y.text, y.text.col = y.text.col,
+    fontsize = fontsize, font.family = font.family,
+    axes.offset = axes.offset,
+    ggtheme = ggtheme, tables.theme = tables.theme,...)
+
+  res <- list()
+  time <- strata <- label <- n.event <- cum.n.event <- NULL
+
+  # Ploting the cumulative number of events table
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  if("cumevents" %in% survtable){
+    opts$survtable = "cumevents"
+    opts$title <- ifelse(is.null(cumevents.title),
+                         "Cumulative number of events", cumevents.title)
+    res$cumevents <- do.call(.plot_survtable, opts)
+
+  }
+
+  if("cumcensor" %in% survtable){
+    opts$survtable = "cumcensor"
+    opts$title <- ifelse(is.null(cumcensor.title),
+                         "Cumulative number of events", cumcensor.title)
+    res$cumcensor <- do.call(.plot_survtable, opts)
+
+  }
+  if("risk.table" %in% survtable){
+    opts$survtable = "risk.table"
+    if(is.null(risk.table.title)) opts$title <- NULL
+    else opts$title <- risk.table.title
+    res$risk.table <- do.call(.plot_survtable, opts)
+  }
+
+
+  if(length(res) == 1) res <- res[[1]]
+  res
+}
+
+
+
+
+
+
+
+
+# Helper function to plot a specific survival table
+.plot_survtable <- function (survsummary, times, survtable = c("cumevents", "risk.table", "cumcensor"),
+                             risk.table.type = c("absolute", "percentage", "abs_pct", "nrisk_cumcensor", "nrisk_cumevents"),
+                             color = "black", palette = cb_palette, xlim = NULL,
+                             xscale = 1,
+                             title = NULL, xlab = "Time", ylab = "Strata",
+                             xlog = FALSE, legend = "top",
+                             legend.title = "Strata", legend.labs = NULL,
+                             y.text = TRUE, y.text.col = TRUE, fontsize = 4.5,
+                             font.family = "",
+                             axes.offset = TRUE,
+                             ggtheme = theme_survminer(), tables.theme = ggtheme,
+                             ...)
+{
+
+  survtable <- match.arg(survtable)
+  risk.table.type <- match.arg(risk.table.type)
+
+  # Defining plot title
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  if(is.null(title)){
+
+    if(survtable == "risk.table"){
+      risk.table.type <- match.arg(risk.table.type)
+      title <- switch(risk.table.type,
+                      absolute = "Number at risk",
+                      percentage = "Percentage at risk",
+                      abs_pct = "Number at risk: n (%)",
+                      nrisk_cumcensor = "Number at risk (number censored)",
+                      nrisk_cumevents = "Number at risk (number of events)",
+                      "Number at risk")
+
+    }
+    else
+      title <- switch(survtable,
+                      cumevents = "Cumulative number of events",
+                      cumcensor = "Number of censored subjects"
+      )
+  }
+
+  # Legend labels
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  if(is.null(color))
+    color <- .strata.var <- "strata"
+  else if(color %in% colnames(survsummary))
+    .strata.var <- color
+  else
+    .strata.var <- "strata"
+
+  # Number of strata and strata names
+  .strata <- survsummary[, .strata.var]
+  strata_names <- .levels(.strata)
+  n.strata <- length(strata_names)
+
+  # Check legend labels and title
+  if(!is.null(legend.labs)){
+    if(n.strata != length(legend.labs))
+      warning("The length of legend.labs should be ", n.strata )
+    else survsummary$strata <- factor(survsummary$strata, labels = legend.labs)
+  }
+  else if(is.null(legend.labs))
+    legend.labs <- strata_names
+
+
+
+  # Adjust table y axis tick labels in case of long strata
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  yticklabs <- rev(levels(survsummary$strata))
+  n_strata <- length(levels(survsummary$strata))
+  if(!y.text) yticklabs <- rep("\\-", n_strata)
+
+  time <- strata <- label <- n.event <- cum.n.event  <- cum.n.censor<- NULL
+
+  # Ploting the cumulative number of events table
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  if(survtable == "cumevents"){
+    mapping <- ggplot2::aes(x = time, y = rev(strata),
+                   label = cum.n.event, shape = rev(strata))
+  }
+  else if (survtable == "cumcensor"){
+    mapping <- ggplot2::aes(x = time, y = rev(strata),
+                   label = cum.n.censor, shape = rev(strata))
+
+  }
+  else if (survtable == "risk.table"){
+    # risk table labels depending on the type argument
+    pct.risk <- abs_pct.risk <- n.risk <- NULL
+    llabels <- switch(risk.table.type,
+                      percentage = round(survsummary$n.risk*100/survsummary$strata_size),
+                      abs_pct = paste0(survsummary$n.risk, " (", survsummary$pct.risk, ")"),
+                      nrisk_cumcensor = paste0(survsummary$n.risk, " (", survsummary$cum.n.censor, ")"),
+                      nrisk_cumevents = paste0(survsummary$n.risk, " (", survsummary$cum.n.event, ")"),
+                      survsummary$n.risk
+    )
+    survsummary$llabels <- llabels
+    mapping <- ggplot2::aes(x = time, y = rev(strata),
+                   label = llabels, shape = rev(strata))
+
+  }
+
+
+  # Plotting survival table
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  .expand <- ggplot2::waiver()
+  # Tables labels Offset from origing
+  if(!axes.offset){
+    .expand <- c(0,0)
+    offset <- max(xlim)/30
+    survsummary <- survsummary %>%
+      dplyr::mutate(time = ifelse(time == 0, offset, time))
+  }
+
+  p <- ggplot2::ggplot(survsummary, mapping) +
+    ggplot2::scale_shape_manual(values = 1:length(levels(survsummary$strata)))+
+    ggpubr::geom_exec(ggplot2::geom_text, data = survsummary, size = fontsize, color = color, family = font.family) +
+    ggtheme +
+    ggplot2::scale_y_discrete(breaks = as.character(levels(survsummary$strata)),labels = yticklabs ) +
+    ggplot2::coord_cartesian(xlim = xlim) +
+    ggplot2::labs(title = title, x = xlab, y = ylab, color = legend.title, shape = legend.title)
+
+  if (survtable == "risk.table")
+    p <- .set_risktable_gpar(p, ...) # For backward compatibility
+
+  p <- ggpubr::ggpar(p, legend = legend, palette = palette,...)
+
+  # Customize axis ticks
+  #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+  xticklabels <- .format_xticklabels(labels = times, xscale = xscale)
+  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels, expand = .expand)
+  else p <- p + ggplot2::scale_x_continuous(breaks = times,
+                                            trans = "log10", labels = xticklabels)
+
+  p <- p + tables.theme
+
+  if(!y.text) {
+    p <- .set_large_dash_as_ytext(p)
+  }
+
+  # Color table tick labels by strata
+  if(is.logical(y.text.col) & y.text.col[1] == TRUE){
+    cols <- .extract_ggplot_colors(p, grp.levels = legend.labs)
+    p <- p + ggplot2::theme(axis.text.y = ggtext::element_markdown(colour = rev(cols)))
+  }
+  else if(is.character(y.text.col))
+    p <- p + ggplot2::theme(axis.text.y = ggtext::element_markdown(colour = rev(y.text.col)))
+
+  p
+
+}
+
+
+
+# For backward compatibility
+# Specific graphical params to risk.table
+.set_risktable_gpar <- function(p,  ...){
+  extra.params <- list(...)
+  ggpubr:::.labs(p,
+                 font.main = extra.params$font.risk.table.title,
+                 font.x = extra.params$font.risk.table.x,
+                 font.y = extra.params$font.risk.table.y,
+                 submain = extra.params$risk.table.subtitle,
+                 caption = extra.params$risk.table.caption,
+                 font.submain = extra.params$font.risk.table.subtitle,
+                 font.caption = extra.params$font.risk.table.caption)
+}