diff --git a/Rfunctions/CompPlot.R b/Rfunctions/CompPlot.R index 5f495b2d8dbc24734bc3c07fdac2686057e62e66..4192e761562a0b15317002cb8060ef404bf5e4e0 100644 --- a/Rfunctions/CompPlot.R +++ b/Rfunctions/CompPlot.R @@ -46,7 +46,7 @@ Plot_Visu_Heatmap_FC <- function(input, BaseContrast, resDiff, ContrastListDebou ############################## ## P VALUE DENSITY PLOT ############################## -Plot_pValue_Density <- function(input, BaseContrast, resDiff, ContrastListDebounce, alphaVal){ +Plot_pValue_Density <- function(input, BaseContrast, resDiff, ContrastListDebounce, alphaVal, InputpValueDensityfocus){ res = NULL #SelContrast = input$ContrastList_table_FC SelContrast = ContrastListDebounce() @@ -64,8 +64,10 @@ Plot_pValue_Density <- function(input, BaseContrast, resDiff, ContrastListDeboun data <- rbind(data, data_cont) } data$contrast <- factor(data$contrast, levels = SelContrast) - # uncomment to zoom (X axis between 0 and input$alphaVal) (use "+ xlim(0,as.numeric(alphaVal))" instead, to redraw geom_density with only data under threshold) - p <- ggplot(data, aes(x = padj, color = contrast, fill = contrast)) + geom_density(alpha = input$fillOpacity, size = input$lineWidth) + theme_minimal() #+ coord_cartesian(xlim = c(0,as.numeric(alphaVal))) + p <- ggplot(data, aes(x = padj, color = contrast, fill = contrast)) + theme_minimal() + InputpValueDensityfocus() # for reactivity + if(isolate(input$adaptBWtoFocus)){p <- p + geom_density(alpha = input$fillOpacity, size = input$lineWidth, adjust = as.numeric(alphaVal), n = 2 ^ (input$numberPoints))}else{p <- p + geom_density(alpha = input$fillOpacity, size = input$lineWidth, adjust = 1, n = 2 ^ (input$numberPoints))} + if(isolate(input$focusUnderThreshold)){p <- p + coord_cartesian(xlim = c(0,as.numeric(alphaVal)))} p <- p + theme(axis.title = element_text(size = input$FontSizepValueDensity), axis.text = element_text(size = input$FontSizepValueDensity), legend.title = element_text(size = input$FontSizepValueDensity), @@ -130,8 +132,6 @@ Plot_Comp_Logit <- function(input, BaseContrast, resDiff, SelectTaxoPlotCompDebo ylab = paste("logit p value", input$Contrast2), hover_opacity = 1, tooltip_text = row.names(padj), - # xlim = xlimits, - # ylim = ylimits, lines = if (input$showSignifThresholdsLogitPlot) { if(input$showDiagonal){ data.frame( @@ -180,8 +180,6 @@ Plot_Comp_Logit <- function(input, BaseContrast, resDiff, SelectTaxoPlotCompDebo # dom_id_reset_zoom = "scatterD3-reset-zoomLogit", # dom_id_svg_export = "scatterD3-svg-exportLogit", # menu = FALSE, - # height = input$heightVolcanoPlot, - # width=if(input$modifwidthVolcano){input$widthVolcanoPlot}, # disable_wheel = TRUE ) } @@ -219,13 +217,20 @@ Plot_Comp_Logit <- function(input, BaseContrast, resDiff, SelectTaxoPlotCompDebo ############################## Plot_Visu_Venn <- function(input,BaseContrast,resDiff, ContrastListVennDebounce, export=FALSE){ res = NULL + contrasts_without_diff = NULL #SelContrast = input$ContrastList_table_FCVenn SelContrast = ContrastListVennDebounce() if(length(SelContrast)>=2 & length(SelContrast)<=4){ - data = GetData_venn(input,SelContrast,BaseContrast,resDiff)$res + gotData = GetData_venn(input,SelContrast,BaseContrast,resDiff) + + data2 = gotData$df.tot + if(length(SelContrast) - length(colnames(data2[sapply(data2,function(x) all(is.na(x)))])) < 2){contrasts_without_diff = colnames(data2[sapply(data2,function(x) all(is.na(x)))]) + } + else{ + data = gotData$res res = venn_tooltip(d3vennR(data=data)) - } - return(res) + }} + return(list(res = res, contrasts_without_diff=contrasts_without_diff)) } ############################## @@ -234,10 +239,16 @@ Plot_Visu_Venn <- function(input,BaseContrast,resDiff, ContrastListVennDebounce, Plot_UpSet <- function(input,BaseContrast, resDiff, ContrastListDebounce, export=FALSE){ plot = NULL df = NULL + contrasts_without_diff = NULL #SelContrast = input$ContrastList_table_FC SelContrast = ContrastListDebounce() if(length(SelContrast)>=2){ - data = GetData_venn(input,SelContrast,BaseContrast,resDiff)$df.tot + gotData = GetData_venn(input,SelContrast,BaseContrast,resDiff) + data = gotData$df.tot + + if(length(SelContrast) - length(colnames(data[sapply(data,function(x) all(is.na(x)))])) < 2){contrasts_without_diff = colnames(data[sapply(data,function(x) all(is.na(x)))]) + } + else{ listInput <- list() n <- ncol(data) for(i in 1:n){ @@ -274,19 +285,27 @@ Plot_UpSet <- function(input,BaseContrast, resDiff, ContrastListDebounce, export maxRow = max(apply(df,2,FUN=function(x) length(which(!is.na(x))))) df = df[1:max(maxRow,1),] df = df[,which(apply(!is.na(df),2,any))] - } - return(list(plot=plot,table=df)) + }} + return(list(plot=plot,table=df, contrasts_without_diff=contrasts_without_diff)) } ############################## -## MULTIPLE VENN COMPAIR +## Contrasts comparison ############################## Plot_MultipleVenn <- function(input,BaseContrast, resDiff, ContrastListDebounce){ plot = NULL + contrasts_without_diff = NULL SelContrast = ContrastListDebounce() if(length(SelContrast)>=2){ - data = GetData_venn(input,SelContrast,BaseContrast,resDiff)$res_multiple_venn + gotData = GetData_venn(input,SelContrast,BaseContrast,resDiff) + + data2 = gotData$df.tot + if(length(SelContrast) - length(colnames(data2[sapply(data2,function(x) all(is.na(x)))])) < 2){contrasts_without_diff = colnames(data2[sapply(data2,function(x) all(is.na(x)))]) + } + else{ + + data = gotData$res_multiple_venn plot <- ggplot(data,aes(x=x,y=y)) + geom_point() + theme_bw() + geom_label_repel(aes(label=name), size = input$labelSizemultipleVenn) + xlim(c(0,1)) + ylim(c(0,1)) + @@ -294,8 +313,8 @@ Plot_MultipleVenn <- function(input,BaseContrast, resDiff, ContrastListDebounce) ylab(bquote(Contrast1 *intersect(Contrast2) ~ "/ Contrast2")) plot <- plot + theme(axis.title = element_text(size = input$FontSizeMultipleVenn), axis.text = element_text(size = input$FontSizeMultipleVenn - 2)) - } - return(plot) + }} + return(list(plot = plot, contrasts_without_diff=contrasts_without_diff)) } @@ -342,20 +361,17 @@ Get_log2FC_padj <-function(input,BaseContrast,resDiff, info = NULL) independentFiltering=input$IndFiltering,alpha=alpha) } log2FC = as.matrix(round(result[[SelContrast[1]]][, "log2FoldChange"], 3)) - #padj = as.matrix(round(result[[SelContrast[1]]][, "padj"], 3)) padj = as.matrix((result[[SelContrast[1]]][, "padj"])) if(nbCont>1) { for(i in 2:nbCont) { log2FC = cbind(log2FC,round(result[[SelContrast[i]]][, "log2FoldChange"], 3)) - #padj = cbind(padj,round(result[[SelContrast[i]]][, "padj"], 7)) padj = cbind(padj,(result[[SelContrast[i]]][, "padj"])) } - }# - colnames(log2FC) = names(result) - colnames(padj) = names(result) - #} + } + colnames(log2FC) = names(result) + colnames(padj) = names(result) rownames(log2FC) = rownames(result[[SelContrast[1]]]) rownames(padj) = rownames(result[[SelContrast[1]]]) @@ -429,7 +445,7 @@ venn_tooltip <- function(venn){ } -## Transform the data for the venn diagram +## Transform the data for the venn diagram and the "contrasts comparison" GetData_venn <-function(input,SelContrast,BaseContrast,resDiff) { res = list() @@ -506,7 +522,7 @@ GetData_venn <-function(input,SelContrast,BaseContrast,resDiff) } } } - # For 'Multiple Venn Compair' + # For 'Contrasts comparison' if(i!=j) { if (is.null(res_multiple_venn)) {res_multiple_venn <- data.frame(name = c(rownames_multiple_venn, paste(names.df[i],names.df[j], sep = " vs ")), diff --git a/Rfunctions/TablesPlot.R b/Rfunctions/TablesPlot.R index c173bc357400a541fd4b91d5ec5465af2ae548b7..194b4ac0853a3b1f6e18d47a6d73b07b8719cc18 100644 --- a/Rfunctions/TablesPlot.R +++ b/Rfunctions/TablesPlot.R @@ -154,13 +154,6 @@ Volcano_Plot <- function(input, data, export = FALSE) { } else{ "" }) - # labels <- - # sapply(names, function(name) - # if (is.element(name, points_to_label)) { - # name - # } else{ - # "" - # }) if(!export){ plot <- scatterD3( diff --git a/Rfunctions/VisuPlot.R b/Rfunctions/VisuPlot.R index 8496e3be65754b3c157c3fd6c0837caca8760fc2..416a2c536771eee5941bf9c73ecc72f2400d6a89 100644 --- a/Rfunctions/VisuPlot.R +++ b/Rfunctions/VisuPlot.R @@ -2,9 +2,9 @@ #@ visualisation plots of SHAMAN -########################### -## Barplot -########################### +## ## +## Barplot #### +## ## Plot_Visu_Barplot <- function(input,resDiff) { @@ -76,9 +76,9 @@ Plot_Visu_Barplot <- function(input,resDiff) - ################################## + ## ## ## Same plot in ggplot2 for export - ################################## + ## ## tax.colors=rep(c("#1f77b4","#aec7e8","#ff7f0e","#ffbb78", "#2ca02c","#98df8a","#d62728","#ff9896","#9467bd","#c5b0d5","#8c564b", "#c49c94","#e377c2","#f7b6d2","#7f7f7f", "#c7c7c7","#bcbd22","#dbdb8d","#17becf","#9edae5"),ceiling(nbKept/20)) @@ -99,9 +99,9 @@ Plot_Visu_Barplot <- function(input,resDiff) -############################## -## HEATMAP -############################## +## ## +## HEATMAP #### +## ## Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){ VarInt = input$VisuVarInt @@ -144,9 +144,9 @@ Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){ -############################## -## BOXPLOTS -############################## +## ## +## BOXPLOTS #### +## ## Plot_Visu_Boxplot <- function(input,resDiff,alpha=0.7){ gg = NULL @@ -219,9 +219,9 @@ Plot_Visu_Boxplot <- function(input,resDiff,alpha=0.7){ return(gg) } -############################## -## KRONA -############################## +## ## +## KRONA #### +## ## Plot_Visu_Krona <- function(input,resDiff,CT_OTU,taxo_table){ res = NULL @@ -256,9 +256,9 @@ Plot_Visu_Krona <- function(input,resDiff,CT_OTU,taxo_table){ return(res) } -############################## -## Phylo PLOT -############################## +## ## +## Phylo PLOT #### +## ## Plot_Visu_Phylotree = function(input, resDiff, CT_OTU, taxo_table, treeseq){ res = NULL VarInt = input$VisuVarInt @@ -296,9 +296,9 @@ Plot_Visu_Phylotree = function(input, resDiff, CT_OTU, taxo_table, treeseq){ } -############################## -## SCATTER PLOT -############################## +## ## +## SCATTER PLOT #### +## ## Plot_Visu_Scatterplot<- function(input,resDiff,export=FALSE,lmEst = FALSE,CorEst=FALSE){ plot = NULL @@ -410,9 +410,9 @@ Plot_Visu_Scatterplot<- function(input,resDiff,export=FALSE,lmEst = FALSE,CorEst -############################## -## Diversity -############################## +## ## +## Diversity #### +## ## Plot_Visu_Diversity <- function(input,resDiff,ForScatter=FALSE){ gg = NULL dataTmp = NULL @@ -528,9 +528,9 @@ Plot_Visu_Diversity <- function(input,resDiff,ForScatter=FALSE){ } -############################## -## RAREFACTION -############################## +## ## +## RAREFACTION #### +## ## Plot_Visu_Rarefaction <- function(input,resDiff,xlim,ylim,ylab="Species"){ PlotRare = NULL @@ -558,11 +558,11 @@ Plot_Visu_Rarefaction <- function(input,resDiff,xlim,ylim,ylab="Species"){ -############################################################## +## ## ## -## Useful functions +## Useful functions #### ## -############################################################## +## ## ## Get the non-zero taxo by sample TaxoNumber <- function (x, groups, mar = 1) @@ -795,9 +795,9 @@ CreateTableTree <- function(input,resDiff,CT_Norm_OTU,taxo_table,VarInt,ind_taxo -########################### +## ## ## Tree -########################### +## ## ## The count matrix must be given at the leaf level. @@ -833,9 +833,9 @@ Plot_Visu_Tree <- function(input,resDiff,CT_Norm_OTU,taxo_table) return(res) } -############################# +## ## ## NETWORK -############################# +## ## Plot_network <- function(input,resDiff,availableTaxo, ind_taxo, qualiVariable, export = FALSE){ plot = NULL @@ -864,19 +864,19 @@ Plot_network <- function(input,resDiff,availableTaxo, ind_taxo, qualiVariable, e adjacency <- matrix(mapply(function(a,b) {mapply(function(x,y){x*y}, x=a, y=b)}, a=pval_bool, b=cor_sgn), nrow = n) rownames(adjacency) <- colnames(countsMatrix) colnames(adjacency) <- colnames(countsMatrix) - # ### Remove rows and columns with only NA + # ### Remove rows and columns with only NA # this way, elements with the same count in all sample (often 0 in this case) will not appear # adjacency <- adjacency[apply(adjacency, 1, function(y) !all(is.na(y))),] # adjacency <- t(adjacency) # adjacency <- adjacency[apply(adjacency, 1, function(y) !all(is.na(y))),] # adjacency <- t(adjacency) - ### Replace NA by zeros (ie "no correlation") + ### Replace NA by zeros (ie "no correlation") # this way, those elements will appear as single nodes adjacency[is.na(adjacency)] <- 0 adjacency <- adjacency[,ind_taxo] adjacency <- adjacency[ind_taxo,] - igraphGraph <- graph_from_adjacency_matrix(adjacency, diag = FALSE, mode = "upper" , weighted = TRUE) # "upper" for adjusted p-value, lower for p-value not adjusted + igraphGraph <- graph_from_adjacency_matrix(adjacency, diag = FALSE, mode = "upper" , weighted = TRUE) # mode = "upper" for adjusted p-value, mode = "lower" for p-value not adjusted list_to_label <- isolate(input$ToLabelNetwork) dataVN <- toVisNetworkData(igraphGraph) @@ -898,7 +898,7 @@ Plot_network <- function(input,resDiff,availableTaxo, ind_taxo, qualiVariable, e plot <- visNetwork(nodes = dataVN$nodes, edges = dataVN$edges) plot <- visIgraphLayout(plot, layout = "layout_nicely", physics = FALSE, smooth = FALSE) - plot <- visNodes(plot, size = 20) #, scaling = list(label = list(min = 30, max = 30, maxVisible = 30))) + plot <- visNodes(plot, size = 20) plot <- visEdges(plot, width = 1) plot <- visOptions(plot, width = if(isolate(input$modifwidthVisu)){isolate(input$widthVisu)}, height = isolate(input$heightVisu), autoResize = FALSE) #plot <- visLegend(plot, addEdges = data.frame(color = c("red", "blue"), label = c("Positive correlation","Negative correlation"))) diff --git a/server.R b/server.R index aa54c7738042ae7a290ebd16257e1aec82a95956..a3267acff33f50078ea3808a021a1e742f0a22d1 100644 --- a/server.R +++ b/server.R @@ -2,11 +2,11 @@ shinyServer(function(input, output,session) { hide(id = "loading-content", anim = TRUE, animType = "fade",time=1.5) hide(id = "loading-content-bar", anim = TRUE, animType = "fade",time=1.5) - ##################################################### + ### ### ## - ## LOAD FILES + #### LOAD FILES #### ## - ##################################################### + ### ### @@ -519,11 +519,11 @@ shinyServer(function(input, output,session) { ## output of plot_filter is ggplot class plot_filter(counts,input$SliderThSamp,input$SliderThAb,type="Scatter") }) - ##################################################### + ### ### ## - ## DYNAMIC MENU + ## DYNAMIC MENU #### ## - ##################################################### + ### ### @@ -557,11 +557,11 @@ shinyServer(function(input, output,session) { - ##################################################### + ### ### ## - ## DATA TABLE + ## DATA TABLE #### ## - ##################################################### + ### ### ## Counts Table output$DataCounts <- DT::renderDataTable( @@ -716,11 +716,10 @@ shinyServer(function(input, output,session) { return(res) }) - ##################################################### + ### ### ## - ## TARGET FILE - ## - ##################################################### + ## TARGET FILE #### + ### ### observe({ counts = dataInput()$data$counts data = dataInput()$data$target @@ -811,11 +810,11 @@ shinyServer(function(input, output,session) { - ############################################################# + ### ### ## - ## MASQUE + ## MASQUE #### ## - ############################################################# + ### ### @@ -1187,7 +1186,7 @@ shinyServer(function(input, output,session) { htmltools::HTML('dna') ) - ##################################### + ### ### @@ -1982,6 +1981,24 @@ shinyServer(function(input, output,session) { return(res) }) + ## Run button + output$RunButton <- renderUI({ + + res = NULL + ChTM = "Error" + target = values$TargetWorking + labeled = values$labeled + CT = dataInput()$data$counts + taxo = input$TaxoSelect + VarInt = input$InterestVar + + ## Return NULL if there is no error + if(!is.null(target) && length(VarInt)>=1) ChTM = CheckTargetModel(input,target,labeled,CT)$Error + + if(!is.null(target) && taxo!="..." && is.null(ChTM) && length(VarInt)>=1) res = actionButton("RunDESeq",strong("Run analysis"),icon = icon("caret-right")) + + return(res) + }) ## Var for normalization output$SelectVarNorm <- renderUI({ @@ -2147,11 +2164,11 @@ shinyServer(function(input, output,session) { - ##################################################### + ### ### ## - ## DEFINE CONTRAST + ## DEFINE CONTRAST #### ## - ##################################################### + ### ### output$contrastMat <- renderUI({ @@ -2595,11 +2612,11 @@ shinyServer(function(input, output,session) { }, priority=1) - ##################################################### + ### ### ## - ## DESEQ2 run + ## DESEQ2 run #### ## - ##################################################### + ### ### @@ -2641,11 +2658,11 @@ shinyServer(function(input, output,session) { }) - ##################################################### + ### ### ## - ## Taxonomy + ## Taxonomy #### ## - ##################################################### + ### ### # Infobox Contrast @@ -2795,11 +2812,11 @@ shinyServer(function(input, output,session) { - ##################################################### + ### ### ## - ## Diagnostic plots + ## DIAGNOSTIC PLOTS #### ## - ##################################################### + ### ### @@ -3021,11 +3038,11 @@ shinyServer(function(input, output,session) { - ##################################################### + ### ### ## - ## EXPORT DIAG GRAPH + ## EXPORT DIAG GRAPH #### ## - ##################################################### + ### ### #### Export Diag output$exportdiag <- downloadHandler( @@ -3043,11 +3060,11 @@ shinyServer(function(input, output,session) { } ) - ##################################################### + ### ### ## - ## EXPORT VISU GRAPH + ## EXPORT VISU GRAPH #### ## - ##################################################### + ### ### #### Export Visu @@ -3091,16 +3108,16 @@ shinyServer(function(input, output,session) { if(is.na(filesize)){filesize=0} if(input$PlotVisuSelectComp=="Venn"){ - if(filesize!=0) print(Plot_Visu_Venn(input,BaseContrast,ResDiffAnal(),ContrastListVennDebounce, export=TRUE)) + if(filesize!=0) print(Plot_Visu_Venn(input,BaseContrast,ResDiffAnal(),ContrastListVennDebounce, export=TRUE)$res) } if(input$PlotVisuSelectComp=="Heatmap_comp"){ if(filesize!=0) Plot_Visu_Heatmap_FC(input,BaseContrast,ResDiffAnal(),ContrastListDebounce, SelectTaxoPlotCompDebounce, export=TRUE) } if(input$PlotVisuSelectComp=="pValueDensity"){ - if(filesize!=0) print(Plot_pValue_Density(input, BaseContrast, ResDiffAnal(), ContrastListDebounce, input$AlphaVal)) + if(filesize!=0) print(Plot_pValue_Density(input, BaseContrast, ResDiffAnal(), ContrastListDebounce, input$AlphaVal, InputpValueDensityfocus)) } if(input$PlotVisuSelectComp=="multipleVenn"){ - if(filesize!=0) print(Plot_MultipleVenn(input, BaseContrast, ResDiffAnal(), ContrastListDebounce)) + if(filesize!=0) print(Plot_MultipleVenn(input, BaseContrast, ResDiffAnal(), ContrastListDebounce)$plot) } if(input$PlotVisuSelectComp=="UpSet"){ if(filesize!=0) print(Plot_UpSet(input, BaseContrast, ResDiffAnal(), ContrastListDebounce)$plot) @@ -3133,11 +3150,11 @@ shinyServer(function(input, output,session) { ) - ##################################################### + ### ### ## - ## DIFF TABLES + ## DIFF TABLES #### ## - ##################################################### + ### ### # output$ContrastListTable <- renderUI({ @@ -3281,29 +3298,12 @@ shinyServer(function(input, output,session) { } }) - # output$TabBoxTablesPlot <- renderUI({ - # tabBox( - # id = "tabBoxPlotTables", - # width = NULL, - # selected = "Bar chart", - # tabPanel( - # "Bar chart", - # amChartsOutput("BarChartTables", height = input$heightBarChartTables) - # ), - # tabPanel( - # "Volcano plot", - # scatterD3Output("VolcanoPlot", height = input$heightVolcanoPlot, width = input$widthVolcanoPlot) - # ) - # ) - # }) - output$BarChartContainer <- renderUI({ fluidPage(amChartsOutput("BarChartTables", height = input$heightBarChartTables)) }) output$VolcanoPlotContainer <- renderUI({ - - fluidPage(scatterD3Output("VolcanoPlot", height = input$heightVolcanoPlot + 10, width=ifelse(input$modifwidthVolcano,input$widthVolcanoPlot,"100%")))#width = input$widthVolcanoPlot + 10)) + fluidPage(scatterD3Output("VolcanoPlot", height = input$heightVolcanoPlot + 10, width=ifelse(input$modifwidthVolcano,input$widthVolcanoPlot,"100%"))) }) output$BarChartTables <- renderAmCharts({ @@ -3328,10 +3328,9 @@ shinyServer(function(input, output,session) { withProgress(message = "Loading...", Volcano_Plot(input, data)) }) - ##################### - ### - ### - ################### + ### ### + ### EXPORT DIFF TABLES #### + ### ### #### Export diff table @@ -3380,34 +3379,11 @@ shinyServer(function(input, output,session) { } ) - - ## Run button - - output$RunButton <- renderUI({ - - res = NULL - ChTM = "Error" - target = values$TargetWorking - labeled = values$labeled - CT = dataInput()$data$counts - taxo = input$TaxoSelect - VarInt = input$InterestVar - - ## Return NULL if there is no error - if(!is.null(target) && length(VarInt)>=1) ChTM = CheckTargetModel(input,target,labeled,CT)$Error - - if(!is.null(target) && taxo!="..." && is.null(ChTM) && length(VarInt)>=1) res = actionButton("RunDESeq",strong("Run analysis"),icon = icon("caret-right")) - - return(res) - }) - - - - ##################################################### + ### ### ## - ## VISUALISATION + ## VISUALIZATION #### ## - ##################################################### + ### ### output$PhyloTreeMetaR2 <- renderPhyloTreeMetaR({ @@ -3500,7 +3476,7 @@ shinyServer(function(input, output,session) { if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_Visu_Scatterplot(input,resDiff,lmEst=FALSE)) }) - + ### ___Venn diagram #### output$VennD3 <- renderD3vennR({ resDiff = ResDiffAnal() ## Just for reactivity @@ -3509,10 +3485,11 @@ shinyServer(function(input, output,session) { if(is.na(filesize)){filesize=0} if(filesize!=0){ BaseContrast = read.table(namesfile,header=TRUE) - if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_Visu_Venn(input,BaseContrast,resDiff, ContrastListVennDebounce)) + if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_Visu_Venn(input,BaseContrast,resDiff, ContrastListVennDebounce)$res) } }) + ### ___Logit plot #### output$LogitPlotD3 <- renderScatterD3({ resDiff = ResDiffAnal() ## Just for reactivity ??? @@ -3525,17 +3502,18 @@ shinyServer(function(input, output,session) { } }) - + ### ___Density plot #### output$pValueDensity <- renderPlot({ resDiff = ResDiffAnal() filesize = file.info(namesfile)[,"size"] if(is.na(filesize)){filesize=0} if(filesize!=0){ BaseContrast = read.table(namesfile,header=TRUE) - if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_pValue_Density(input, BaseContrast, resDiff, ContrastListDebounce, input$AlphaVal)) + if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_pValue_Density(input, BaseContrast, resDiff, ContrastListDebounce, input$AlphaVal, InputpValueDensityfocus)) } }) + ### ___UpSet #### output$UpSet <- renderPlot({ resDiff = ResDiffAnal() filesize = file.info(namesfile)[,"size"] @@ -3546,31 +3524,54 @@ shinyServer(function(input, output,session) { } }) + ### ___Contrasts comparison #### output$multipleVennPlot <- renderPlot({ resDiff = ResDiffAnal() filesize = file.info(namesfile)[,"size"] if(is.na(filesize)){filesize=0} if(filesize!=0){ BaseContrast = read.table(namesfile,header=TRUE) - if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_MultipleVenn(input, BaseContrast, resDiff, ContrastListDebounce)) + if(!is.null(resDiff$dds)) withProgress(message="Loading...",Plot_MultipleVenn(input, BaseContrast, resDiff, ContrastListDebounce)$plot) } }) - #### + # Warning about contrasts without significant differential element (common to UpSet, Venn and Contrasts comparison) + output$contrastsNoDiff <- renderUI({ + res = NULL + resDiff = ResDiffAnal() + filesize = file.info(namesfile)[,"size"] + if(is.na(filesize)){filesize=0} + if(filesize!=0){ + BaseContrast = read.table(namesfile,header=TRUE) + if(!is.null(resDiff$dds)) { + lst <- NULL + if(input$PlotVisuSelectComp == "UpSet"){lst <- Plot_UpSet(input, BaseContrast, resDiff, ContrastListDebounce)$contrasts_without_diff} + else{if(input$PlotVisuSelectComp == "Venn"){lst <- Plot_Visu_Venn(input,BaseContrast,resDiff, ContrastListVennDebounce)$contrasts_without_diff} + else{if(input$PlotVisuSelectComp == "multipleVenn"){lst <- Plot_MultipleVenn(input, BaseContrast, resDiff, ContrastListDebounce)$contrasts_without_diff} + }} + + if(!is.null(lst)){print(lst) + res <- div(h5("The following contrasts have no significant differential element:"), div(paste(lst, sep = " ", collapse = " "), align = "center"), h5(strong("Select minimum two contrasts with differential elements.")))} + return(res)}} + }) + + #### to delay reactivity ContrastList <- reactive({ input$ContrastList_table_FC}) - ContrastListDebounce <- debounce(ContrastList, 1000) ContrastListVenn <- reactive({ input$ContrastList_table_FCVenn}) - ContrastListVennDebounce <- debounce(ContrastListVenn, 1000) SelectTaxoPlotComp <- reactive({ input$selectTaxoPlotComp}) - SelectTaxoPlotCompDebounce <- debounce(SelectTaxoPlotComp, 1000) + + InputDensityP <- reactive({ + input$adaptBWtoFocus + input$focusUnderThreshold}) + InputpValueDensityfocus <- debounce(InputDensityP, 1000) #### @@ -3760,7 +3761,7 @@ shinyServer(function(input, output,session) { return(res) }) - ##### + #### output$tooltippValueDensity <- renderUI({ hover <- input$plot_hover_pValueDensity point <- nearPoints(pValueDensityData(), hover, xvar = "x", yvar = "y", threshold = 20, maxpoints = 1) @@ -3793,11 +3794,11 @@ shinyServer(function(input, output,session) { if(filesize!=0){ BaseContrast = read.table(namesfile,header=TRUE) if(!is.null(resDiff$dds)) - {p <- Plot_pValue_Density(input, BaseContrast, resDiff, ContrastListDebounce, input$AlphaVal) + {p <- Plot_pValue_Density(input, BaseContrast, resDiff, ContrastListDebounce, input$AlphaVal, InputpValueDensityfocus) if(!is.null(p)){ data <- ggplot_build(p)$data[[1]]}} }}) - ##### + #### output$ColBoxplot <- renderUI({ @@ -3938,7 +3939,6 @@ shinyServer(function(input, output,session) { } }) - output$SelectValueQualiVar <- renderUI({ target=isolate(values$TargetWorking) if(!is.null(target)) { @@ -4297,11 +4297,11 @@ shinyServer(function(input, output,session) { # # }) - ##################################################### + ### ### ## ## KRONA ## - ##################################################### + ### ### #output$kronar <- renderTable({ # data = dataInput()$data # taxo = input$TaxoSelect @@ -4322,11 +4322,11 @@ shinyServer(function(input, output,session) { #}, sanitize.text.function = function(x) x) - ##################################################### + ### ### ## ## Disable/Enable actions ## - ##################################################### + ### ### ## Disable the actionbutton if the number of feature is lower than 2 @@ -4371,9 +4371,9 @@ shinyServer(function(input, output,session) { }) - ########### + ### ### # NETWORK - ########### + ### ### observeEvent(input$searchNode, { if(input$searchNode == "..."){visNetworkProxy("NetworkPlot") %>% visFit()} else{ @@ -4462,5 +4462,4 @@ shinyServer(function(input, output,session) { Plot_network(input,ResDiffAnal(), Available_taxo, SelectTaxoPlotNetworkDebounce(), qualiVariable)$plot %>% visSave(con) } ) - }) \ No newline at end of file diff --git a/ui.R b/ui.R index 4cb5ce153872a64cdac5b94f96f18d30ace60e5f..030ac3d7a49767abc7de3c6a7f2801991312cc1c 100644 --- a/ui.R +++ b/ui.R @@ -115,6 +115,7 @@ function(request) { ) ) ), + ### TUTORIAL #### tabItem(tabName = "Tutorial", div(style="width:100% ; max-width: 1200px", tabBox(title="How to use SHAMAN", id="tabset1", width =NULL, @@ -203,7 +204,7 @@ function(request) { "no interaction")) )) ), - + ### DOWNLOAD #### tabItem(tabName = "Download", fluidRow( column(width=9, @@ -258,6 +259,7 @@ function(request) { ) ) ), + ### RAW DATA #### #id="rawdatatab", tabItem(tabName = "RawData", tags$style(type='text/css', ".well { max-width: 20em; }"), @@ -503,7 +505,7 @@ function(request) { ) ), - + ### UPLOAD YOUR DATA #### tabItem(tabName = "Upload", tags$style(type='text/css', ".well { max-width: 20em; }"), fluidRow( @@ -597,8 +599,8 @@ function(request) { receiveSweetAlert(messageId = "ErrorRDP") ), - #### Statistical analysis - + #### STATISTICAL ANALYSIS #### + #### ___RUN DIFFERENTIAL ANALYSIS #### tabItem(tabName = "RunDiff", fluidRow( column(width=3,valueBoxOutput("RowTarget",width=NULL)), @@ -720,6 +722,7 @@ function(request) { ), + #### ___DIAGNOSTIC PLOTS #### tabItem(tabName = "DiagPlotTab", fluidRow( column(width=9, @@ -868,8 +871,10 @@ function(request) { ) ) ), + #### ___TABLES #### tabItem(tabName = "TableDiff", fluidRow( + ### _____Tables and plots #### column(width=9, div(id = "plot-container", tags$img(src = "gears.gif",id ="loading-spinner"),tags$head(tags$style(HTML(spincss))), div( @@ -892,25 +897,21 @@ function(request) { selectInput("ColumnOrder","Order by",c("Id" = "Id", "baseMean" = "baseMean", "FoldChange"="log2FoldChange", ######## "log2FoldChange"="log2FoldChange" "pvalue_adjusted"="pvalue_adjusted"), selected = "pvalue_adjusted"), checkboxInput("Decreasing","Decreasing order",value=FALSE)), + ### _____Plot options #### box(title = "Plot options", width = NULL, status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE, + ### _______both #### h5(strong("Choose colours")), fluidRow(column(width = 7, colourInput("colour1", NULL, value = "#008B00", showColour = "both")), column(width = 5, h6(strong("Down")), style='padding:0px;')), fluidRow(column(width = 7, colourInput("colour2", NULL, value = "#999999", showColour = "both")), column(width = 5, h6(strong("Not significant")), style='padding:0px;')), fluidRow(column(width = 7, colourInput("colour3", NULL, value = "#FF7F00", showColour = "both")), column(width = 5, h6(strong("Up")), style='padding:0px;')), - # fluidRow(column(width = 7, colourInput("colour1", NULL, value = "#008B00", showColour = "background", palette = "limited", allowedCols = NULL, - # returnName = FALSE)), column(width = 5, h6(strong("Down")), style='padding:0px;')), - # fluidRow(column(width = 7, colourInput("colour2", NULL, value = "#999999", showColour = "background", palette = "limited", allowedCols = NULL, - # returnName = FALSE)), column(width = 5, h6(strong("Not significant")), style='padding:0px;')), - # fluidRow(column(width = 7, colourInput("colour3", NULL, value = "#FF7F00", showColour = "background", palette = "limited", allowedCols = NULL, - # returnName = FALSE)), column(width = 5, h6(strong("Up")), style='padding:0px;')), - conditionalPanel(condition = "input.tabBoxPlotTables == 'Bar chart'", + ### _______bar chart #### + conditionalPanel(condition = "input.tabBoxPlotTables == 'Bar chart'", uiOutput("RadioButtonSelectedBarChart"), uiOutput("TaxoToPlotBarChart"), uiOutput("SetHeightBarChart"), sliderInput("fontSize", h6(strong("Font size")),min=5,max=20,value = 10)), - conditionalPanel(condition = "input.tabBoxPlotTables == 'Volcano plot'", - #uiOutput("RadioButtonSelectedVolcano"), - #h5(strong(textOutput("SelectTheToLabel"))), + ### _______volcano #### + conditionalPanel(condition = "input.tabBoxPlotTables == 'Volcano plot'", radioButtons( "SelectSpecifTaxoTablesVolcano", label = textOutput("SelectTheToLabel"), @@ -921,11 +922,6 @@ function(request) { "All" = "All" ) ), - # selectizeInput("selectTaxoLabelVolcano", - # h6(strong("Custom selection")), - # c(), - # selected = NULL, - # multiple = TRUE), uiOutput("TaxoToLabelVolcanoPlot"), checkboxInput("showSignifThresholds", "Show significance thresholds", value = TRUE), conditionalPanel(condition = "input.showSignifThresholds", sliderInput("signifThresholdsWidth", "Significance thresholds width", min = 0, max = 3, value = 1, step = 0.1), @@ -945,6 +941,7 @@ function(request) { #fluidRow(column(width = 6, sliderInput("legendFontSize", h6(strong("Legend font size")),min=50,max=200,value = 100)), # column(width = 6, sliderInput("legendWidth", h6(strong("Legend width")),min=100,max=200,value = 125))) )), + ### _____Export #### box(title = "Export", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE, fluidRow( column(width=8,selectInput("WhichExportTable", "Select the table to export",c("Significant"="Significant","Complete"="Complete","Up"="Up","Down"="Down"))), @@ -964,10 +961,12 @@ function(request) { ) ), - #### Data Viz + #### VISUALIZATION #### + #### ___GLOBAL VIEWS #### tabItem(tabName = "GlobVisu", fluidRow( + ### _____Plots #### column(width=9, tags$head(tags$style(HTML(spincss))), div(id = "plot-container", @@ -1021,19 +1020,15 @@ function(request) { ) ), - column(width=3, box(title = "Select your plot", width = NULL, status = "primary", solidHeader = TRUE,collapsible = FALSE,collapsed= FALSE, selectizeInput("PlotVisuSelect","",c("Barplot"="Barplot","Heatmap"="Heatmap","Boxplot"="Boxplot","Tree"="Tree","Scatterplot"="Scatterplot", "Network"="Network","Diversity"="Diversity","Rarefaction"="Rarefaction","Krona"="Krona"),selected = "Barplot") ), - - - ######################################################################## - ### - ### Options Visualization - ### - ######################################################################## + ### _____Options #### box(title = "Options", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= FALSE, + ## ### + ## _______common to several plots #### + ### ### conditionalPanel(condition="input.PlotVisuSelect", radioButtons("NormOrRaw",label = h5(strong("Type of counts")), c("Normalized" = "norm", "Raw" = "raw"),inline=TRUE) ), @@ -1044,13 +1039,6 @@ function(request) { ), # conditionalPanel(condition="input.PlotVisuSelect=='Tree'", # uiOutput("VarIntVisuTree")), - conditionalPanel(condition="input.PlotVisuSelect=='Scatterplot'", - uiOutput("VarIntVisuScatter"), - radioButtons("TransDataScatter","Data transformation",c("Log2 +1" = "log2","None" = "none"),inline=TRUE), - hr(), - radioButtons("CorMeth","Correlation method",c("Pearson" = "pearson", "Spearman" = "spearman"),inline=TRUE), - checkboxInput("AddRegScatter","Add regression line",FALSE) - ), conditionalPanel(condition="input.PlotVisuSelect!='Network' && input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity' && input.PlotVisuSelect!='Scatterplot' && input.PlotVisuSelect!='Krona'", radioButtons("SelectSpecifTaxo","Select the features",c("Most abundant"="Most","All"="All", "Differential features" = "Diff", "Non differential features" = "NoDiff")) ), @@ -1061,16 +1049,19 @@ function(request) { conditionalPanel(condition="input.PlotVisuSelect!='Network' && input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity' && input.PlotVisuSelect!='Scatterplot' && input.PlotVisuSelect!='Krona'", uiOutput("TaxoToPlotVisu") ), - - ################## - ## NETWORK - ################## - # conditionalPanel(condition="input.PlotVisuSelect=='Network'", - # checkboxInput("colorCorr", "Color nodes according to correlation with a variable"), - # conditionalPanel(condition = "input.colorCorr", radioButtons("quantiOrQuali",label = NULL, choices = c("Quantitative variable"="quanti","Qualitative variable"="quali"))), - # uiOutput("SelectSecVariable"), - # uiOutput("SelectValueQualiVar") - # ), + ## ### + ## _______scatterplot #### + ### ### + conditionalPanel(condition="input.PlotVisuSelect=='Scatterplot'", + uiOutput("VarIntVisuScatter"), + radioButtons("TransDataScatter","Data transformation",c("Log2 +1" = "log2","None" = "none"),inline=TRUE), + hr(), + radioButtons("CorMeth","Correlation method",c("Pearson" = "pearson", "Spearman" = "spearman"),inline=TRUE), + checkboxInput("AddRegScatter","Add regression line",FALSE) + ), + ## ### + ## _______network #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Network'", checkboxInput("colorCorr", "Color nodes according to correlation with a variable"), conditionalPanel(condition = "input.colorCorr", uiOutput("SelectSecVariable"), @@ -1086,18 +1077,18 @@ function(request) { uiOutput("SelectToLabelNetwork") ), - ################## - ## BARPLOT - ################## + ### ### + ## _______barplot #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Barplot'", hr(), selectizeInput(inputId = "CountsOrProp",label = h6(strong("Type of data")),choices = c("Proportions" = "prop", "Counts" = "counts"),selected = "prop") ), - ################## - ## HEATMAP - ################## + ### ### + ## _______heatmap #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Heatmap'", selectizeInput(inputId = "scaleHeatmap",label = h5(strong("Scale:")),choices = c("None" = "none", "Rows" = "row", "Column" = "col"),selected = "none"), radioButtons("SortHeatRow","Row Clustering:", c("Yes" ="Yes","No" = "No"),inline=TRUE), @@ -1105,17 +1096,17 @@ function(request) { ), - ################## - ## BOXPLOT - ################## + ### ### + ## _______boxplot #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Boxplot'", hr(), selectizeInput("typeDataBox",h6(strong("Type of data")),c("Log2"="Log2","Relative"="Relative")) ), - ################## - ## DIVERSITY - ################## + ### ### + ## _______diversity #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Diversity'", selectizeInput("WhichDiv",h6(strong("Diversity")),c('Alpha','Beta','Gamma','Shannon','Simpson','Inv.Simpson'),selected = c('Alpha','Shannon','Simpson','Inv.Simpson'),multiple=TRUE) ), @@ -1125,40 +1116,40 @@ function(request) { ), - ######################################################################## - ### - ### Appearance Visualization - ### - ######################################################################## + ### ### + # # + ### _____Appearance #### + # # + ### ### box(title = "Appearance", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE, sliderInput("heightVisu", h6(strong("Height")),min=100,max=4000,value = 800), checkboxInput("modifwidthVisu","Set width",value=FALSE), conditionalPanel(condition="input.modifwidthVisu", sliderInput("widthVisu", h6(strong("Width")),min=100,max=4000,value = 800)), - ################## - ## BARPLOT - ################## + ### ### + ### _______barplot #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Barplot'", sliderInput("rotateXLabel", h6(strong("Rotate X labels (Only vertical orientation)")),min=-90, max=90,value = 0, step = 5) ), - ################## - ## BOXPLOT - ################## + ### ### + ### _______boxplot #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Boxplot'", uiOutput("ColBoxplot"), radioButtons("ScaleBoxplot","Scales",c("Fixed"="fixed","Free"="free"),inline=TRUE), checkboxInput("CheckAddPointsBox","Add points",value=TRUE) ), - ################## - ## DIVERSITY - ################## + ### ### + ### _______diversity #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Diversity'", radioButtons("DivScale","Scales",c("Fixed"="fixed","Free"="free"),selected = "free",inline=TRUE), radioButtons("DivAddError","Add Error bars",c("Add"="Add","Remove"="Remove"),selected = "Add",inline=TRUE) ), - ################## - ## HEATMAP - ################## + ### ### + ### _______heatmap #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Heatmap'", selectInput("colors", label=h6(strong("Gradient of colors")),choices = c("green-blue", "blue-white-red", "purple-white-orange", "red-yellow-green"),selected = "blue-white-red") ), @@ -1175,18 +1166,18 @@ function(request) { ) ), - ################## - ## Scatterplot - ################## + ### ### + ### _______scatterplot #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Scatterplot'", fluidRow( column(width=12,sliderInput("SizeLabelScatter", h6("Label size"),min=0,max=50,value = 10,step = 1)) ) ), - ################## - ## Network plot - ################## + ### ### + ### _______network #### + ### ### conditionalPanel(condition="input.PlotVisuSelect=='Network'", fluidRow( column(width=6,sliderInput("nodeSizeNetwork", h6("Node size"),min=0,max=100,value = 20,step = 1)), @@ -1209,18 +1200,16 @@ function(request) { ) ), - ################## - ## ALL - ################## + ## ### + ## _______common to several plots #### + ### ### conditionalPanel(condition="input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Scatterplot' && input.PlotVisuSelect!='Krona' && input.PlotVisuSelect!='Phylogeny' && input.PlotVisuSelect!='Network'", radioButtons(inputId = "SensPlotVisu",label = h6(strong("Orientation")),choices = c("Vertical" = "Vertical", "Horizontal" = "Horizontal"),selected = "Vertical",inline = TRUE) ) ), + ### _____Export #### conditionalPanel(condition="input.PlotVisuSelect!='Krona' && input.PlotVisuSelect!='Phylogeny' ", box(title = "Export", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE, - ################## - ## BARPLOT - ################## conditionalPanel(condition="input.PlotVisuSelect=='Barplot'", radioButtons("positionBarPlot","Position",c("Grouped"="dodge","Stacked"="fill"), selected = "fill",inline=TRUE) ), @@ -1237,9 +1226,10 @@ function(request) { ) ) ), - + #### ___COMPARISON PLOTS #### tabItem(tabName = "CompPlot", fluidRow( + ### _____Plots #### column(width=9, uiOutput("plotVisuComp"), conditionalPanel(condition="input.PlotVisuSelectComp=='Venn'", @@ -1251,8 +1241,9 @@ function(request) { ), column(width=3, box(title = "Select your plot", width = NULL, status = "primary", solidHeader = TRUE,collapsible = FALSE,collapsed= FALSE, - selectizeInput("PlotVisuSelectComp","",c("Venn diagram"="Venn", "UpSet"="UpSet", "Contrasts compair" = "multipleVenn" ,"Heatmap"="Heatmap_comp", "Logit plot"="LogitPlot", "Density plot"="pValueDensity"),selected = "Heatmap_comp") + selectizeInput("PlotVisuSelectComp","",c("Venn diagram"="Venn", "UpSet"="UpSet", "Contrasts comparison" = "multipleVenn" ,"Heatmap"="Heatmap_comp", "Logit plot"="LogitPlot", "Density plot"="pValueDensity"),selected = "Heatmap_comp") ), + ### _____Options #### box(title = "Options", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= FALSE, conditionalPanel(condition="input.PlotVisuSelectComp=='Heatmap_comp' || input.PlotVisuSelectComp=='UpSet' || input.PlotVisuSelectComp=='pValueDensity' || input.PlotVisuSelectComp=='multipleVenn'", selectizeInput("ContrastList_table_FC","Contrasts",choices = "", multiple = TRUE)), @@ -1261,6 +1252,7 @@ function(request) { conditionalPanel(condition= "input.PlotVisuSelectComp=='Venn'", selectizeInput("ContrastList_table_FCVenn","Contrasts",choices = "", multiple = TRUE, options = list(maxItems = 4)), h6("(between 2 and 4 contrasts)", align = "right")), + uiOutput("contrastsNoDiff"), conditionalPanel(condition="input.PlotVisuSelectComp=='LogitPlot'", selectizeInput("Contrast1",h6(strong("Contrast 1 (X axis)")),choices = "", multiple = FALSE), selectizeInput("Contrast2",h6(strong("Contrast 2 (Y axis)")),choices = "", multiple = FALSE), @@ -1281,14 +1273,18 @@ function(request) { ) ), + ### ### + ### _____Appearance #### + ### ### box(title = "Appearance", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE, + ## _______common to several plots #### sliderInput("heightVisuComp", h6(strong("Height")),min=100,max=4000,value = 800), checkboxInput("modifwidthComp","Set width",FALSE), conditionalPanel(condition="input.modifwidthComp", sliderInput("widthComp", "Width",min=100,max=2500,value = 800,step =10)), - ################## - ## HEATMAP - ################## + ### ### + ## _______heatmap #### + ### ### conditionalPanel(condition="input.PlotVisuSelectComp=='Heatmap_comp'", radioButtons(inputId = "SensPlotVisuComp",label = h6(strong("Orientation")),choices = c("Vertical" = "Vertical", "Horizontal" = "Horizontal"),selected = "Vertical",inline = TRUE), @@ -1303,7 +1299,7 @@ function(request) { column(width=6,sliderInput("lowerMarginComp", h6("Lower"),min=0,max=20,value = 6,step = 1)) ) ), - ### + ## _______logit plot #### conditionalPanel(condition="input.PlotVisuSelectComp=='LogitPlot'", h5(strong("Choose colours")), fluidRow(column(width = 7, colourInput("colour01", NULL, value = "#999999", showColour = "both")), column(width = 5, h6(strong("Not significant")), style='padding:0px;')), @@ -1325,13 +1321,19 @@ function(request) { column(width = 6, sliderInput("legendWidthLogit", h6(strong("Legend width")),min=100,max=300,value = 200))) ) ), + ## _______density plot #### conditionalPanel(condition="input.PlotVisuSelectComp=='pValueDensity'", + checkboxInput("focusUnderThreshold", "Focus on interval between 0 and significance threshold", TRUE), + checkboxInput("adaptBWtoFocus", "Adapt bandwidth to interval [0 ; significance threshold]", TRUE), fluidRow(column(width = 6, sliderInput("fillOpacity", h6(strong("Opacity")), min=0, max=1, value = 0.1, step = 0.1)), column(width = 6, sliderInput("lineWidth", h6(strong("Line width")), min=0, max=5, value = 1))), - sliderInput("FontSizepValueDensity", h6(strong("Font size")), min=5,max=20,value = 13)), + fluidRow(column(width = 6, sliderInput("numberPoints", h6(strong("Sampling precision")), min=7, max=14, value = 11, step = 1)), + column(width = 6, sliderInput("FontSizepValueDensity", h6(strong("Font size")), min=5,max=20,value = 13)))), + ## _______contrasts comparison #### conditionalPanel(condition="input.PlotVisuSelectComp=='multipleVenn'", fluidRow(column(width = 6, sliderInput("labelSizemultipleVenn", h6(strong("Labels size")), min=1,max=10,value = 5)), column(width = 6, sliderInput("FontSizeMultipleVenn", h6(strong("Axes font size")), min=5,max=20,value = 13)))), + ## _______UpSet #### conditionalPanel(condition="input.PlotVisuSelectComp=='UpSet'", sliderInput("pointSizeUpSet", h6(strong("Point size")), min=3, max=10, value=5, step=0.5), fluidRow(column(width = 6, radioButtons("orderByUpset",label = "Order by",choices = c("Size of intersection" = "freq", "Degree of intersection" = "degree"),selected = "degree")), @@ -1340,6 +1342,7 @@ function(request) { checkboxInput("showNumbers", "Show values", FALSE)) ), + ### _____Export #### conditionalPanel(condition="input.PlotVisuSelectComp!='Venn'", box(title = "Export", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE,