Skip to content

GitLab

Commit 028e08ac authored by Amine GHOZLANE's avatar Amine GHOZLANE
Browse files

Treemap and bug fix from Carine

parent 22f5bb40
Hide whitespace changes
Inline Side-by-side
Rfunctions/Data_Management.R
View file @ 028e08ac
......@@ -112,6 +112,11 @@ CheckTargetModel <- function(input,target,labeled,CT)
labels = rownames(target)
ind = which(colnames(CT)%in%labels)
InterVar = input$InterestVar
uniq_column = (length(which(sapply(target[InterVar], function(x) length(unique(x))) == 1)) > 0)
uniq_column_names = names(which(sapply(target[InterVar], function(x) length(unique(x))) == 1))
## At least one variable selected
if(is.null(Error) && length(ind)<=1){
Error = "Less than two samples names fit with the counts table"
......@@ -153,7 +158,13 @@ CheckTargetModel <- function(input,target,labeled,CT)
HowTo = "Remove all the samples for which one or more variables are NA or missing"
}
## contrasts can be applied only to factors with 2 or more levels
if(is.null(Error) && (uniq_column)){
Error = "Contrasts can be applied only to factors with 2 or more levels."
HowTo = paste("Remove all variables with only one factor:", uniq_column_names, sep=" ")
}
## Full rank matrix
if(is.null(Error) && length(InterVar)>0)
......@@ -380,7 +391,6 @@ GetCountsMerge <- function(input,dataInput,taxoSelect,target,design)
if(taxoSelect=="OTU/Gene") counts = counts_annot
else{
if(input$TypeTable == "MGS" && input$FileFormat!="fileBiom"){
print("MGS")
taxoS = taxo[,input$TypeTable]
counts = aggregate(counts_annot,by=list(Taxonomy = taxoS),mean)
rownames(counts)=counts[,1]
......@@ -389,7 +399,6 @@ GetCountsMerge <- function(input,dataInput,taxoSelect,target,design)
rownames(counts_int)=rownames(counts)
colnames(counts_int)=colnames(counts)
counts=counts_int
print("end")
}
if(taxoSelect != "MGS" || input$FileFormat=="fileBiom"){
#taxoS = taxo[ordOTU,taxoSelect]
......
Rfunctions/VisuPlot.R
View file @ 028e08ac
......@@ -22,7 +22,8 @@ Plot_Visu_Barplot <- function(input,resDiff)
if(nbKept==1) namesTax = ind_taxo
dataNull = data.frame(x=c(0,0),y=c(1,2))
plotd3 = nvd3Plot(x ~ y , data = dataNull, type = "multiBarChart", id = 'barplotTaxoNyll',height = input$heightVisu,width=input$widthVisu)
plotd3 = nvd3Plot(x ~ y , data = dataNull, type = "multiBarChart", id = 'barplotTaxoNyll',height = input$heightVisu,width=if(input$modifwidthVisu){input$widthVisu})
gg = NULL
if(!is.null(counts_tmp_combined) && nrow(counts_tmp_combined)>0 && length(VarInt)>0)
......@@ -64,8 +65,16 @@ Plot_Visu_Barplot <- function(input,resDiff)
if(input$SensPlotVisu == "Vertical") Sens = "multiBarChart"
if(input$SensPlotVisu == "Horizontal") Sens = "multiBarHorizontalChart"
plotd3 <- nvd3Plot(Proportions ~ AllVar | Taxonomy, data = dataBarPlot_mat, type = Sens, id = 'barplotTaxo',height = input$heightVisu,width=input$widthVisu)
XRotate = input$rotateXLabel
plotd3 <- nvd3Plot(Proportions ~ AllVar | Taxonomy, data = dataBarPlot_mat, type = Sens, id = 'barplotTaxo', height = input$heightVisu, width=if(input$modifwidthVisu){input$widthVisu})
plotd3$chart(stacked = TRUE)
if(input$SensPlotVisu == "Vertical") {
plotd3$chart(reduceXTicks = FALSE)
plotd3$xAxis(rotateLabels = XRotate)
}
##################################
## Same plot in ggplot2 for export
......@@ -106,7 +115,7 @@ Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){
counts_tmp_combined = log2(GetDataToPlot(input,resDiff,VarInt,ind_taxo)$counts+1)
col <- switch(input$colors,
"green-blue"=colorRampPalette(brewer.pal(9,"GnBu"))(200),
"green-blue"=colorRampPalette(brewer.pal(9,"GnBu"))(256),
"blue-white-red"=colorRampPalette(rev(brewer.pal(9, "RdBu")))(200),
"purple-white-orange"=colorRampPalette(rev(brewer.pal(9, "PuOr")))(200),
"red-yellow-green"= colorRampPalette(rev(brewer.pal(9,"RdYlGn")))(200))
......@@ -114,8 +123,9 @@ Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){
## Transpose matrix if Horizontal
if(input$SensPlotVisu=="Horizontal") counts_tmp_combined = t(as.matrix(counts_tmp_combined))
if(!export) plot = d3heatmap(counts_tmp_combined, dendrogram = "none", Rowv = NA, Colv = NA, na.rm = TRUE,width = input$widthVisu, height = input$heightVisu, show_grid = FALSE, colors = col, scale = input$scaleHeatmap,cexRow = 0.6)
if(export) plot = heatmap.2(counts_tmp_combined, dendrogram = "none", Rowv = NA, Colv = NA, na.rm = TRUE, density.info="none", margins=c(12,8),trace="none",srtCol=45,col = col, scale = input$scaleHeatmap,cexRow = 0.6)
if(!export) plot = d3heatmap(counts_tmp_combined, dendrogram = "none", Rowv = (input$SortHeatRow == "Yes"), Colv = (input$SortHeatColumn == "Yes"), na.rm = TRUE, width=ifelse(input$modifwidthVisu,input$widthVisu, "100%"), height = input$heightVisu, show_grid = FALSE, colors = col, scale = input$scaleHeatmap, cexRow = input$LabelSizeHeatmap, cexCol=input$LabelSizeHeatmap, offsetCol=input$LabelColOffsetHeatmap, offsetRow=input$LabelRowOffsetHeatmap)
if(export) plot = heatmap.2(counts_tmp_combined, dendrogram = "none", Rowv = (input$SortHeatRow == "Yes"), Colv = (input$SortHeatColumn == "Yes"), na.rm = TRUE, density.info="none", margins=c(12,8),trace="none", srtCol=45, col = col, scale = input$scaleHeatmap, cexRow = input$LabelSizeHeatmap,cexCol =input$LabelSizeHeatmap, offsetCol=input$LabelColOffsetHeatmap,offsetRow=input$LabelRowOffsetHeatmap,symm=FALSE,symkey=TRUE,symbreaks=TRUE)
return(plot)
}
}
......@@ -213,7 +223,12 @@ Plot_Visu_Scatterplot<- function(input,resDiff,export=FALSE,lmEst = FALSE,CorEst
cor.pvalue = NULL
div = NULL
dds = resDiff$dds
counts = as.data.frame(round(counts(dds, normalized = TRUE)))
if(input$NormOrRaw=="norm")
{counts = as.data.frame(round(counts(dds, normalized = TRUE)))}
else
{counts = as.data.frame(round(counts(dds, normalized = FALSE)))}
target = as.data.frame(resDiff$target)
## Get the diversity values
tmp_div = Plot_Visu_Diversity(input,resDiff,ForScatter=TRUE)$dataDiv
......@@ -258,6 +273,7 @@ Plot_Visu_Scatterplot<- function(input,resDiff,export=FALSE,lmEst = FALSE,CorEst
size_lab = PointSize,
key_var = rownames(data),
height = input$heightVisu,
width=if(input$modifwidthVisu){input$widthVisu},
point_opacity = 0.7,
labels_size = input$SizeLabelScatter,
transitions = TRUE)
......@@ -430,7 +446,11 @@ Plot_Visu_Rarefaction <- function(input,resDiff,xlim,ylim,ylab="Species"){
dds = resDiff$dds
## Taxo in columns
counts = t(round(counts(dds, normalized = TRUE)))
if(input$NormOrRaw=="norm")
{counts = t(round(counts(dds, normalized = TRUE)))}
else
{counts = t(round(counts(dds, normalized = FALSE)))}
if(nrow(counts)>0 && !is.null(counts))
{
......@@ -497,7 +517,10 @@ GetDataToPlot <- function(input,resDiff,VarInt,ind_taxo,aggregate=TRUE,rarefy=FA
dds = resDiff$dds
val = c()
list.val = list()
counts = as.data.frame(round(counts(dds, normalized = TRUE)))
if(input$NormOrRaw=="norm")
{counts = as.data.frame(round(counts(dds, normalized = TRUE)))}
else
{counts = as.data.frame(round(counts(dds, normalized = FALSE)))}
if(rarefy) {set.seed(1234); counts = t(rrarefy(t(counts), min(colSums(counts))))}
target = resDiff$target
......@@ -703,7 +726,7 @@ Plot_Visu_Tree <- function(input,resDiff,CT_Norm_OTU,taxo_table)
conditions <- rownames(tmp$counts)
nodeFind = input$TaxoTree
if(input$TaxoTree=="...") nodeFind = NULL
res = treeWeightD3(merge_dat,conditions,levels,nodeFind=nodeFind, height =input$heightVisu+10)
res = treeWeightD3(merge_dat,conditions,levels,nodeFind=nodeFind, height =input$heightVisu+10, width=if(input$modifwidthVisu){input$widthVisu})
}
}
return(res)
......
server.R
View file @ 028e08ac
......@@ -445,9 +445,21 @@ shinyServer(function(input, output,session) {
if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
{
taxo = rbind(taxo,rep(NA,ncol(taxo)))
tmpPercent = round(apply(is.na(taxo),2,table)["FALSE",]/(nrow(taxo)-1)*100,2)
#tmpPercent = round(apply(is.na(taxo),2,table)["FALSE",]/(nrow(taxo)-1)*100,2)
tmp = apply(is.na(taxo),2,table)
if (class(tmp) == "list") {
tmp2 = sapply(tmp, function (x) {if (! "FALSE" %in% names(x)) {x["FALSE"] = 0} ; return(x["FALSE"])})
}
else
{
tmp2 = tmp["FALSE",]
}
tmpPercent = round(tmp2/(nrow(taxo)-1)*100,2)
#print(tmpPercent)
df <- data.frame(Label = colnames(taxo),Value = tmpPercent)
res = gvisGauge(df,options=list(min=0, max=100, greenFrom=80,
......@@ -1353,7 +1365,7 @@ shinyServer(function(input, output,session) {
resDiff = isolate(ResDiffAnal())
Plot_diag(input,resDiff)
},height = reactive(input$heightDiag))
},height = reactive(input$heightDiag), width = reactive(ifelse(input$modifwidthDiag,input$widthDiag,"auto")))
......@@ -1721,9 +1733,13 @@ shinyServer(function(input, output,session) {
output$PlotVisuTree <- renderTreeWeightD3({
resDiff = ResDiffAnal()
taxo_table = dataInput()$data$taxo
CT_Norm_OTU = dataMergeCounts()$CT_Norm
res = NULL
if(!is.null(resDiff$dds) && length(input$VisuVarInt)>=1) res = Plot_Visu_Tree(input,resDiff,CT_Norm_OTU,taxo_table)
if(!is.null(resDiff$dds) && length(input$VisuVarInt)>=1){
if(input$NormOrRaw=="norm") res = Plot_Visu_Tree(input,resDiff,dataMergeCounts()$CT_Norm,taxo_table)
else res = Plot_Visu_Tree(input,resDiff,dataMergeCounts()$CT_noNorm,taxo_table)
}
return(res)
})
......@@ -1917,14 +1933,14 @@ shinyServer(function(input, output,session) {
res=NULL
if(input$PlotVisuSelect=="Barplot") res = showOutput("PlotVisuBar")
if(input$PlotVisuSelect=="Heatmap") res = d3heatmapOutput("heatmap", height = input$heightVisu+10)
if(input$PlotVisuSelect=="Boxplot") res = plotOutput("Boxplot", height = input$heightVisu+10)
if(input$PlotVisuSelect=="Tree") res = treeWeightD3Output('PlotVisuTree', height = input$heightVisu+10,width="100%")
if(input$PlotVisuSelect=="Scatterplot" && !input$AddRegScatter) res = scatterD3Output("ScatterplotD3", height = input$heightVisu+10)
if(input$PlotVisuSelect=="Scatterplot" && input$AddRegScatter) res = plotOutput("Scatterplotgg", height = input$heightVisu+10)
if(input$PlotVisuSelect=="Diversity") res = plotOutput("DiversityPlot", height = input$heightVisu+10)
if(input$PlotVisuSelect=="Rarefaction") res = plotOutput("RarefactionPlot",dblclick = "RarefactionPlot_dblclick",brush = brushOpts(id = "RarefactionPlot_brush",resetOnNew = TRUE), height = input$heightVisu+10)
if(input$PlotVisuSelect=="Heatmap") res = d3heatmapOutput("heatmap", height = input$heightVisu+10, width=ifelse(input$modifwidthVisu,input$widthVisu,"100%"))
if(input$PlotVisuSelect=="Boxplot") res = plotOutput("Boxplot", height = input$heightVisu+10, width=if(input$modifwidthVisu){input$widthVisu})
if(input$PlotVisuSelect=="Tree") res = treeWeightD3Output('PlotVisuTree', height = input$heightVisu+10,width=ifelse(input$modifwidthVisu,input$widthVisu,"100%"))
if(input$PlotVisuSelect=="Scatterplot" && !input$AddRegScatter) res = scatterD3Output("ScatterplotD3", height = input$heightVisu+10, width=ifelse(input$modifwidthVisu,input$widthVisu,"100%"))
if(input$PlotVisuSelect=="Scatterplot" && input$AddRegScatter) res = plotOutput("Scatterplotgg", height = input$heightVisu+10,width=if(input$modifwidthVisu){input$widthVisu})
if(input$PlotVisuSelect=="Diversity") res = plotOutput("DiversityPlot", height = input$heightVisu+10, width=if(input$modifwidthVisu){input$widthVisu})
if(input$PlotVisuSelect=="Rarefaction") res = plotOutput("RarefactionPlot",dblclick = "RarefactionPlot_dblclick",brush = brushOpts(id = "RarefactionPlot_brush",resetOnNew = TRUE), height = input$heightVisu+10, width=if(input$modifwidthVisu){input$widthVisu})
return(res)
})
......@@ -1932,8 +1948,8 @@ shinyServer(function(input, output,session) {
output$plotVisuComp <- renderUI({
res=NULL
if(input$PlotVisuSelectComp=="Heatmap_comp") res = d3heatmapOutput("heatmap_comp", height = input$heightVisuComp+10)
if(input$PlotVisuSelectComp=="Venn") res = d3vennROutput("VennD3", height = input$heightVisuComp+10)
if(input$PlotVisuSelectComp=="Heatmap_comp") res = d3heatmapOutput("heatmap_comp", height = input$heightVisuComp+10, width=ifelse(input$modifwidthComp,input$widthComp,"100%"))
if(input$PlotVisuSelectComp=="Venn") res = d3vennROutput("VennD3", height = input$heightVisuComp+10, width=ifelse(input$modifwidthComp,input$widthComp,"100%"))
return(res)
})
......
ui.R
View file @ 028e08ac
......@@ -67,7 +67,7 @@ body <- dashboardBody(
tabItem(tabName = "Home",
fluidRow(
column(width=9,
div(style="width:100% ; max-width: 1200px",
div(style="width:100% ; max-width: 1200px; height: 550px",
tabBox(title="Welcome to SHAMAN", id="tabset1", width=NULL,
tabPanel("About", tags$script(type="text/javascript", language="javascript", src="google-analytics.js"),
......@@ -85,13 +85,14 @@ body <- dashboardBody(
tabPanel("Authors", h3("The main contributors to SHAMAN:"),
p(a("Stevenn Volant", href="mailto:stevenn.volant@pasteur.fr"), "(Initiator, coding, testing, documentation, evaluation)"),
p(a("Amine Ghozlane",href="mailto:amine.ghozlane@pasteur.fr"), "(Coding, testing, documentation, evaluation, packaging)"),
p(a("Hugo Varet",href="mailto:hugo.varet@pasteur.fr"), "(Coding, testing, feature suggestions)"),
p(a("Christophe Malabat",href="mailto:christophe.malabat@pasteur.fr"), "(Packaging)"),
p(a("Marie-Agnès Dillies",href="mailto:marie-agnes.dillies@pasteur.fr"), "(Evaluation)"),
p(a("Sean Kennedy",href="mailto:sean.kennedy@pasteur.fr"), "(Evaluation)"),
p("Hugo Varet", "(Coding, testing, feature suggestions)"),
p("Pierre Lechat", "(Coding, testing, feature suggestions)"),
p("Christophe Malabat", "(Packaging)"),
p("Marie-Agnès Dillies", "(Evaluation)"),
p("Sean Kennedy", "(Evaluation)"),
h3("Acknowledgements"),
p("Thanks to the following people for patches and other suggestions for improvements:"),
p(a("Pierre Lechat, ",href="mailto:pierre.lechat@pasteur.fr"),a("Julien Tap, ",href="mailto:julien.tap@danone.com"),a("Anna Zhukova, ",href="mailto:anna.zhukova@pasteur.fr"), a("Rachel Torchet",href="mailto:rachel.torchet@pasteur.fr"))
p("Carine Rey, ","Julien Tap, ","Anna Zhukova, ", "Rachel Torchet.")
),
tabPanel("Citing SHAMAN",
p("No papers about SHAMAN have been published yet, but a manuscript is in preparation.",style = "font-family: 'times'; font-si16pt"),
......@@ -102,18 +103,19 @@ body <- dashboardBody(
column(width=3,
box(
title = "What's new in SHAMAN", width = NULL, status = "primary",
div(style = 'overflow-y: scroll; max-height: 400px',
div(style = 'overflow-y: scroll; height: 550px',
addNews("Nov 22th 2016","New visualization and bug fix","We have implemented a new visualization called tree abundance. Some bugs have been fixed (thanks Carine Rey from ENS)."),
addNews("Oct 12th 2016","Filtering step and bugs fix","You can now apply a filter on the features according to their abundance
and the number of samples. Bugs on confidence intervals for the alpha diversity have been fixed"),
and the number of samples. Bugs on confidence intervals for the alpha diversity have been fixed."),
addNews("Sep 21th 2016","SHAMAN on docker","The install of SHAMAN is now available with docker.
The R install is also updated and passed in release candidate state."),
addNews("Sep 14th 2016","Download and install SHAMAN","You can install SHAMAN (beta)."),
addNews("Sep 9th 2016","PCA/PCOA","You can select the axes for the PCOA and PCA plots."),
addNews("Aug 1st 2016","Biom format","SHAMAN can now support all the Biom format versions."),
addNews("Jun 24th 2016","Comparisons plots","The venn diagram and the heatmap of foldchange
have been added to compare the results of 2 or more contrasts"),
have been added to compare the results of 2 or more contrasts."),
addNews("Jun 17th 2016","Diversity plots","Enhancement of the visualtisation of the diverties.
The shanon and inv. shanon have been added")
The shanon and inv. shanon have been added.")
)
)
)
......@@ -491,6 +493,9 @@ body <- dashboardBody(
# numericInput("NbcolSfactors", h6("Columns"),min=1,value = NA)
# ),
sliderInput("heightDiag", "Height",min=100,max=1500,value = 500,step =10),
checkboxInput("modifwidthDiag","Set width",FALSE),
conditionalPanel(condition="input.modifwidthDiag",
sliderInput("widthDiag", "Width",min=100,max=2500,value = 800,step =10)),
conditionalPanel(condition="input.DiagPlot=='clustPlot'",
h6(strong("Layout")),
......@@ -618,6 +623,9 @@ body <- dashboardBody(
###
########################################################################
box(title = "Options", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= FALSE,
conditionalPanel(condition="input.PlotVisuSelect",
radioButtons("NormOrRaw",label = h5(strong("Type of counts")), c("Normalized" = "norm", "Raw" = "raw"),inline=TRUE)
),
conditionalPanel(condition="input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Scatterplot' ",
uiOutput("VarIntVisu"),
h5(strong("Select the modalities")),
......@@ -656,7 +664,9 @@ body <- dashboardBody(
## HEATMAP
##################
conditionalPanel(condition="input.PlotVisuSelect=='Heatmap'",
selectizeInput(inputId = "scaleHeatmap",label = h6(strong("Scale:")),choices = c("None" = "none", "Rows" = "row", "Column" = "col"),selected = "none")
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),
radioButtons("SortHeatColumn","Column Clustering:", c("Yes" ="Yes","No" = "No"), inline=TRUE)
),
......@@ -687,6 +697,15 @@ body <- dashboardBody(
########################################################################
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
##################
conditionalPanel(condition="input.PlotVisuSelect=='Barplot'",
sliderInput("rotateXLabel", h6(strong("Rotate X labels (Only vertical orientation)")),min=-90, max=90,value = 0, step = 5)
),
##################
## BOXPLOT
##################
......@@ -785,7 +804,9 @@ body <- dashboardBody(
box(title = "Appearance", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE,
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
##################
......@@ -833,13 +854,7 @@ body <- dashboardBody(
a(href = "test_krona.html",target="_blank", "Click Here!")
# tableOutput("krona")
),
column(width=3,
p(strong("Tree abundance")),
img(src="Tree.png",height = 200, width = 220),
a(href = "http://genopole.pasteur.fr/SynTView/flash/TreeAbundance",target="_blank", "Click Here!")
)
)
))
#includeHTML("file:///home/aghozlan/workspace/SHAMAN_App/www/text.krona.html")
)
)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment