Merge pull request #25 from davemcg/dev

Dev into main for 0.50

inst/app/make_dotplot.R

@@ -108,6 +108,7 @@ make_dotplot <- function(input, db, meta_filter, cat_to_color_df){
     geom_point() +
     cowplot::theme_cowplot() +
     scale_color_viridis_c(option = 'magma') +
+    geom_point() + scale_radius(range=c(0, 10)) +
     theme(axis.line  = element_blank()) +
     theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
     ylab('') + xlab('') +

inst/app/make_exp_plot.R

@@ -81,7 +81,7 @@ make_exp_plot <- function(input, db, meta_filter){
   box_data %>%
     ggplot(aes(x=Gene, y = !!as.symbol(input$exp_plot_ylab), color = !!as.symbol(grouping_features))) +
     geom_boxplot(color = 'black', outlier.shape = NA) +
-    ggbeeswarm::geom_quasirandom(aes(size = `Total Cells`), grouponX = TRUE) +
+    ggbeeswarm::geom_quasirandom(aes(size = `Total Cells`), groupOnX = TRUE) +
     cowplot::theme_cowplot() +
     theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
     scale_colour_manual(values = rep(c(pals::alphabet() %>% unname()), 20)) +

inst/app/make_facet_plot.R

@@ -3,11 +3,13 @@ make_facet_plot <- function(input, meta_filter){
   # # testing
   # input <- list()
   # input$pt_size_facet = 1
-  # input$facet <- 'organism'
-  # input$facet_color <- 'CellType'
+  # input$facet <- 'CellType_predict'
+  # input$facet_color <- 'CellType_predict'
+  # input$facet_filter_cat <- 'organism'
+  # input$facet_filter_on <- 'Homo sapiens'
   facet_column <- input$facet
   color_column <- input$facet_color
-  pt_size <- input$pt_size_facet %>% as.numeric()
+  pt_size <- input$pt_size_facet %>% as.numeric() - 1
 
 
   if (!is.null(input$facet_filter_cat)){

inst/app/make_gene_scatter_umap_plot.R

@@ -1,18 +1,18 @@
 make_gene_scatter_umap_plot <- function(input, db, mf, meta_filter){
   cat(file=stderr(), paste0(Sys.time(), ' Gene Scatter Plot Call\n'))
   gene <- input$Gene
-  tech <- input$gene_and_meta_scatter_tech
+
   pt_size <- input$pt_size_gene %>% as.numeric()
   expression_range <- input$gene_scatter_slider
-  mf <- mf %>% filter(TechType == tech)
+
   p <-  db %>% tbl('cpm') %>%
     filter(Gene == gene) %>%
     collect() %>%
     mutate(cpm = cpm - min(cpm) + 1) %>%
     filter(cpm > as.numeric(expression_range[1]),
            cpm < as.numeric(expression_range[2])) %>%
     left_join(., meta_filter, by = 'Barcode') %>%
-    filter(TechType == tech, !is.na(UMAP_1), !is.na(UMAP_2), !is.na(cpm))
+    filter(!is.na(UMAP_1), !is.na(UMAP_2), !is.na(cpm))
   cat(input$gene_filter_cat)
   cat(class(input$gene_filter_cat))
   if (!is_null(input$gene_filter_cat)){
@@ -33,12 +33,12 @@ make_gene_scatter_umap_plot <- function(input, db, mf, meta_filter){
   plot <- p %>% ggplot() +
     geom_scattermost(cbind(mf$UMAP_1, mf$UMAP_2), color = '#D3D3D333',
                      pointsize = pt_size ,
-                     pixels=c(750,750)) +
+                     pixels=c(1000,1000)) +
     geom_scattermost(cbind(p$UMAP_1, p$UMAP_2),
-                     color = viridis::magma(100, alpha=0.3)
+                     color = viridis::magma(100, alpha=0.2)
                      [1+99*(p$cpm-color_range[1])/diff(color_range)],
                      pointsize= pt_size - 1,
-                     pixels=c(750,750),
+                     pixels=c(1000,1000),
                      interpolate=FALSE) +
     geom_point(data=data.frame(x=double(0)), aes(x,x,color=x)) +
     scale_color_gradientn(  #add the manual guide for the empty aes

inst/app/make_meta_scatter_umap_plot.R

@@ -7,8 +7,8 @@ make_meta_scatter_umap_plot <- function(input, mf, meta_filter,
 ){
   cat(file=stderr(), paste0(Sys.time(), ' Meta Plot Call\n'))
   # input <- list()
-  # input[['meta_column']] <- 'CellType'
-  # input[['pt_size']] <- 1
+  # input[['meta_column']] <- 'CellType_predict'
+  # input[['pt_size_meta']] <- 1
   # input[['gene_and_meta_scatter_tech']] <- 'Droplet'
   # input[['meta_column_transform']] <- 'None'
   # input[['meta_filter_cat']] <- 'CellType_predict'
@@ -19,15 +19,6 @@ make_meta_scatter_umap_plot <- function(input, mf, meta_filter,
 
   pt_size <- input$pt_size_meta %>% as.numeric()
   filter_column <- input$meta_column
-  # cut down to match tech selected
-  tech <- input$gene_and_meta_scatter_tech
-  mf <- mf %>% filter(TechType == tech)
-  meta_filter <- meta_filter %>% filter(TechType == tech)
-  celltype_predict_labels <- celltype_predict_labels %>% filter(TechType == tech)
-  celltype_labels <- celltype_labels %>% filter(TechType == tech)
-  tabulamuris_predict_labels <- tabulamuris_predict_labels %>% filter(TechType == tech)
-  cluster_labels <- cluster_labels %>% filter(TechType == tech)
-
   if (transform == 'log2' && is.numeric(meta_filter[,meta_column] %>% pull(1))){
     cat('log2 time')
     meta_filter[,meta_column] <- log2(meta_filter[,meta_column] + 1)
@@ -60,12 +51,12 @@ make_meta_scatter_umap_plot <- function(input, mf, meta_filter,
                                               mf %>%
                                                 filter(is.na(!!as.symbol(meta_column))) %>% pull(UMAP_2)),
                                         pointsize = pt_size - 1, color = '#D3D3D333',
-                                        pixels = c(750,750)) +
+                                        pixels = c(1000,1000)) +
                        geom_scattermost(cbind(p_data$UMAP_1, p_data$UMAP_2),
-                                        color = viridis::viridis(100, alpha=0.3)
+                                        color = viridis::viridis(100, alpha=0.2)
                                         [1+99*((p_data[,meta_column] %>% pull(1))-color_range[1])/diff(color_range)],
                                         pointsize= pt_size - 1,
-                                        pixels=c(750,750),
+                                        pixels=c(1000,1000),
                                         interpolate=FALSE) +
                        geom_point(data=data.frame(x=double(0)), aes(x,x,color=x))  +
                        scale_color_gradientn(  #add the manual guide for the empty aes
@@ -103,11 +94,11 @@ make_meta_scatter_umap_plot <- function(input, mf, meta_filter,
                                               mf %>%
                                                 filter(is.na(!!as.symbol(meta_column))) %>% pull(UMAP_2)),
                                         pointsize = pt_size, color = '#D3D3D333',
-                                        pixels = c(750,750)) +
+                                        pixels = c(1000,1000)) +
                        geom_scattermost(cbind(p_data$UMAP_1, p_data$UMAP_2),
                                         color = np_color ,
                                         pointsize= pt_size,
-                                        pixels=c(750,750),
+                                        pixels=c(1000,1000),
                                         interpolate=FALSE) +
                        #geom_point(data=data.frame(x=double(0)), aes(x,x,color=x))  +
                        geom_point(data=color_data, aes(x,x,color=value)) +

inst/app/server.R

@@ -1,4 +1,5 @@
 # server.R
+# if running locally: setwd('inst/app')
 time <- Sys.time()
 cat(file = stderr(), 'Server Go!\n')
 #options(shiny.trace=TRUE)
@@ -19,22 +20,28 @@ library(stringr)
 library(shinyalert)
 library(fst)
 
-scEiaD_2020_v01 <- dbPool(drv = SQLite(), dbname = "/data1/scEiaD_2020_10_18__Mus_musculus_Macaca_fascicularis_Homo_sapiens-0-2000-counts-TabulaDroplet-batch-scVI-8-0.001-500-0.6.sqlite", idleTimeout = 3600000)
+scEiaD_2020_v01 <- dbPool(drv = SQLite(), dbname ="~/data/massive_integrated_eye_scRNA/MOARTABLES__anthology_limmaFALSE___5000-transform-counts-universe-batch-scVIprojectionSO-8-0.1-500-0.6.sqlite", idleTimeout = 3600000)
 #scEiaD_2020_v01 <- dbPool(drv = SQLite(), dbname = "/data/swamyvs/plaeApp/sql_08132020.sqlite", idleTimeout = 3600000)
-meta_filter <- read_fst('www/meta_filter.fst') %>% as_tibble()
+meta_filter <- read_fst('www/meta_filter.fst') %>%
+  as_tibble() %>%
+  mutate(CellType_predict = case_when(!is.na(TabulaMurisCellType_predict) ~ 'Tabula Muris',
+                   TRUE ~ CellType_predict)) %>%
+  mutate(UMAP_1 = UMAP_1 * -1, UMAP_2 = UMAP_2 * -1)
 # temporarily fix two issues:
 ## the well data RPCs were labelled as RPC by mistake
 ## remove the well based label "Mesenchymal/RPE/Endothelial" for now until I figure out
 ## better what this population is
-meta_filter <- meta_filter %>% mutate(CellType_predict = case_when(CellType_predict == 'RPC' ~ 'RPCs',
-                                                                   CellType_predict == 'Mesenchymal/RPE/Endothelial' ~ 'Endothelial',
-                                                                   TRUE ~ CellType_predict))
-tabulamuris_predict_labels <-scEiaD_2020_v01 %>% tbl('tabulamuris_predict_labels') %>% collect
-celltype_predict_labels <-scEiaD_2020_v01 %>% tbl('celltype_predict_labels') %>% mutate(CellType_predict = case_when(CellType_predict == 'RPC' ~ 'RPCs',
-                                                                                                                     CellType_predict == 'Mesenchymal/RPE/Endothelial' ~ 'Endothelial',
-                                                                                                                     TRUE ~ CellType_predict)) %>% collect
-celltype_labels <-scEiaD_2020_v01 %>% tbl('celltype_labels') %>% collect
-cluster_labels <-scEiaD_2020_v01 %>% tbl('cluster_labels')
+# meta_filter <- meta_filter %>% mutate(CellType_predict = case_when(CellType_predict == 'RPC' ~ 'RPCs',
+#                                                                    CellType_predict == 'Mesenchymal/RPE/Endothelial' ~ 'Endothelial',
+#                                                                    TRUE ~ CellType_predict))
+tabulamuris_predict_labels <-scEiaD_2020_v01 %>% tbl('tabulamuris_predict_labels') %>% collect %>%
+  mutate(UMAP_1 = UMAP_1 * -1, UMAP_2 = UMAP_2 * -1)
+celltype_predict_labels <-scEiaD_2020_v01 %>% tbl('celltype_predict_labels')  %>% collect %>%
+  mutate(UMAP_1 = UMAP_1 * -1, UMAP_2 = UMAP_2 * -1)
+celltype_labels <-scEiaD_2020_v01 %>% tbl('celltype_labels') %>% collect %>%
+  mutate(UMAP_1 = UMAP_1 * -1, UMAP_2 = UMAP_2 * -1)
+cluster_labels <-scEiaD_2020_v01 %>% tbl('cluster_labels') %>% collect %>%
+  mutate(UMAP_1 = UMAP_1 * -1, UMAP_2 = UMAP_2 * -1)
 mf <- meta_filter %>% sample_frac(0.2)
 
 # generate color_mappings
@@ -46,7 +53,9 @@ categorical_columns <- c("Phase","batch","study_accession","library_layout","org
 meta_filter <- meta_filter %>% mutate(SubCellType = tidyr::replace_na(SubCellType, 'None'),
                                       subcluster = as.character(subcluster))
 map_color <- function(column, meta_filter){
-  master_colorlist <- c(pals::alphabet(), pals::alphabet2())
+  #master_colorlist <- c(pals::polychrome()[3:length(pals::polychrome())], pals::alphabet2())
+  #master_colorlist <- c(pals::glasbey()[-c(3,4,8,18)],pals::alphabet2()[-c(5,7,8,9,23,24)])
+  master_colorlist <- c(pals::cols25()[1:23],pals::alphabet())
   values <- meta_filter %>% pull(!!column) %>% unique %>% sort
   if(length(values) > length(master_colorlist) ){
     r= round(length(values) / length(master_colorlist)) +1
@@ -564,15 +573,10 @@ shinyServer(function(input, output, session) {
 
     # BREAK -------
     # gene scatter plot ------------
-    if (input$gene_and_meta_scatter_tech == 'Droplet'){
-      temp_filter <- meta_filter %>% filter(TechType == 'Droplet')
-      x_range =  c(temp_filter$UMAP_1 %>% min(), temp_filter$UMAP_1 %>% max())
-      y_range = c(temp_filter$UMAP_2 %>% min(), temp_filter$UMAP_2 %>% max())
-    } else {
-      temp_filter <- meta_filter %>% filter(TechType == 'Well')
-      x_range =  c(temp_filter$UMAP_1 %>% min(), temp_filter$UMAP_1 %>% max())
-      y_range = c(temp_filter$UMAP_2 %>% min(), temp_filter$UMAP_2 %>% max())
-    }
+
+    x_range =  c(meta_filter$UMAP_1 %>% min(), meta_filter$UMAP_1 %>% max())
+    y_range = c(meta_filter$UMAP_2 %>% min(), meta_filter$UMAP_2 %>% max())
+
     gene_scatter_ranges <- reactiveValues(x = x_range,
                                           y = y_range)
     source('make_gene_scatter_umap_plot.R')
@@ -613,15 +617,10 @@ shinyServer(function(input, output, session) {
                                   cat_to_color_df
       )
     })
-    if (input$gene_and_meta_scatter_tech == 'Droplet'){
-      temp_filter <- meta_filter %>% filter(TechType == 'Droplet')
-      x_range =  c(temp_filter$UMAP_1 %>% min(), temp_filter$UMAP_1 %>% max())
-      y_range = c(temp_filter$UMAP_2 %>% min(), temp_filter$UMAP_2 %>% max())
-    } else {
-      temp_filter <- meta_filter %>% filter(TechType == 'Well')
-      x_range =  c(temp_filter$UMAP_1 %>% min(), temp_filter$UMAP_1 %>% max())
-      y_range = c(temp_filter$UMAP_2 %>% min(), temp_filter$UMAP_2 %>% max())
-    }
+
+    x_range =  c(meta_filter$UMAP_1 %>% min(), meta_filter$UMAP_1 %>% max())
+    y_range = c(meta_filter$UMAP_2 %>% min(), meta_filter$UMAP_2 %>% max())
+
     meta_ranges <- reactiveValues(x = x_range,
                                   y = y_range)
     observeEvent(input$meta_plot_dblclick, {