diff --git a/fun-analysisres.R b/fun-analysisres.R
index e7fbdcd..e736ebe 100644
--- a/fun-analysisres.R
+++ b/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,"
",
paste0(group1,"_Ave",valuename,":"),round(pp_wide$g1,3),"
",
paste0(group2,"_Ave",valuename,":"),round(pp_wide$g2,3),"
",
- "Difference:",round(pp_wide$diff,3))
+ "Difference:",round(pp_wide$diff,3),"
",
+ "logFC:",round(pp_wide$logFC,3),"
",
+ "P.Value:",round(pp_wide$P.Value,3),"
",
+ "adj.P.Val:",round(pp_wide$adj.P.Val,3),"
"
+ )
- tmpid = do.call(rbind,strsplit(g$data[[1]]$text,"
"))[,4]
- g$data[[1]]$text <- newtext[match(tmpid,pp_wide$unique_id)]
- tmpid = do.call(rbind,strsplit(g$data[[2]]$text,"
"))[,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,"
"))[,4]
+ g$x$data[[ii]]$text <- newtext[match(tmpid,pp_wide$unique_id)]
+ }
+ }
g
diff --git a/server-analysisres.R b/server-analysisres.R
index b19c481..2551f4b 100644
--- a/server-analysisres.R
+++ b/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,6 +95,7 @@ observe({
data_analyzed = analyzeDataReactive()
data_long = data_analyzed$data_long
geneids = data_analyzed$geneids
+ results = data_analyzed$results
@@ -101,14 +103,22 @@ observe({
# 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
})
diff --git a/ui-tab-analysisres.R b/ui-tab-analysisres.R
index c8f4443..bdb5f51 100644
--- a/ui-tab-analysisres.R
+++ b/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")