Added theme and ggplotly hover to DBBarPlot

Added compatibility for using the data.hover feature of the plotly package for the DBBarPlot function.

Also added the ability to change the theme.

Also added tutorial plots in the public data walkthrough to include the new features

R/DittoSeq.R

@@ -600,6 +600,8 @@ DBPlot <- function(var, object = DEFAULT, group.by, color.by,
 #' @param cells.use              Cells to include: either in the form of a character list of names, or a logical that is the same length as the number of cells in the object (a.k.a. *USE* in [email protected][*USE*])
 #' @param color.panel            the set of colors to draw from
 #' @param colors                 indexes / or order, of colors from color.panel to actual use
+#' @param do.hover               TRUE/FALSE. Default = F.  If set to true, object will be converted to a ggplotly object so that data about individual bars will be displayed when you hover your cursor over them.  Data displayed will be the "counts" and "percentage of total".'data.hover' argument is not used with this plotting function.
+#' @param theme                  Allows setting of a theme. Default = theme_classic() when nothing is provided.
 #' @param xlab                   "character". The text title for the x axis.  NULL/blank by default.
 #' @param ylab                   "character". The text title for the y axis.  Auto-generated by default.  Provide ylab = NULL to remove
 #' @param x.labels               Replacement x-axis labels to use instead of the identities of gorup.by
@@ -622,6 +624,7 @@ DBPlot <- function(var, object = DEFAULT, group.by, color.by,
 DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
                       cells.use = NULL,
                       color.panel = MYcolors, colors = c(1:length(color.panel)),
+                      do.hover = F, theme = theme_classic(),
                       xlab = NULL, ylab = "make", x.labels = NA, rotate.labels = TRUE,
                       y.breaks = c(0,0.5,1),
                       main = "make", sub = NULL, rename.groups = NA,
@@ -634,16 +637,24 @@ DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
     object <- deparse(substitute(object))
   }
 
+  #Establish the full list of cell/sample names
+  all.cells <-
+    if (classof(object)=="RNAseq"){
+      eval(expr = parse(text = paste0(object,"@samples")))
+    } else {
+      if(classof(object)=="seurat") {
+        eval(expr = parse(text = paste0(object,"@cell.names")))
+      }}
+
   #If cells.use = NA (was not provided), populate it to be all cells or all samples.
-  if (classof(object)=="seurat" & is.null(cells.use)) {cells.use <- eval(expr = parse(text = paste0(object,"@cell.names")))}
-  if (classof(object)=="RNAseq" & is.null(cells.use)) {cells.use <- eval(expr = parse(text = paste0(object,"@samples")))}
+  if (is.null(cells.use)) {cells.use <- all.cells}
 
   ####Retrieve metas: var, group.by
   #var to y.var
   #If name of meta in "quotes", obtain the meta
   if(length(var)==1 & typeof(var)=="character") {
     if (is.meta(var, object)){
-      y.var <- meta(var, object)
+      y.var <- as.factor(meta(var, object))
     }
   } else {y.var <- var}
   #group.by to x.var
@@ -654,24 +665,13 @@ DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
     }
   }
   #Subset the x.var and y.var to only the cells in cell.use.
-  if (classof(object)=="seurat"){
-    if (typeof(cells.use)=="logical"){
-      x.var <- as.factor(as.character(x.var[cells.use]))
-      y.var <- as.factor(as.character(y.var[cells.use]))
-    } else {
-      x.var <- x.var[eval(expr = parse(text = paste0(object,"@cell.names"))) %in% cells.use]
-      y.var <- y.var[eval(expr = parse(text = paste0(object,"@cell.names"))) %in% cells.use]
-    }
-  }
-  if (classof(object)=="RNAseq"){
     if (typeof(cells.use)=="logical"){
       x.var <- as.factor(as.character(x.var[cells.use]))
       y.var <- as.factor(as.character(y.var[cells.use]))
     } else {
-      x.var <- x.var[eval(expr = parse(text = paste0(object,"@samples"))) %in% cells.use]
-      y.var <- y.var[eval(expr = parse(text = paste0(object,"@samples"))) %in% cells.use]
+      x.var <- x.var[all.cells %in% cells.use]
+      y.var <- y.var[all.cells %in% cells.use]
     }
-  }
   #Reorder x groupings (steps 1 and 2)
   #1-Rename the x.var labels in order to set their order.
   #2-Store originals in orig.names.
@@ -682,6 +682,27 @@ DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
   orig.names <- levels(x.var)
   levels(x.var) <- reorder.x
 
+  #Groundwork for plotly hover data:
+  #Overall: if do.hover=T and data.hover has a list of genes / metas,
+  # then for all cells, make a string "var1: var1-value\nvar2: var2-value..."
+  hover.string <- NA
+  if (do.hover) {
+    features.info <- data.frame(name = rep(meta.levels(var), length(levels(x.var))),
+                                y.counts = c(sapply(levels(as.factor(x.var)), function(X)
+                                  unlist(sapply(levels(as.factor(y.var)), function(Y)
+                                    #Number of Xs that are Ys
+                                    sum(y.var==Y & x.var == X))))),
+                                y.percents = c(sapply(levels(as.factor(x.var)), function(X)
+                                  unlist(sapply(levels(as.factor(y.var)), function(Y)
+                                    #Number of Xs that are Ys, divided by the total number of Xs.
+                                    sum(y.var==Y & x.var == X)/sum(x.var == X))))))
+    names(features.info)<-c("Identity","Count","Percent of total")
+    hover.string <- sapply(1:nrow(features.info), function(row){
+      paste(as.character(sapply(1:ncol(features.info), function(col){
+        paste0(names(features.info)[col],": ",features.info[row,col])})),collapse = "\n")
+    })
+  }
+
   #Build data (Make a dataframe while calculating the percent makeup of x.var groups by y.var identities.)
   #Generate the x.grouping data (needs to be the identities of x.var each individually repeated
   # the number of times that there are distinct levels in the var / y.var.)
@@ -694,13 +715,18 @@ DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
                         #Number of Xs that are Ys, divided by the total number of Xs.
                         sum(y.var==Y & x.var == X)/sum(x.var == X)
                       ))
-                    ))
+                    )),
+                    hover.string = hover.string
   )
 
   #Build Plot
-  p <- ggplot(data=dat, aes(x = grouping)) +
+  p <- ggplot(data=dat, aes(x = grouping)) + theme +
     #Add the bars.
-    geom_col(aes(y=y.percents, fill = y.ident))
+    if(do.hover){
+      geom_col(aes(y=y.percents, fill = y.ident, text = hover.string))
+    } else {
+      geom_col(aes(y=y.percents, fill = y.ident))
+    }
   #Populate ylab if left as "make".
   if(ylab == "make"){ ylab <- paste0("Percent of ",
                                      ifelse(classof(object)=="seurat",
@@ -749,8 +775,12 @@ DBBarPlot <- function(var="ident", object = DEFAULT, group.by = "Sample",
     p <- p + scale_x_discrete(labels=orig.names[order(reorder.x)])
   }
 
-  #DONE return the plot
-  return(p)
+  #DONE. Return the plot
+  if(do.hover){
+    return(plotly::ggplotly(p, tooltip = "text"))
+  } else {
+    return(p)
+  }
 }
 
 #### multiDBPlot : a function for quickly making multiple DBPlots arranged in a grid.

Vignette/pbmc_3k_code-examples.R

@@ -225,12 +225,18 @@ DBPlot("LYZ", group.by = "Celltype", color.by = "BroadCelltype",
        labels = c("CD4 Ts", "CD8 Ts", "Bs", "NKs", "14 Monos", "FC Monos", "DCs", "Megas"))
 #We can also adjust the range and tickmarks of the y-axis
 DBPlot("LYZ", group.by = "Celltype", color.by = "BroadCelltype",
-       plots = c("vlnplot","jitter"),
+       plots = c("jitter","vlnplot"),
        y.breaks = c(0,2.5,5,7.5,10))
 #And finally, though there are also some extra tweeks I am leaving out, we can show the raw (or scaled) data as well.
 DBPlot("LYZ", group.by = "Celltype", color.by = "BroadCelltype",
-       plots = c("vlnplot","jitter"),
+       plots = c("jitter","vlnplot"),
        data.type = "raw")
+#And we can use do.hover and data.hover to select info to display about the cells if we hover the cursor over the jitter dots
+DBPlot("LYZ", group.by = "Celltype", color.by = "BroadCelltype",
+       plots = c("jitter","vlnplot"),  # Notice that ggplotly puts the jitter on top regardless of the order of plots.  I may fix this bug in a future version.
+       data.type = "raw",
+       do.hover = T, data.hover = c("LYZ","CD8A","Celltype","BroadCelltype","Sample"))
+
 
 #####- My "identity plotting function, DBBarPlot -#######
 #### AT THIS TIME, SEURAT DOES NOT HAVE THIS AT ALL #####
@@ -255,5 +261,15 @@ DBBarPlot("Celltype", group.by = "Sample",
           sub = "Pallet Town Bushes",
           xlab = "Trainers",
           x.labels = c("Ash", "Gary", "Prof Oak"))
+#And finally, we can also set do.hover = T to extract the counts/ exact percentage info from the barplot:
+DBBarPlot("Celltype", group.by = "Sample",
+          rename.groups = c("Charizards", "Vaporeons", "Sceptiles", "Zapdos", "Wartortles", "Exeggutors", "Mr. Mimes", "Jynxs"),
+          legend.title = "Pokemon",
+          ylab = "Percent of Wild Encounters",
+          main = "Encounters by Visit",
+          sub = "Pallet Town Bushes",
+          xlab = "Trainers",
+          x.labels = c("Ash", "Gary", "Prof Oak"),
+          do.hover = T) # Notice that ggplotly ignores our rename.groups change of the identity names. I may fix this bug in a future version.
 
 ## Other customizations do exist.  Check the documentation for other arguments that are not in here!