Merge pull request #43 from fungenomics/dev-bhavyaa

Enhancements to v1.2 clusters app

clusters/data/data.json

@@ -2,6 +2,14 @@
 
   "joint_mouse": [
 
+   {
+
+      "file": "all_mm10_genes.txt",
+      "path": "selin.jessa/from_hydra/atlas/data/references/all_mm10_genes.txt",
+      "description": "Names of all genes in the annotation",
+      "contents": "Plain text (.txt) file with one gene name on each line of the file"
+
+   }, 
    {
 
       "file": "ID_20190715_dendrogram_order.Rda",

clusters/functions.R

@@ -796,16 +796,20 @@ noTicks <- function() {
 
 #' Determine if a background colour is dark enough to warrant white text
 #' 
-#' @param hex_color String, colour in hex colour format e.g. #000000
+#' @param hex_color String, colour in hex colour format e.g. "#000000"
 #' 
 #' @return TRUE if the colour is dark enough (arbitrary)
 dark <- function(hex_color) {
 
+  # Store the first, third, and fifth character in the string (after "#")
   red <- substr(hex_color, 2, 2)
   green <- substr(hex_color, 4, 4)
   blue <- substr(hex_color, 6, 6)
-  dark_nums <- c(0:8)
 
+  # Output that a colour is "dark" if any of these 3 characters is an 
+  # integer between 0 and 8 inclusively. (Higher hexadecimal numbers 
+  # indicate less color e.g. #FFFFFF is white.)
+  dark_nums <- c(0:8)
   if ((red %in% dark_nums && blue %in% dark_nums) || 
       (red %in% dark_nums && green %in% dark_nums) ||
       (green %in% dark_nums && blue %in% dark_nums)) {
@@ -820,6 +824,7 @@ dark <- function(hex_color) {
 }
 
 #' Add ticks below a bar plot to categorize x axis into less granular categories
+#' (Adapted from Selin's code)
 #' 
 #' @param df Dataframe, containing the data to use
 #' [...]
@@ -878,18 +883,46 @@ add_class_ticks <- function(df, classes, height, sep, start, label_x_pos, palett
 #' Default: FALSE (i.e. check against list of dataset genes, not annotation)
 #' 
 #' @return A list of inputs that do not match the list of accepted genes
-
 check_genes <- function(user_genes, 
-                        n = 20,
+                        n = NULL,
                         annotation = FALSE) {
 
   if (!is.null(n)) {
     user_genes <- head(user_genes, n)
   } 
 
-  if (!(all(user_genes %in% genes_mouse))) {
-    return(user_genes[!(user_genes %in% genes_mouse)])
+  if(annotation){
+    check_against <- genes_anno
+  } else {
+    check_against <- genes_mouse
+  }
+
+  if (!(all(user_genes %in% check_against))) {
+    return(user_genes[!(user_genes %in% check_against)])
   } else {
     return(NULL)
   }
 }
+
+makePheatmapAnno <- function(palette, column) {
+
+  palette <- palette[unique(names(palette))]
+
+  anno_row <- data.frame(cluster = names(palette))
+  names(anno_row) <- column
+  rownames(anno_row) <- anno_row[[1]]
+  side_colors <- list(cluster = palette)
+  names(side_colors) <- column
+
+  return(list(anno_row = anno_row,
+              side_colors = side_colors))
+
+}
+
+# Code from https://stackoverflow.com/questions/61874876/get-size-of-plot-in-pixels-in-r 
+get_plot_dims <- function(heat_map)
+{
+  plot_height <- sum(sapply(heat_map$gtable$heights, grid::convertHeight, "in"))
+  plot_width  <- sum(sapply(heat_map$gtable$widths, grid::convertWidth, "in"))
+  return(list(height = plot_height, width = plot_width))
+}

clusters/global.R

@@ -10,7 +10,6 @@ library(glue)
 library(stringr)
 library(ggplot2)
 library(ggrepel)
-#library(DT)
 library(purrr)
 library(readr)
 library(shinyWidgets)
@@ -34,12 +33,28 @@ pons_palette_joint   <- readRDS("data/joint_pons/joint_pons.palette_ID_20190715_
 # Joint mouse colour palette
 load("data/joint_mouse/joint_mouse.palette_ID_20190715.Rda")
 
+# General cell type palette
+general_palette <- c("Progenitors/cyc." = "#ffaf49",
+                       "Oligodendrocytes" = "#b7dd5f",
+                       "Astrocytes" = "#00a385",
+                       "Ependymal" = "#8ee5cf",
+                       "Neurons" = "#840200",
+                       "Non-neuroect." = "gray40",
+                       "Other" = "gray60")
+
 # Vector specifying the order of clusters in the dendrogram
 load("data/joint_mouse/ID_20190715_dendrogram_order.Rda")
 
-# Load names of genes detected in mouse to provide choices in input
+# Load names of genes detected in mouse - genes for which there is data in atlas
 genes_mouse <- data.table::fread("data/joint_mouse/joint_mouse.gene_names.tsv", data.table = FALSE)$genes
 
+# Load all genes in mouse annotation - to validate input from users & provide as choices
+# Some of these genes may not have corresponding data in the atlas - 
+# i.e. genes_mouse (above) is a subset of genes_anno
+genes_anno <- data.table::fread("data/all_mm10_genes.txt", header = FALSE, data.table=FALSE)
+names(genes_anno) <- "Genes"
+genes_anno <- genes_anno[['Genes']]
+
 # ---- Shiny settings ----
 
 # Enable bookmarking