Skip to content

GitLab

Commit 9ed59fee authored by svolant's avatar svolant
Browse files

modif workflow + check contrast file

parent 877518ae
Hide whitespace changes
Inline Side-by-side
Rfunctions/Data_Management.R
View file @ 9ed59fee
#@ This file contains all the functions needed to
#@ to load, check and transform the data
#@ to load, check, filter and transform the data
## Add news to the home page
addNews <- function(date ="",title="",text="")
......@@ -168,6 +168,25 @@ CheckTargetModel <- function(input,target,labeled,CT)
CheckContrast <- function(contrastFile,dds)
{
Error = NULL
Warning = NULL
parameterNames = resultsNames(dds)
if(is.null(contrastFile) && is.null(Error)){Error = "The format of the contrast file is not supported by SHAMAN" }
if(ncol(contrastFile)<1 && is.null(Error)){Error = "The contrast file seems to be empty" }
if(nrow(contrastFile)!=length(parameterNames) && is.null(Error)){Error = "The contrast file does not fit with the model parameters" }
if(TRUE%in%sapply(contrastFile,is.na) && is.null(Error)){Error = "NA values are considered as 0 is the counts table"; contrastFile[sapply(contrastFile,is.na)]=0}
return(list(Error=Error,Warning=Warning,contrastFile=contrastFile))
}
## Get the percentage of annotated OTU
PercentAnnot <- function(counts,taxo)
{
......@@ -491,6 +510,9 @@ Filtered_feature <- function(counts,th.samp,th.abund)
## Order the counts
plot_filter <- function(counts,th.samp,th.abund,type="Scatter")
{
......
Rfunctions/DiffTable.R
View file @ 9ed59fee
......@@ -17,7 +17,7 @@ TableDiff_print <- function(input,BaseContrast,resDiff, info = NULL)
cooksCutoff = ifelse(input$CooksCutOff!='Auto',ifelse(input$CooksCutOff!=Inf,input$CutOffVal,Inf),TRUE)
result[[input$ContrastList_table]] <- results(dds,contrast=BaseContrast[,input$ContrastList_table],pAdjustMethod=input$AdjMeth,
cooksCutoff=cooksCutoff,
independentFiltering=input$IndFiltering,alpha=alpha)
independentFiltering=input$IndFiltering,alpha=alpha,parallel = TRUE)
#names(result) <- gsub("_", " ", names(result))
if (is.null(info)) info <- data.frame(Id = rownames(result[[1]]))
......
Rfunctions/Stat_Model.R
View file @ 9ed59fee
......@@ -36,16 +36,24 @@ GetInteraction2 <- function(target,VarInt)
Get_dds_object <- function(input,counts,target,design,normFactorsOTU,CT_noNorm,CT_Norm)
{
dds <- DESeqDataSetFromMatrix(countData=counts, colData=target, design=design,ignoreRank = TRUE)
sizeFactors(dds) = normFactorsOTU
dds <- estimateDispersions(dds, fitType=input$fitType)
# dds <- estimateDispersions(dds, fitType=input$fitType)
# if(as.numeric(R.Version()$major)>=3 && as.numeric(R.Version()$minor) >=1.3){
# dds <- nbinomWaldTest(dds)
# }else{
# dds <- nbinomWaldTest(dds,modelMatrixType = "expanded")
# }
# countsNorm = counts(dds, normalized = TRUE)
if(as.numeric(R.Version()$major)>=3 && as.numeric(R.Version()$minor) >=1.3){
dds <- nbinomWaldTest(dds)
dds <- dds <- DESeq(dds,fitType=input$fitType,parallel = TRUE,minReplicatesForReplace = Inf)
}else{
dds <- nbinomWaldTest(dds,modelMatrixType = "expanded")
dds <- dds <- DESeq(dds,fitType=input$fitType,modelMatrixType = "expanded",parallel = TRUE)
}
countsNorm = counts(dds, normalized = TRUE)
#save(dds,file="dds.RData")
return(list(dds = dds,raw_counts=counts,countsNorm=countsNorm,target=target,design=design,normFactors = normFactorsOTU,CT_noNorm=CT_noNorm,CT_Norm=CT_Norm))
}
......
Rfunctions/VisuPlot.R
View file @ 9ed59fee
......@@ -235,12 +235,14 @@ Plot_Visu_Scatterplot<- function(input,resDiff,export=FALSE,lmEst = FALSE,CorEst
ColBy = input$ColorBy
PchBy = input$PchBy
PointSize = input$PointSize
x_var = if (is.null(Xvar)) NULL else data[,Xvar]
y_var = if (is.null(Yvar)) NULL else data[,Yvar]
col_var = if (ColBy== "None" || is.null(ColBy)) NULL else data[,ColBy]
symbol_var = if (PchBy == "None" || is.null(PchBy)) NULL else data[,PchBy]
size_var = if (PointSize == "None" || is.null(PointSize)) NULL else data[,PointSize]
NamesData = colnames(data)
x_var = NULL; y_var = NULL; col_var = NULL; symbol_var = NULL; size_var = NULL
if (!is.null(Xvar)) {if(Xvar%in%NamesData){x_var = data[,Xvar]}}
if (!is.null(Yvar)) {if(Yvar%in%NamesData){ y_var = data[,Yvar]}}
if (!is.null(ColBy)) {if(ColBy%in%NamesData){ col_var = data[,ColBy]}}
if (!is.null(PchBy)) {if(PchBy%in%NamesData){ symbol_var = data[,PchBy]}}
if (!is.null(PointSize)) {if(PointSize%in%NamesData){ size_var = data[,PointSize]}}
if(!export && !input$AddRegScatter && !lmEst && !CorEst && !is.null(x_var) && !is.null(y_var)){
plot = scatterD3(x = x_var,
......
server.R
View file @ 9ed59fee
......@@ -786,20 +786,28 @@ shinyServer(function(input, output,session) {
AddContFromFile <-eventReactive(input$fileContrast,{
res = ReadContrastFile()
createdCont = NULL
filesize = file.info(namesfile)[,"size"]
if(is.na(filesize)){filesize=0}
if(filesize!=0){ createdCont = read.table(namesfile,header=TRUE) }
resDiff = ResDiffAnal()
dds = resDiff$dds
CheckCont = CheckContrast(res,dds)
if(!is.null(res))
{
if(!is.null(createdCont)) res = cbind(res,createdCont)
updateSelectInput(session, "ContrastList","Contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table","Contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",colnames(res))
write.table(res,namesfile,row.names=FALSE)
if(is.null(CheckCont$Error))
{
res = CheckCont$contrastFile
createdCont = NULL
if(!is.null(res))
{
filesize = file.info(namesfile)[,"size"]
if(is.na(filesize)){filesize=0}
if(filesize!=0){ createdCont = read.table(namesfile,header=TRUE) }
if(!is.null(createdCont)) res = cbind(res,createdCont)
updateSelectInput(session, "ContrastList","Contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table","Contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_Visu","For which contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_VisuComp","For which contrasts",colnames(res))
updateSelectInput(session, "ContrastList_table_FC","Contrasts (Min = 2)",colnames(res))
write.table(res,namesfile,row.names=FALSE)
}
}
})
......@@ -867,26 +875,60 @@ shinyServer(function(input, output,session) {
input$RemoveContrast
input$fileContrast
resDiff = ResDiffAnal()
dds = resDiff$dds
res=NULL
tmpFile = NULL
if(!is.null(resDiff)){
res = infoBox("Contrasts", subtitle = h6("At least one contrast (non null) must be defined"), icon = icon("warning"),color = "light-blue",width=NULL,fill=TRUE)
test = FALSE
filesize = isolate(file.info(namesfile)[,"size"])
filesize = isolate(file.info(namesfile)[,"size"])
if(is.na(filesize)){filesize=0}
if(filesize!=0)
if(filesize!=0) tmpFile = read.table(namesfile,header=TRUE)
if(!is.null(tmpFile))
{
tmp = read.table(namesfile,header=TRUE)
if(any(as.vector(tmp)!=0)) test = TRUE
}
CheckCont = CheckContrast(tmpFile,dds)
if(!is.null(CheckCont$Warning)) res = infoBox(h6(strong("Contrasts")), subtitle = h6(CheckCont$Warning), icon = icon("warning"),color = "orange",width=NULL,fill=TRUE)
if(!is.null(CheckCont$Error)) res = infoBox(h6(strong("Contrasts")), subtitle = h6(CheckCont$Error), icon = icon("thumbs-o-down"),color = "red",width=NULL,fill=TRUE)
if(is.null(CheckCont$Error) && is.null(CheckCont$Warning)) res = infoBox("Contrasts", subtitle = h6("Contrasts OK"), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
if(test) res = infoBox("Contrasts", subtitle = h6("Contrasts OK"), icon = icon("thumbs-o-up"),color = "green",width=NULL,fill=TRUE)
}
## if user load a bad contrast file after having define one or more good contrasts
# if(!is.null(input$fileContrast)){
# tmpRead = ReadContrastFile()
# CheckCont_new = CheckContrast(tmpRead,dds)
# if(!is.null(CheckCont_new$Warning)) info("test1")
# if(!is.null(CheckCont_new$Error)) info("test2")
# }
}
return(res)
})
# Infobox Contrast
output$InfoContrast_box <- renderUI({
resDiff = ResDiffAnal()
dds = resDiff$dds
if(!is.null(resDiff)){
if(!is.null(input$fileContrast)){
tmpRead = ReadContrastFile()
CheckCont_new = CheckContrast(tmpRead,dds)
if(!is.null(CheckCont_new$Warning)){
box(title = "Warning", status = "warning",width = NULL,
h6(strong(CheckCont_new$Warning)))
}
if(!is.null(CheckCont_new$Error)){
box(title = "Warning", status = "warning",width = NULL,
h6(strong(CheckCont_new$Error)))
}
}
}
})
output$contrastBox <- renderUI({
......@@ -1011,8 +1053,11 @@ shinyServer(function(input, output,session) {
{
box(title="Contrasts (advanced user)",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = FALSE,
fluidRow(
column(width=12,
fileInput('fileContrast', h6(strong('Select a file of contrasts')),width="60%")
column(width=9,
fileInput('fileContrast', h6(strong('Select a file of contrasts')),width="80%")
),
column(width=3,
column(width=12,selectInput("sepContFile", h6(strong("Separator:")), c("Tab" = "\t", "Comma" = ",", "Semicolon" = ";","Space"= " "),selected = " "))
),
hr(),
column(width=12,h6(strong("Define contrasts by yourself"))),
......@@ -1054,7 +1099,7 @@ shinyServer(function(input, output,session) {
if (is.null(inFile)) return(NULL)
res = read.csv(inFile$datapath,sep=" ",header=TRUE)
try(read.csv(inFile$datapath,header=TRUE,sep=input$sepContFile)->res,silent=T)
return(res)
})
......@@ -1186,13 +1231,14 @@ shinyServer(function(input, output,session) {
## Return NULL if there is no error
if(!is.null(target)) ChTM = CheckTargetModel(input,target,labeled,CT)
print(ChTM$Error)
if(!is.null(ChTM$Error)) {
print("OK")
box(title = "Error", status = "danger",width = 6,
h6(strong(ChTM$Error)),
footer = em("Reminder: Your target file must contain at least 2 columns and 2 rows. NA's values are not allowed and the variables must not be collinear.")
)
}
} else return(NULL)
})
......@@ -2091,11 +2137,18 @@ shinyServer(function(input, output,session) {
## Get numeric variables from target
typesTarget = sapply(target,class)
numInd = (typesTarget=="numeric")[2:ncol(target)]
Available_x = list(x1 = c(sort(rownames(counts))),"Diversity" = c("Alpha div","Shannon div","Inv.Simpson div","Simpson div"))
names(Available_x)[1] = taxo
if(any(numInd)) Available_x$Variables = namesTarget[numInd]
## Using list slows down the application if the number of rows too high
if(nrow(counts)<300)
{
Available_x = list(x1 = c(sort(rownames(counts))),"Diversity" = c("Alpha div","Shannon div","Inv.Simpson div","Simpson div"))
names(Available_x)[1] = taxo
if(any(numInd)) Available_x$Variables = namesTarget[numInd]
} else{
Available_x = c(sort(rownames(counts)),"Alpha div","Shannon div","Inv.Simpson div","Simpson div")
if(any(numInd)) Available_x = c(Available_x,namesTarget[numInd])
}
Available_y = Available_x
res[[1]] = selectizeInput("Xscatter",h6(strong("X variable")),Available_x, selected = Available_x[1],multiple = FALSE)
res[[2]] = selectizeInput("Yscatter",h6(strong("Y variable")),Available_y, selected = Available_x[2],multiple = FALSE)
res[[3]] = selectizeInput("ColorBy",h6(strong("Color variable")),c("None"="None",namesTarget[!numInd]),multiple = FALSE)
......
ui.R
View file @ 9ed59fee
......@@ -83,7 +83,7 @@ body <- dashboardBody(
A presentation about SHAMAN is available", a("here",target="_blank",href="shaman_presentation.pdf")," and a poster", a("here.",target="_blank",href="shaman_poster.pdf"), br(),
"SHAMAN is compatible with standard formats for metagenomic analysis. We also provide a complete pipeline for OTU picking and annotation named",a("MASQUE", href="https://github.com/aghozlane/masque") ,"used in production at Institut Pasteur.",style = "font-family: 'times'; font-si16pt"),
p("Hereafter is the global workflow of the SHAMAN application:"),
div(img(src = "Workflow.png",width = "100%",style="max-width: 600px"),Align="center")
div(img(src = "Workflow_sh.png",width = "100%",height = "100%",style="max-width: 800px;"),Align="center")
),
tabPanel("Authors", h3("The main contributors to SHAMAN:"),
p(a("Stevenn Volant", href="mailto:stevenn.volant@pasteur.fr"), "(Initiator, coding, testing, documentation, evaluation)"),
......@@ -332,9 +332,9 @@ body <- dashboardBody(
uiOutput("BoxTarget"),
uiOutput("BoxCountsMerge")
),
column(width=7,
box(title="Options",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = TRUE,
box(title="Options",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = TRUE,
tabBox(title="", id="tabsetOption", width=NULL,
tabPanel("Statistical model",
fluidRow(
......@@ -402,18 +402,23 @@ body <- dashboardBody(
)
)
)
),
fluidRow(
column(width=8,
uiOutput("contrastBox"),
uiOutput("contrastBoxAdvanced")
),
column(width=4,
uiOutput("contrastDefined")
)
)
),
fluidRow(
column(width=8,
uiOutput("contrastBox"),
uiOutput("contrastBoxAdvanced")
),
column(width=4,
uiOutput("contrastDefined"),
uiOutput("InfoContrast_box")
)
)
)
)
),
tabItem(tabName = "DiagPlotTab",
fluidRow(
......
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