Skip to content
GitLab
Commit 8381410f authored by svolant's avatar svolant
Browse files

Ajout de la normalisation par groupe

parent d3182266
Hide whitespace changes
Inline Side-by-side
internal.R
View file @ 8381410f
......@@ -216,6 +216,9 @@ CheckCountsTable <- function(counts)
labels = target[,1]
ind = which(colnames(CT)%in%labels)
## Get the normalization variable (normalization can be done according to this variable)
VarNorm = input$VarNorm
if(length(ind)==length(labels))
{
if(input$TypeTable == "MGS"){
......@@ -232,20 +235,49 @@ CheckCountsTable <- function(counts)
rownames(CT_int)=rownames(CT)
colnames(CT_int)=colnames(CT)
CT=CT_int
}
else CT = CT[,ind]
} else CT = CT[,ind]
## Order CT according to the target
CT = OrderCounts(counts=CT,labels=labels)$CountsOrder
CT_noNorm = CT
RowProd = sum(apply(CT_noNorm,1,prod))
## Counts normalisation
## Create the dds object
dds <- DESeqDataSetFromMatrix(countData=CT, colData=target, design=design)
## Normalisation with or without 0
if(input$AccountForNA || RowProd==0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)),geoMeans=GeoMeansCT(CT))
if(!input$AccountForNA && RowProd!=0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)))
normFactors = sizeFactors(dds)
if(is.null(VarNorm)){
## Counts normalisation
## Normalisation with or without 0
if(input$AccountForNA || RowProd==0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)),geoMeans=GeoMeansCT(CT))
if(!input$AccountForNA && RowProd!=0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)))
normFactors = sizeFactors(dds)
} else{
group = as.data.frame(target[,VarNorm])
group = apply(group,1,paste, collapse = "-")
normFactors = c()
mod = unique(group)
## At least 2 samples are needed for the normalization
if(min(table(group))>1){
for(i in unique(group))
{
indgrp = which(group==i)
CT_tmp = CT[,indgrp]
CT_tmp = removeNulCounts(CT_tmp)
target_tmp = data.frame(labels = rownames(target)[indgrp])
dds_tmp <- DESeqDataSetFromMatrix(countData=CT_tmp, colData=target_tmp, design=~labels)
if(input$AccountForNA) dds_tmp = estimateSizeFactors(dds_tmp,locfunc=eval(as.name(input$locfunc)),geoMeans=GeoMeansCT(CT_tmp))
if(!input$AccountForNA) dds_tmp = estimateSizeFactors(dds_tmp,locfunc=eval(as.name(input$locfunc)))
normFactors[indgrp] = sizeFactors(dds_tmp)
}
} else{
if(input$AccountForNA || RowProd==0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)),geoMeans=GeoMeansCT(CT))
if(!input$AccountForNA && RowProd!=0) dds = estimateSizeFactors(dds,locfunc=eval(as.name(input$locfunc)))
normFactors = sizeFactors(dds)
}
sizeFactors(dds) = normFactors
}
## Keep normalized OTU table
CT_Norm = counts(dds, normalized=TRUE)
......@@ -898,6 +930,7 @@ CheckCountsTable <- function(counts)
{
v_tmp = rep(0,length(names))
print(names)
filesize = file.info(namesfile)[,"size"]
F1 = NULL
nameContrast = ""
......@@ -905,6 +938,8 @@ CheckCountsTable <- function(counts)
## Get the selected modalities
M1 = input$Select1_contrast
M2 = input$Select2_contrast
print(M1)
print(M2)
if(length(input$Interaction2)>0) F1 = input$Select3_contrast
## Get the name of the parameter corresponding to the modalities
......@@ -916,8 +951,11 @@ CheckCountsTable <- function(counts)
## fill the vector
ind1 = which(names%in%names1dds)
ind2 = which(names%in%names2dds)
print(ind1)
print(ind2)
if(length(ind1)>0) v_tmp[ind1] = 1
if(length(ind2)>0) v_tmp[ind2] = -1
print(v_tmp)
nameContrast = paste(M1,"_vs_",M2,sep="")
......@@ -934,11 +972,12 @@ CheckCountsTable <- function(counts)
if(length(ind2.for)>0) v_tmp[ind2.for] = -1
nameContrast = paste(nameContrast,"_for_",F1,sep="")
}
print(v_tmp)
if(filesize!=0)
{
oldContrast = read.table(namesfile,header=TRUE)
print(oldContrast)
colnamesTmp = c(colnames(oldContrast),nameContrast)
mat = cbind(oldContrast,v_tmp)
}
......
server.R
View file @ 8381410f
......@@ -458,6 +458,24 @@ shinyServer(function(input, output,session) {
})
## Var for normalization
output$SelectVarNorm <- renderUI({
target=dataInputTarget()$target
res = selectInput("VarNorm",h6(strong("Normalization by:")),NULL,multiple=TRUE)
if(!is.null(target))
{
namesTarget = colnames(target)[2:ncol(target)]
ind = which(apply(as.data.frame(target[,namesTarget]),2,is.numeric))
if(length(ind)>=1) namesTarget = namesTarget[-ind]
res = selectInput("VarNorm",h6(strong("Normalization by:")),c(NULL,namesTarget),multiple=TRUE)
}
return(res)
})
## Reference radio buttons
output$RefSelect <- renderUI({
......@@ -662,7 +680,7 @@ shinyServer(function(input, output,session) {
AddContEasy()
})
},priority=1)
AddContFromFile <-eventReactive(input$fileContrast,{
......@@ -792,7 +810,7 @@ output$InfoContrast <- renderInfoBox({
})
ModifMod_ContEasy <-eventReactive(input$Select1_contrast,{
input$RunDESeq
resDiff = ResDiffAnal()
int = input$Interaction2
target = as.data.frame(resDiff$target)
......@@ -800,7 +818,7 @@ output$InfoContrast <- renderInfoBox({
InterVar = input$InterestVar
## Get the selected variable from the selected modality
Sel_Var = InterVar[which(unlist(lapply(target[,InterVar],FUN = function(x){input$Select1_contrast%in%x})))]
Sel_Var = InterVar[which(unlist(lapply(as.data.frame(target[,InterVar]),FUN = function(x){input$Select1_contrast%in%x})))]
ModInterestCond = levels(target[,Sel_Var])
ModInterestCond = ModInterestCond[-which(ModInterestCond==input$Select1_contrast)]
......@@ -823,10 +841,10 @@ output$InfoContrast <- renderInfoBox({
InterVar = input$InterestVar
## Remove numeric variable
ind = unlist(lapply(target[,InterVar],is.numeric))
ind = unlist(lapply(as.data.frame(target[,InterVar]),is.numeric))
InterVar = InterVar[!ind]
ModInterestAll = unique(unlist(lapply(target[,InterVar],levels)))
ModInterestAll = unique(unlist(lapply(as.data.frame(target[,InterVar]),levels)))
updateSelectInput(session, "Select1_contrast",label="Compare",ModInterestAll)
})
......@@ -850,7 +868,7 @@ output$InfoContrast <- renderInfoBox({
InterVar = input$InterestVar
## Get the selected variable from the selected modality
Sel_Var = InterVar[which(unlist(lapply(target[,InterVar],FUN = function(x){input$Select1_contrast%in%x})))]
Sel_Var = InterVar[which(unlist(lapply(as.data.frame(target[,InterVar]),FUN = function(x){input$Select1_contrast%in%x})))]
## Keep only the variables in interactoin with Sel_Var
......@@ -861,11 +879,11 @@ output$InfoContrast <- renderInfoBox({
var_Inter = var_Inter[-which(var_Inter%in%Sel_Var)]
## remove if numeric
if(length(var_Inter)>1){ind = unlist(lapply(target[,var_Inter],is.numeric));var_Inter = var_Inter[!ind]}
if(length(var_Inter)>1){ind = unlist(lapply(as.data.frame(target[,var_Inter]),is.numeric));var_Inter = var_Inter[!ind]}
if(length(var_Inter)==1){ind = is.numeric(target[,var_Inter]);var_Inter = var_Inter[!ind]}
if(length(var_Inter)>=1) ModInterestFor = c("All",unique(unlist(lapply(target[,var_Inter],levels))))
if(length(var_Inter)>=1) ModInterestFor = c("All",unique(unlist(lapply(as.data.frame(target[,var_Inter]),levels))))
}
updateSelectInput(session,"Select3_contrast","For",ModInterestFor)
......
ui.R
View file @ 8381410f
......@@ -177,6 +177,8 @@ body <- dashboardBody(
column(width=7,
box(title="Options",width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed = TRUE,
p(strong("Linear model options"),Align ="center"),
hr(),
fluidRow(
column(width=3,
radioButtons("TransType",h6(strong("Type of transformation")),choices = c("VST"="VST","rlog"="rlog"))
......@@ -202,11 +204,14 @@ body <- dashboardBody(
),
column(width=3,
radioButtons("fitType",h6(strong("Relationship")),choices = c("Parametric"="parametric","Local"="local"))
),
column(width=3,checkboxInput("AccountForNA","Compute geometric mean without 0",value=TRUE))
)
# column(width=3,uiOutput("RefSelect"))
),
p(strong("Options for the normalization step"),Align ="center"),
hr(),
fluidRow(
column(width=3,checkboxInput("AccountForNA","Compute geometric mean without 0",value=TRUE)),
column(width=3,uiOutput("SelectVarNorm")),
column(width=3,
fileInput('fileSizeFactors', h6(strong('Define your own size factors')),width="100%")
),
......
Supports Markdown
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