Add downsample feature

Author: bschilder

NEWS.md

@@ -3,7 +3,14 @@
 ## Bug fixes
 * `plot_celltype_severity`: Ensure cell types are ordered by composite severity.
 * `get_ggstatsplot_stats`: Return all stats, not just specific labels.
+* `ttd_check` \ `ttd_plot` 
+  - Make % prioritised targets a percentage of the total number of rows.
+  - Fix mistake where I was including non-gene therapies too 
+    (due to how grepping collapsed listed works in data.tables).
+  - Account for situations when there's no failed targets to check.
 
+## New features
+* `validate_associations_correlate_ctd`: Add `downsample` arg to reduce plot size.
 
 # MSTExplorer 1.0.7
 

R/plot_celltype_severity.R

@@ -26,7 +26,7 @@
 #' set.seed(2025)
 #' results <- load_example_results()
 #' results <- results[sample(seq(nrow(results)), 5000),]
-#' out <- plot_celltype_severity(results, types="bar")
+#' out <- plot_celltype_severity(results, types=c("bar","dot"))
 plot_celltype_severity <- function(results,
                                    cl = get_cl(),
                                    q_threshold=.05,
@@ -64,9 +64,14 @@ plot_celltype_severity <- function(results,
                   "blindness","sensory_impairments","immunodeficiency","cancer",
                   "reduced_fertility","congenital_onset")]|>
       data.table::melt.data.table(id.vars=c("cl_id","cl_name"))
+
   )[,value:=factor(value,levels = c(0:3),ordered = TRUE)]
+
+  # Split variable names for plotting
   agg_gpt[,variable:=gsub("_"," ",variable)]
-  agg_gpt[,variable:=factor(variable, levels = unique(variable),ordered = TRUE)]
+  agg_gpt[,variable_split:=gsub(" ","\n",variable)]
+  agg_gpt[variable_split=="immunodeficiency",variable_split:="immuno-\ndeficiency"]
+  agg_gpt[,variable_split:=factor(variable_split, levels = unique(variable_split),ordered = TRUE)]
   # Set celltype name order
   agg_gpt[,cl_name:=factor(cl_name, levels = celltype_order,ordered = TRUE)]
 
@@ -80,6 +85,8 @@ plot_celltype_severity <- function(results,
   out <- list()
   if("bar" %in% types){
     messager("Creating bar plot.")
+
+    # Subplot with composite severity scores
     gg_severity <- ggplot2::ggplot(celltypes_gpt,
                                    ggplot2::aes(x=cl_name,y=severity_score_gpt,
                                                 fill=severity_score_gpt)) +
@@ -89,9 +96,11 @@ plot_celltype_severity <- function(results,
                     fill="GPT\nseverity\nscore") +
       ggplot2::coord_flip()+
       ggplot2::theme_minimal()
+
+    # Subplot with individual severity annotations
     gg_annot <- ggplot2::ggplot(agg_gpt[!is.na(value)],
                                 ggplot2::aes(x=cl_name, y=1, fill=value))+
-      ggplot2::facet_grid(.~variable, scales="free_y")+
+      ggplot2::facet_grid(.~variable_split, scales="free_y")+
       ggplot2::geom_bar(stat="identity", position="fill")+
       ggplot2::scale_fill_viridis_d(option="plasma",
                                     labels=c(`0`="never",
@@ -101,7 +110,8 @@ plot_celltype_severity <- function(results,
       ggplot2::scale_y_continuous(breaks = c(0,.5,1), labels=c("0","0.5","1")) +
       ggplot2::labs(y="Proportion of associated phenotypes", x="Cell type") +
       ggplot2::coord_flip()+
-      ggplot2::theme_minimal()
+      ggplot2::theme_minimal() +
+      ggplot2::theme(axis.text.x = ggplot2::element_text(vjust = 1) )
 
     out[["bar"]][["plot"]] <- (gg_annot | gg_severity) +
       patchwork::plot_layout(axes = "collect", widths = c(1,.1))

R/plot_density_cor.R

@@ -5,8 +5,18 @@ plot_density_cor <- function(res,
                              density_alpha=.7,
                              min_colors=15,
                              log_vars=FALSE,
+                             downsample=NULL,
                              show.legend=FALSE){
+  res <- data.table::copy(res)
   res <- res[!is.na(get(x)) & !is.na(get(y))]
+
+  ### Downsample for plotting
+  if (!is.null(downsample) && downsample < nrow(res)) {
+    downsample <- min(downsample, nrow(res))
+    messager("Downsampling to", downsample, "points.")
+    res <- res[sample(.N, downsample)]
+  }
+
   p<- res |>
     ggstatsplot::ggscatterstats(x=!!ggplot2::sym(x),
                                 y=!!ggplot2::sym(y),

R/plot_ttd.R

@@ -21,8 +21,8 @@ plot_ttd <- function(dat_sub,
                         subtitle = paste0(
                           subtitle_prefix,
                           "(",
-                            round(sum(dat_sub[prioritised==TRUE,]$n_drugs)/
-                                    sum(dat_sub$n_drugs)*100,2),
+                            round(sum(dat_sub$prioritised)/
+                                  nrow(dat_sub)*100,2),
                             "% prioritised)"
                           ),
                         width = NULL,
@@ -124,6 +124,14 @@ plot_ttd <- function(dat_sub,
                         as_percent = as_percent)
     ylims <- c(0,
                max(p1$data$n_drugs_total))
+
+    if (nrow(fail) == 0) {
+      messager("No failed therapeutics found, only plotting non-failed therapeutics.")
+      return(list(
+        plot = p1,
+        data = dat_sub
+      ))
+    }
     p2 <- plot_ttd_make(fail,
                         subtitle_prefix="Failed therapeutics\n",
                         as_percent = as_percent,
@@ -142,5 +150,8 @@ plot_ttd <- function(dat_sub,
     plt <- plot_ttd_make(dat_sub,
                          as_percent = as_percent)
   }
-  return(plt)
+  return(list(
+    plot= plt,
+    data= dat_sub
+  ))
 }

R/ttd_check.R

@@ -93,13 +93,14 @@ ttd_check <- function(top_targets,
     baseline <- dat_sub[,list(
       baseline_prop=sum(GENENAME3 %in% unique(phenotype_to_genes$gene_symbol))/.N
     ), by=c("HIGHEST_STATUS")]
+
     #### Filter by drug type ####
     if(!is.null(drug_types)){
       dat_sub <- dat_sub[
         tolower(DRUGNAME) %in% tolower(drug_types) |
-          tolower(DRUGTYPE) %in% tolower(drug_types) |
-          grepl(paste(drug_types,collapse = "|"),DRUGNAME,ignore.case = TRUE) |
-          grepl(paste(drug_types,collapse = "|"),DRUGTYPE,ignore.case = TRUE),
+          tolower(DRUGTYPE) %in% tolower(drug_types),
+          # grepl(paste(drug_types,collapse = "|"),DRUGNAME,ignore.case = TRUE) |
+          # grepl(paste(drug_types,collapse = "|"),DRUGTYPE,ignore.case = TRUE),
       ]
     }
     #### Filter by status ####
@@ -147,18 +148,18 @@ ttd_check <- function(top_targets,
                   base_size = base_size,
                   label_size = label_size)
   #### Show ####
-  if(isTRUE(show_plot)) methods::show(plt)
+  if(isTRUE(show_plot)) methods::show(plt$plot)
   #### Save ####
-  KGExplorer::plot_save(plt = plt,
+  KGExplorer::plot_save(plt = plt$plot,
                         save_path=save_path,
                         height=height,
                         width=width)
   #### Return ####
   return(
-    list(data=dat_sub,
+    list(data=plt$data,
          data_overlap=dat_sub2,
          pct_captured,
-         plot=plt,
+         plot=plt$plot,
          ttd_hypergeo_out=ttd_hypergeo_out)
   )
 }

R/validate_associations_correlate_ctd.R

@@ -6,6 +6,7 @@
 #' that contains the group variable to compare across.
 #' @param celltype_var A character string specifying the column in \code{results}
 #' that contains the cell type variable to compare across.
+#' @param downsample Downsample the data to this many points when plotting.
 #' @param ... Additional arguments passed to \code{plot_density_cor}.
 #' @inheritParams prioritise_targets
 #' @inheritParams KGExplorer::filter_dt
@@ -26,6 +27,7 @@ validate_associations_correlate_ctd <- function(results=load_example_results(),
                                                 group_var="ctd",
                                                 celltype_var="cl_name",
                                                 q_threshold=0.05,
+                                                downsample=NULL,
                                                 ...){
   test_id <- NULL;
   results <- map_celltype(results)
@@ -60,21 +62,29 @@ validate_associations_correlate_ctd <- function(results=load_example_results(),
            paste0("@FDR<",q_threshold,"."))
   #### Plot ####
   messager("Generating plots.")
+
+
+
   plots <- list()
   plots[["p.all"]] <- plot_density_cor(res2,
                                        x=paste0("p_",group_values[1]),
-                                       y=paste0("p_",group_values[2])
+                                       y=paste0("p_",group_values[2]),
+                                       downsample=downsample,
                                        )
   plots[["logFC.all"]] <- plot_density_cor(res2,
                                            x=paste0("logFC_",group_values[1]),
-                                           y=paste0("logFC_",group_values[2])
+                                           y=paste0("logFC_",group_values[2]),
+                                           downsample=downsample
                                            )
   plots[["p.significant"]] <- plot_density_cor(res_sig,
                                                x=paste0("p_",group_values[1]),
-                                               y=paste0("p_",group_values[2]))
+                                               y=paste0("p_",group_values[2]),
+                                               downsample=downsample
+                                               )
   plots[["logFC.significant"]] <- plot_density_cor(res_sig,
                                                    x=paste0("logFC_",group_values[1]),
-                                                   y=paste0("logFC_",group_values[2])
+                                                   y=paste0("logFC_",group_values[2]),
+                                                   downsample=downsample
                                                    )
   messager("Gathering statistics.")
   data_stats <- lapply(plots, get_ggstatsplot_stats)