Commit 3846c773 authored by svolant's avatar svolant
Browse files

correction bug CAH + export heatmap

parent 399e3cdb
...@@ -510,6 +510,8 @@ GetCountsMerge <- function(input,dataInput,taxoSelect,target,design) ...@@ -510,6 +510,8 @@ GetCountsMerge <- function(input,dataInput,taxoSelect,target,design)
## Create the dds object ## Create the dds object
dds <- DESeqDataSetFromMatrix(countData=CT, colData=target, design=design,ignoreRank=TRUE) dds <- DESeqDataSetFromMatrix(countData=CT, colData=target, design=design,ignoreRank=TRUE)
print(head(CT))
print(GeoMeansCT(CT))
#save(dds,file="testdds.RData") #save(dds,file="testdds.RData")
if(is.null(VarNorm)){ if(is.null(VarNorm)){
## Counts normalisation ## Counts normalisation
......
...@@ -93,60 +93,63 @@ Perma_test_Diag <- function(input,resDiff,tree) ...@@ -93,60 +93,63 @@ Perma_test_Diag <- function(input,resDiff,tree)
## Hierarchical clustering ## Hierarchical clustering
HCPlot <- function (input,dds,group,type.trans,counts,CT,tree,col = c("lightblue", "orange", "MediumVioletRed", "SpringGreen")) HCPlot <- function (input,dds,group,type.trans=NULL,counts=NULL,CT,tree,col = c("lightblue", "orange", "MediumVioletRed", "SpringGreen"))
{ {
res = NULL res = NULL
if(!is.null(dds) && !is.null(counts) && !is.null(type.trans) && !is.null(input$DistClust)){
## Get the counts ## Get the counts
if (input$DistClust == "euclidean" && type.trans == "VST") counts <- assay(varianceStabilizingTransformation(dds))
if (input$DistClust == "euclidean" && type.trans == "rlog") counts <- assay(rlogTransformation(dds))
## Get the group of leaf
group = apply(group,1,paste, collapse = "-")
nb = length(unique((group)))
## Get the dendrogram
if(input$DistClust=="sere") dist.counts.norm = as.dist(SEREcoef(counts.norm))
else if(input$DistClust=="Unifrac"){
tmp = UniFracDist(CT,tree)
if(is.null(tree) || is.null(tmp)) dist.counts.norm = NULL
else
{
dist.counts.norm = switch(input$DistClustUnifrac,
"WU" = as.dist(tmp[, , "d_1"]),
"UWU" = as.dist(tmp[, , "d_UW"]),
"VAWU" = as.dist(tmp[, , "d_VAW"]))
}
}
else if(input$DistClust %in% getDistMethods()){
dist = as.dist(distance(t(sweep(counts.norm,2,colSums(counts.norm),`/`)), method=input$DistClust))
dist[is.na(dist)]=0.0
dist.counts.norm = dist
}
else dist.counts.norm = vegdist(t(counts.norm), method = input$DistClust)
if(!is.null(dist)) if (input$DistClust == "euclidean" && type.trans == "VST") counts <- assay(varianceStabilizingTransformation(dds))
{ if (input$DistClust == "euclidean" && type.trans == "rlog") counts <- assay(rlogTransformation(dds))
hc <- hclust(dist, method = "ward.D")
dend = as.dendrogram(hc)
## Get the type of dendrogram ## Get the group of leaf
type <- input$typeHculst group = apply(group,1,paste, collapse = "-")
nb = length(unique((group)))
dend <- set(dend, "labels_cex", input$cexLabelDiag) ## Get the dendrogram
if(input$colorHC) labels_colors(dend)<-col[as.integer(as.factor(group))][order.dendrogram(dend)] if(input$DistClust=="sere") dist.counts.norm = as.dist(SEREcoef(counts))
if(type=="hori") else if(input$DistClust=="Unifrac"){
{ tmp = UniFracDist(CT,tree)
par(cex=input$cexTitleDiag,mar=c(6,6,4,5)) if(is.null(tree) || is.null(tmp)) dist.counts.norm = NULL
res = plot(dend, main = "Cluster dendrogram",xlab = paste(input$DistClust,"distance, Ward criterion",sep=" "),cex=input$cexLabelDiag) else
} {
else dist.counts.norm = switch(input$DistClustUnifrac,
"WU" = as.dist(tmp[, , "d_1"]),
"UWU" = as.dist(tmp[, , "d_UW"]),
"VAWU" = as.dist(tmp[, , "d_VAW"]))
}
}
else if(input$DistClust %in% getDistMethods()){
dist = as.dist(distance(t(sweep(counts,2,colSums(counts),`/`)), method=input$DistClust))
dist[is.na(dist)]=0.0
dist.counts.norm = dist
}
else dist.counts.norm = vegdist(t(counts), method = input$DistClust)
if(!is.null(dist.counts.norm))
{ {
par(cex=input$cexTitleDiag,mar=c(6,6,4,5))
res = circlize_dendrogram(dend, labels_track_height = 0.2, dend_track_height = .3, main = "Cluster dendrogram",xlab = paste(input$DistClust,"distance, Ward criterion",sep=" ")) hc <- hclust(dist.counts.norm, method = "ward.D")
dend = as.dendrogram(hc)
## Get the type of dendrogram
type <- input$typeHculst
dend <- set(dend, "labels_cex", input$cexLabelDiag)
if(input$colorHC) labels_colors(dend)<-col[as.integer(as.factor(group))][order.dendrogram(dend)]
if(type=="hori")
{
par(cex=input$cexTitleDiag,mar=c(6,6,4,5))
res = plot(dend, main = "Cluster dendrogram",xlab = paste(input$DistClust,"distance, Ward criterion",sep=" "),cex=input$cexLabelDiag)
}
else
{
par(cex=input$cexTitleDiag,mar=c(6,6,4,5))
res = circlize_dendrogram(dend, labels_track_height = 0.2, dend_track_height = .3, main = "Cluster dendrogram",xlab = paste(input$DistClust,"distance, Ward criterion",sep=" "))
}
} }
} }
return(res) return(res)
......
...@@ -123,9 +123,16 @@ Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){ ...@@ -123,9 +123,16 @@ Plot_Visu_Heatmap <- function(input,resDiff,export=FALSE){
## Transpose matrix if Horizontal ## Transpose matrix if Horizontal
if(input$SensPlotVisu=="Horizontal") counts_tmp_combined = t(as.matrix(counts_tmp_combined)) if(input$SensPlotVisu=="Horizontal") counts_tmp_combined = t(as.matrix(counts_tmp_combined))
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 = d3heatmap(counts_tmp_combined, dendrogram = "none", Rowv = (input$SortHeatRow == "Yes"),
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) 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 = as.numeric(input$LabelSizeHeatmap), margins=c(12,30),
cexCol=as.numeric(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(as.numeric(input$lowerMargin),as.numeric(input$rightMargin)),trace="none",
srtCol=45, col = col, scale = input$scaleHeatmap, cexRow = input$LabelSizeHeatmap,cexCol =input$LabelSizeHeatmap,
offsetCol=input$LabelColOffsetHeatmap,offsetRow=input$LabelRowOffsetHeatmap,symm=FALSE,symkey=FALSE,symbreaks=FALSE)
}
return(plot) return(plot)
} }
} }
......
...@@ -202,6 +202,9 @@ shinyServer(function(input, output,session) { ...@@ -202,6 +202,9 @@ shinyServer(function(input, output,session) {
{ {
tmp = GetDataFromCT(Counts,Taxo, ifelse(input$TypeTable=="MGS" && input$FileFormat!="fileBiom", TRUE, FALSE)) tmp = GetDataFromCT(Counts,Taxo, ifelse(input$TypeTable=="MGS" && input$FileFormat!="fileBiom", TRUE, FALSE))
data = list(counts=tmp$counts,taxo=tmp$taxo) data = list(counts=tmp$counts,taxo=tmp$taxo)
## Remove row with only O
# data[["counts"]] = data[["counts"]][rowSums(data[["counts"]])>1,]
check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent) check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent)
percent = tmp$Percent percent = tmp$Percent
} }
...@@ -214,11 +217,16 @@ shinyServer(function(input, output,session) { ...@@ -214,11 +217,16 @@ shinyServer(function(input, output,session) {
{ {
tmp = GetDataFromBIOM(tmpBIOM) tmp = GetDataFromBIOM(tmpBIOM)
data = list(counts=tmp$counts,taxo=tmp$taxo) data = list(counts=tmp$counts,taxo=tmp$taxo)
## Remove row with only O
# data[["counts"]] = data[["counts"]][rowSums(data[["counts"]])>1,]
check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent) check = list(CheckCounts=tmp$CheckCounts,CheckTaxo=tmp$CheckTaxo,CheckPercent=tmp$CheckPercent)
percent = tmp$Percent percent = tmp$Percent
} }
} }
# if(input$FileFormat=="fileRData") # if(input$FileFormat=="fileRData")
# { # {
# inFile <- input$fileRData # inFile <- input$fileRData
...@@ -726,7 +734,7 @@ shinyServer(function(input, output,session) { ...@@ -726,7 +734,7 @@ shinyServer(function(input, output,session) {
CreateFasta() CreateFasta()
values$num = 1 values$num = 1
tmp = tempdir() tmp = tempdir()
home <- normalizePath("~") # home <- normalizePath("~")
home <- "" home <- ""
# path_glob = file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep)) # path_glob = file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
......
...@@ -9,17 +9,16 @@ sidebar <- dashboardSidebar( ...@@ -9,17 +9,16 @@ sidebar <- dashboardSidebar(
p()), p()),
div( div(
id = "app-content-bar", id = "app-content-bar",
sidebarMenu(id = "side", sidebarMenu(id = "side",
menuItem("Home", tabName = "Home", icon = icon("home")), menuItem("Home", tabName = "Home", icon = icon("home")),
menuItem("Tutorial", tabName = "Tutorial", icon = icon("book")), menuItem("Tutorial", tabName = "Tutorial", icon = icon("book")),
menuItem("Download/Install", tabName = "Download", icon = icon("download")), menuItem("Download/Install", tabName = "Download", icon = icon("download")),
# menuItem("Raw data", tabName = "RawData", icon = icon("upload")), #menuItem("Raw data", tabName = "RawData", icon = icon("upload")),
menuItem("Upload your data", tabName = "Upload", icon = icon("upload")), menuItem("Upload your data", tabName = "Upload", icon = icon("upload")),
# bookmarkButton(), # bookmarkButton(),
menuItemOutput("dymMenu"), menuItemOutput("dymMenu"),
img(src = "logo.jpg", height = 49, width = 220,style="position:absolute;bottom:0;margin:0 0 15px 10px;")
img(src = "logo.jpg", height = 49, width = 220,style="position:absolute;bottom:0;margin:0 0 15px 10px;") )
)
) )
) )
...@@ -957,8 +956,8 @@ body <- dashboardBody( ...@@ -957,8 +956,8 @@ body <- dashboardBody(
column(width=6,sliderInput("LabelColOffsetHeatmap", h6("Column offset"),min=0,max=4,value = 0,step = 0.5)), column(width=6,sliderInput("LabelColOffsetHeatmap", h6("Column offset"),min=0,max=4,value = 0,step = 0.5)),
column(width=6,sliderInput("LabelRowOffsetHeatmap", h6("Row offset"),min=0,max=4,value = 0,step = 0.5)), column(width=6,sliderInput("LabelRowOffsetHeatmap", h6("Row offset"),min=0,max=4,value = 0,step = 0.5)),
column(width=12,h6(strong("Margins options"))), column(width=12,h6(strong("Margins options"))),
column(width=6,sliderInput("rightMargin", h6("Right"),min=0,max=20,value = 6,step = 1)), column(width=6,sliderInput("rightMargin", h6("Right"),min=0,max=30,value = 6,step = 1)),
column(width=6,sliderInput("lowerMargin", h6("Lower"),min=0,max=20,value = 6,step = 1)) column(width=6,sliderInput("lowerMargin", h6("Lower"),min=0,max=30,value = 6,step = 1))
) )
), ),
......
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