scatterplot: color by p-value, logFC, adj p-value etc. also fix color…

… of scatterplot to be consistent.

fun-analysisres.R

@@ -79,7 +79,7 @@ rna_volcanoplot <- function(data_results, geneids=NULL,
   res$color = factor(
     res$color,
     levels = intersect(all_levels,
-                      tmplevels
+                       tmplevels
     ))
   tmplevels = levels(res$color)
 
@@ -163,7 +163,10 @@ rna_volcanoplot_ggvis <- function(data_results, geneids=NULL,
 ## Scatter plot of log2 fold changes
 ## ==================================================================================== ##  	
 
-rna_scatterplot <- function(data_long, geneids=NULL, group_sel=NULL,
+rna_scatterplot <- function(data_long, results, 
+                            results_test_name = NULL,
+                            color_result_name=NULL,
+                            geneids=NULL, group_sel=NULL,
                             valuename="log2cpm") {
   group1 = group_sel[1]; group2 = group_sel[2]
 
@@ -177,6 +180,28 @@ rna_scatterplot <- function(data_long, geneids=NULL, group_sel=NULL,
 
   colnames(pp_wide)[c(match(group1,colnames(pp_wide)),match(group2,colnames(pp_wide)))] = c("g1","g2")
   pp_wide = pp_wide%>%mutate(diff = g1-g2,color=1*(g1>=g2))
+
+  results = results%>%filter(test==results_test_name)
+  pp_wide = left_join(pp_wide,results)
+  len_nacolor = 0
+  colorname = NULL
+  if(color_result_name=="Sign of FC") color_result_name = NULL
+  color_is_factor = TRUE
+  if(!is.null(color_result_name)) {
+    tmpcolor = get(color_result_name,pp_wide)
+    len_nacolor = sum(is.na(tmpcolor))
+    colorname = color_result_name
+    color_is_factor = FALSE
+    if(len_nacolor>0) warning(paste0("Color factor has ",len_nacolor, "missing values, these genes will not appear on graph."))
+    pp_wide$color = tmpcolor
+  }
+  if(length(unique(pp_wide$color))<5) {
+    color_is_factor = TRUE
+    pp_wide$color = factor(pp_wide$color)
+  }
+
+
+
   #  pp_wide = pp_wide%>%filter(value>=valuecut[1],value<=valuecut[2])
 
   # all_values <- function(x){
@@ -198,26 +223,44 @@ rna_scatterplot <- function(data_long, geneids=NULL, group_sel=NULL,
 
   # switch to ggplotly since ggvis was slow
   p <- ggplot(pp_wide,aes(x=g1,y=g2,
-                          color=factor(color),text=unique_id))+geom_point()
-  p <- p + xlab(paste0(group1,"_Ave",valuename)) + ylab(paste0(group2,"_Ave",valuename))+
-    scale_color_manual(values=c("darkred","darkorange"))
+                          color=color,text=unique_id))+geom_point()
+  p <- p + xlab(paste0(group1,"_Ave",valuename)) + ylab(paste0(group2,"_Ave",valuename))
+
+  if(is.null(colorname)) {
+    p <- p + guides(color=FALSE)
+  }else {
+    if(color_is_factor){
+      p <- p + scale_color_manual(name=colorname)
+    }else{
+      p <- p + scale_color_continuous(name=colorname)
+    }
+  }
+
   p <- p + theme_base() + #ggtitle(paste0("Number of genes: ",nrow(pp_wide))) + 
-    theme(legend.position="none",plot.margin = unit(c(2,2,2,2), "cm"))
+    theme(plot.margin = unit(c(2,2,2,2), "cm"))
 
   g <- plotly_build(p)
 
+  if(is.null(pp_wide$adj.P.Val)) pp_wide$adj.P.Val = NA
+
   #Match order of text to proper gene order
   newtext =  paste("Gene ID:",pp_wide$unique_id,"<br>",
                    paste0(group1,"_Ave",valuename,":"),round(pp_wide$g1,3),"<br>",
                    paste0(group2,"_Ave",valuename,":"),round(pp_wide$g2,3),"<br>",
-                   "Difference:",round(pp_wide$diff,3))
+                   "Difference:",round(pp_wide$diff,3),"<br>",
+                   "logFC:",round(pp_wide$logFC,3),"<br>",
+                   "P.Value:",round(pp_wide$P.Value,3),"<br>",
+                   "adj.P.Val:",round(pp_wide$adj.P.Val,3),"<br>"
+  )
 
 
-  tmpid = do.call(rbind,strsplit(g$data[[1]]$text,"<br>"))[,4]
-  g$data[[1]]$text <- newtext[match(tmpid,pp_wide$unique_id)]
 
-  tmpid = do.call(rbind,strsplit(g$data[[2]]$text,"<br>"))[,4]
-  g$data[[2]]$text <- newtext[match(tmpid,pp_wide$unique_id)]
+  for(ii in 1:length(g$x$data)) {
+    if(!is.null(g$x$data[[ii]]$text)) {
+      tmpid = do.call(rbind,strsplit(g$x$data[[ii]]$text,"<br>"))[,4]
+      g$x$data[[ii]]$text <- newtext[match(tmpid,pp_wide$unique_id)]
+    }
+  }
 
   g
 

server-analysisres.R

@@ -43,7 +43,8 @@ observe({
 
   updateRadioButtons(session,'scattervaluename',
                      choices=sort(tmpynames,decreasing = TRUE))
-
+  updateRadioButtons(session,'scatterresultsname',
+                     choices=tmptests)
 
 })
 
@@ -74,10 +75,10 @@ observe({
                    if (names(dev.cur()) != "null device") dev.off()
                    pdf(NULL)
                    p=rna_volcanoplot(data_results = data_results,
-                                   test_sel = input$analysisres_test,
-                                   absFCcut = input$analysisres_fold_change_cut,
-                                   pvalcut = input$analysisres_pvalcut,
-                                   fdrcut = input$analysisres_fdrcut)
+                                     test_sel = input$analysisres_test,
+                                     absFCcut = input$analysisres_fold_change_cut,
+                                     pvalcut = input$analysisres_pvalcut,
+                                     fdrcut = input$analysisres_fdrcut)
 
                  })#end withProgress
 
@@ -94,21 +95,30 @@ observe({
   data_analyzed = analyzeDataReactive()
   data_long = data_analyzed$data_long
   geneids = data_analyzed$geneids
+  results = data_analyzed$results
 
 
 
   # rna_scatterplot(data_long = data_long,
   #                 group_sel = input$analysisres_groups,
   #                 valuename=input$scattervaluename)%>%
   #   bind_shiny("scatterplot_fc_2groups_ggvis","scatterplot_fc_2groups_ggvisUI")
+
+
+
   output$scatterplot <- renderPlotly({ 
     validate(need(length(input$analysisres_groups)==2,"Please select two groups."))
     withProgress(message = "Drawing scatterplot, please wait",{
       if (names(dev.cur()) != "null device") dev.off()
       pdf(NULL)
+
       p=rna_scatterplot(data_long = data_long,
-                      group_sel = input$analysisres_groups,
-                      valuename=input$scattervaluename)
+                        results = results,
+                        group_sel = input$analysisres_groups,
+                        valuename=input$scattervaluename,
+                        color_result_name = input$scattercolor,
+                        results_test_name = input$scatterresultsname
+      )
     })#end withProgress
   })
 

ui-tab-analysisres.R

@@ -41,7 +41,13 @@ tabPanel("Analysis Plots",
                             selectizeInput("analysisres_groups",label="Select Groups for Scatterplot",
                                            choices=NULL,
                                            multiple=TRUE,options = list(maxItems = 2)),
-                            radioButtons("scattervaluename",label="Select Scatterplot Value",choices="")
+                            radioButtons("scattervaluename",label="Select Scatterplot Value",choices=""),
+                            radioButtons("scattercolor",label="Select Color Factor Value",
+                                         choices=c("Sign of FC","logFC","P.Value","adj.P.Val"),
+                                         selected = "P.Value"),
+                            radioButtons("scatterresultsname",label="Select Test for Color Factor",
+                                         choices="")
+
            )#conditionalpanel
          )#,
          #img(src="KCardio_CMYK_4C_pos_small.jpg",height=150,width= 275,align="right")