Merge pull request #412 from PNNL-CompBio/manuscript-figure4

Parquet handling & Figure 4 draft based on MPNST data

Author: sgosline

manuscript/coderdataResultsFunctions.R

@@ -2,13 +2,15 @@
 
 library(ggplot2)
 library(dplyr)
+library(arrow)
 library(ggridges)
 library(synapser)
 library(RColorBrewer)
 ##COLORS: standardize here
 
+models <- c('deepttc','graphdrp','lgbm','pathdsp','uno')
 modelcolors <- RColorBrewer::brewer.pal(n=6,name='RdYlBu')
-names(modelcolors) <- c('deepttc','graphdrp','lgbm','pathdsp','uno')
+names(modelcolors) <- models
 
 
 exvivo = c('mpnst','beataml','sarcpdo','pancpdo','bladderpdo','liverpdo')
@@ -67,18 +69,37 @@ getModelPerformanceData <- function(){
 }
 
 
-
-###these files are very big so i'm not sure how to deal with them.
+# this currently only retrieves one dataset at a time and returns an appache
+# "arrow" tabular dataset object that can be interacted / queried via dplyr
 getModelPredictionData <- function(dset='lgbm') {
 
-  preds <- list(deepttc = 'syn68149793', graphdrp = 'syn68146828', lgbm = 'syn68149807', pathdsp = 'syn66772452', uno = 'syn68149809')
+  preds <- list(
+    deepttc = "syn68176968",
+    graphdrp = "syn68176977",
+    lgbm = "syn68176033",
+    pathdsp = "syn68176970",
+    uno = "syn68176971"
+  )
 
-  fullres <- do.call(rbind,lapply(dset,function(mod)
-    readr::read_csv(synapser::synGet(preds[[mod]])$path) |> mutate(model = mod)))
+  dataset <- arrow::open_dataset(
+    sources = synapser::synGet(preds[[dset]])$path,
+    format = "parquet"
+    )
 
-  return(preds)
+  return(dataset)
 }
 
+###these files are very big so i'm not sure how to deal with them.
+# getModelPredictionData <- function(dset='lgbm') {
+#
+#   preds <- list(deepttc = 'syn68149793', graphdrp = 'syn68146828', lgbm = 'syn68149807', pathdsp = 'syn66772452', uno = 'syn68149809')
+#
+#   fullres <- do.call(rbind,lapply(dset,function(mod)
+#     readr::read_csv(synapser::synGet(preds[[mod]])$path) |> mutate(model = mod)))
+#
+#   return(preds)
+# }
+
 #this function plots a single metric by all the possible values
 #
 ridgelineMetricPlots <- function(metric,dataset=cdres, prefix='all'){

manuscript/figure4ExVivoResults.Rmd

@@ -14,14 +14,16 @@ First we get the packages loaded and logged into synapse.
 knitr::opts_chunk$set(echo  =  TRUE)
 library(tidyverse)
 library(ggplot2)
+library(arrow)
+library(dplyr)
+library(gridExtra)
 source('coderdataResultsFunctions.R')
-
 ```
 
 
 The data has been uploaded by natasha and can be downloaded as follows.
 
-```{r download data}
+```{r download data, eval}
 
   cdres <- getModelPerformanceData()
 
@@ -33,7 +35,7 @@ The data has been uploaded by natasha and can be downloaded as follows.
 ## Figure 4A
 
 
-```{r}
+```{r, eval=FALSE}
 metrics <- c('scc','pcc')
 exres = lapply(metrics,function(x) {
   res<-ridgelineMetricPlots(x, ecdres,'cellline')
@@ -47,7 +49,7 @@ print(exres)
 
 Now we can confirm that the datasets follow the same pattern. 
 
-```{r dataset samples}
+```{r dataset samples, eval=FALSE}
 
 
 plot<-calcSourceStatistics('scc',ecdres)
@@ -61,7 +63,107 @@ print(plot)
 ## Create funtion to dive in
 
 
+```{r}
+tgt = 'ccle'
+
+all_preds <- do.call(
+  rbind,
+  lapply(
+    models,
+    function(mdl) getModelPredictionData(dset = mdl) |>
+      dplyr::filter(target == tgt & source != tgt & source != 'beataml' & source != 'mpnst') |>
+      collect()
+    )
+  )
+```
+```{r}
+plot_panel <- function(data, title){
+  data <- sample_n(data, 10000)
+  plot <- (
+    ggplot(data, aes(x=auc_pred, y=auc_true))
+    + geom_point()
+    + geom_smooth(method=lm)
+    + facet_grid(source ~ model)
+    + ggtitle(title)
+    # + xlim(0, 1)
+    # + ylim(0, 1.25)
+  )
+}
+```
+```{r}
+all_preds <- all_preds |> mutate(auc_ranges = cut(auc_true, c(-Inf, 0.2, 0.8, Inf), labels = c('auc_true <= 0.2', '0.2 < auc_true <= 0.8', 'auc_true > 0.8')))
 
+```
 ```{r}
+ranges <- list('auc_true <= 0.2', '0.2 < auc_true <= 0.8', 'auc_true > 0.8')
+plots <- lapply(ranges, function(auc_range){
+  data <- all_preds |> filter(auc_ranges == auc_range) |> collect()
+  plot_panel(data, auc_range)
+})
+plot <- arrangeGrob(grobs = plots, ncol = 3)
+ggsave('ccle_auc_plot.pdf', plot, dpi=300, width=30, height=10)
+```
+
+Full model predictions are stored on synapse as parquet files. Individual
+datasets can be downloaded via `getModelPredictionData` in
+`coderdataResultsFunctions.R` (sources during the setup process).
+
+Here we download data from all models, subset to only MPNST target predictions
+and combine the individual subsets into one master table.
+```{r predictions data import}
+
+tgt = 'mpnst'
 
+all_preds <- do.call(
+  rbind,
+  lapply(
+    models,
+    function(mdl) getModelPredictionData(dset = mdl) |>
+      dplyr::filter(target == tgt & source != tgt & source != 'beataml') |>
+      collect()
+    )
+  )
+
+```
+
+We want to group results by drugs i.e. create a panel per drug. To that end we 
+extract the drugs and determine the "grid layout" by size of target drugs.
+```{r}
+
+drugs <- unique(all_preds$improve_chem_id)
+grid_ncol = 4
+grid_nrow = ceiling(length(drugs) / grid_ncol)
+```
+
+Defining the plot function for the individual "panels"
+```{r}
+plot_panel <- function(data, title){
+  plot <- (
+    ggplot(data, aes(x=auc_true, y=auc_pred))
+    + geom_point()
+    + geom_smooth(method=lm)
+    + facet_grid(source ~ model)
+    + ggtitle(title)
+    + xlim(0, 1)
+    + ylim(0, 1.25)
+  )
+}
+
+```
+
+```{r}
+plots <- lapply(drugs, function(drug_id){
+  data <- all_preds |> filter(improve_chem_id == drug_id) |> collect()
+  plot_panel(data, drug_id)
+})
+```
+
+```{r}
+plot <- arrangeGrob(grobs = plots, ncol = grid_ncol, nrow = grid_nrow)
+```
+
+
+```{r}
+# print(plot)
+ggsave('mpnst_auc_plot.pdf', plot, dpi=300, width=40, height=60, limitsize = FALSE)
 ```