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

Modif visu diversity + ajout shannon/simpson/inv.simpson + modif couleur heatmap log2FC

parent 4860ff1c
Hide whitespace changes
Inline Side-by-side
META16S_App.Rproj deleted 100644 → 0
View file @ 4860ff1c
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
google-analytics.js deleted 100644 → 0
View file @ 4860ff1c
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
})(window,document,'script','//www.google-analytics.com/analytics.js','ga');
ga('create', 'UA-72614324-2', 'auto');
ga('send', 'pageview');
internal.R
View file @ ec886b9f
......@@ -864,9 +864,13 @@ CheckCountsTable <- function(counts)
if (length(VarInt)>0 && nbKept>0)
{
## Get the modalities to keep
for(i in 1:length(VarInt))
{
## Replace "-" by "."
target[,VarInt[i]] = gsub("-",".",target[,VarInt[i]])
Tinput = paste("input$","ModVisu",VarInt[i],sep="")
expr=parse(text=Tinput)
## All the modalities for all the var of interest
......@@ -1237,67 +1241,91 @@ CheckCountsTable <- function(counts)
Plot_Visu_Diversity <- function(input,resDiff,type="point"){
gg = NULL
dds = resDiff$dds
counts = round(counts(dds, normalized = TRUE))
#target = resDiff$target
counts_rare = rrarefy(t(counts), min(colSums(counts)))
## Get Input for the plot
VarInt = input$VisuVarInt
#VarIntBoxDiv = input$VarBoxDiv
VarIntBoxDiv = input$VarBoxDiv
VarIntDivCol = input$VarDivCol
ind_taxo = rownames(counts)
tmp = GetDataToPlot(input,resDiff,VarInt,ind_taxo,aggregate=FALSE)
counts_tmp_combined = tmp$counts
targetInt = tmp$targetInt
levelsMod = tmp$levelsMod
if(nrow(counts_tmp_combined)>0 && !is.null(counts_tmp_combined) && !is.null(targetInt))
{
print(TaxoNumber(counts_tmp_combined))
sqrt.nb = sqrt(table(targetInt$AllVar))
alpha <- tapply(TaxoNumber(counts_tmp_combined), targetInt$AllVar, mean)
ci.alpha.down = pmax(alpha - 1.96*tapply(TaxoNumber(counts_tmp_combined), targetInt$AllVar, mean)/sqrt.nb,0)
ci.alpha.up = alpha + 1.96*tapply(TaxoNumber(counts_tmp_combined), targetInt$AllVar, mean)/sqrt.nb
shan <- tapply(diversity(counts_tmp_combined, index = "shannon"), targetInt$AllVar, mean)
ci.shan.down = pmax(shan - 1.96*tapply(diversity(counts_tmp_combined, index = "shannon"), targetInt$AllVar, sd)/sqrt.nb,0)
ci.shan.up = shan + 1.96*tapply(diversity(counts_tmp_combined, index = "shannon"), targetInt$AllVar, sd)/sqrt.nb
simpson <- tapply(diversity(counts_tmp_combined, index = "simpson"), targetInt$AllVar, mean)
ci.simpson.down = pmax(simpson - 1.96*tapply(diversity(counts_tmp_combined, index = "simpson"), targetInt$AllVar, sd)/sqrt.nb,0)
ci.simpson.up = simpson + 1.96*tapply(diversity(counts_tmp_combined, index = "simpson"), targetInt$AllVar, sd)/sqrt.nb
invsimpson <- tapply(diversity(counts_tmp_combined, index = "invsimpson"), targetInt$AllVar, mean)
ci.invsimpson.down = pmax(invsimpson - 1.96*tapply(diversity(counts_tmp_combined, index = "invsimpson"), targetInt$AllVar, sd)/sqrt.nb,0)
ci.invsimpson.up = invsimpson + 1.96*tapply(diversity(counts_tmp_combined, index = "invsimpson"), targetInt$AllVar, sd)/sqrt.nb
gamma <- TaxoNumber(counts_tmp_combined, targetInt$AllVar)
beta = gamma/alpha - 1
nb = length(alpha)
# dataTmp = data.frame(value=c(alpha,beta,gamma),
# diversity = c(rep("Alpha",nb),rep("Beta",nb),rep("Gamma",nb)),
# Var = as.character(rep(names(alpha),3)),
# X = as.character(rep(targetInt[,VarIntBoxDiv],3)))
dataTmp = data.frame(value=c(alpha,beta,gamma),
diversity = c(rep("Alpha",nb),rep("Beta",nb),rep("Gamma",nb)),
Var = as.character(rep(names(alpha),3)))
## Merge targetInt et dataTmp par rapport à Var
# VectX = c()
# for(i in 1:nb)
# {
# ## If duplicated, take only one row
# tmpX = which(targetInt$AllVar%in%names(alpha)[i])[1]
# VectX = c(VectX,targetInt[tmpX,VarIntBoxDiv])
# }
# print(VectX)
# dataTmp$X = as.character(rep(VectX,3))
dataTmp = data.frame(value=c(alpha,beta,gamma,shan,simpson,invsimpson),
ci.down=c(ci.alpha.down,beta,gamma,ci.shan.down,ci.simpson.down,ci.invsimpson.down),
ci.up=c(ci.alpha.up,beta,gamma,ci.shan.up,ci.simpson.up,ci.invsimpson.up),
diversity = c(rep("Alpha",nb),rep("Beta",nb),rep("Gamma",nb),rep("Shannon",nb),rep("Simpson",nb),rep("Inv.Simpson",nb)),
Var = as.character(rep(names(alpha),6)))
dataTmp = dataTmp[dataTmp$diversity%in%input$WhichDiv,]
if(type=="point")
{
gg = ggplot(dataTmp, aes(x=Var, y=value, color=diversity)) + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
gg = gg + geom_point(size=input$sizePointGlobal)
if(input$SensPlotVisu=="Horizontal") gg = gg + coord_flip()
if(input$SplitVisuGlobal==TRUE) gg = gg + facet_wrap(~ diversity)
## Order of the modalities
dataTmp$Var = factor(dataTmp$Var,levels = levelsMod)
tmp.mat = matrix(unlist((lapply(as.matrix(as.character(dataTmp$Var)),strsplit,"-"))),ncol=length(VarInt),byrow = T)
indVar = VarInt%in%VarIntBoxDiv
if(length(which(indVar))>=1){
if(length(which(indVar))>=2) dataTmp$VarX = factor(apply(tmp.mat[,which(indVar)],1,paste,collapse = "-"))
if(length(which(indVar))==1) dataTmp$VarX = factor(tmp.mat[,which(indVar)])
}
if(is.null(VarIntBoxDiv)) dataTmp$VarX = tmp.mat[,1]
dataTmp$VarCol = dataTmp$VarX
if(length(which(!indVar))>=1){
if(length(which(!indVar))>=2) dataTmp$VarCol = factor(apply(tmp.mat[,which(!indVar)],1,paste,collapse = "-"))
if(length(which(!indVar))==1) dataTmp$VarCol = factor(tmp.mat[,which(!indVar)])
}
# if(type=="box")
# {
# gg = ggplot(dataTmp,aes(x=X,y=value,fill=diversity)) + geom_boxplot(alpha=0.7) + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
# gg = gg + geom_point(size=input$sizePointGlobal)
# gg = gg + geom_point(position=position_jitterdodge(dodge.width=0.9))
# if(input$SensPlotVisuGlobal=="Horizontal") gg = gg + coord_flip()
# if(input$SplitVisuGlobal==TRUE) gg = gg + facet_wrap(~ diversity)
# }
# nvd3Plot(value ~ Var | diversity, data = dataTmp, id = 'Scachart', type = 'lineChart',height = 1000,width=1000)
# p1$xAxis(axisLabel = 'Variable of interest')
dataTmp$Var = factor(dataTmp$Var,levels = levelsMod)
colors = rep(c("#1f77b4","#aec7e8","#ff7f0e","#ffbb78", "#2ca02c","#98df8a","#d62728","#ff9896","#9467bd","#c5b0d5","#8c564b",
"#c49c94","#e377c2","#f7b6d2","#7f7f7f", "#c7c7c7","#bcbd22","#dbdb8d","#17becf","#9edae5"),ceiling(nrow(targetInt)/20))
gg = ggplot(dataTmp, aes(x=VarX, y=value, fill=VarCol))
gg = gg + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1,vjust=0.5), legend.title=element_blank())
gg = gg + geom_bar(stat = "identity",width=0.4,position = position_dodge(width=0.5),alpha=0.8)
if(input$DivAddError=="Add") gg = gg + geom_errorbar(aes(ymin=ci.down, ymax=ci.up,color=VarCol,width=.2),position = position_dodge(width=0.5))
if(input$SensPlotVisu=="Horizontal") gg = gg + coord_flip() + facet_wrap(~ diversity,scales="fixed")
if(input$SensPlotVisu=="Vertical") gg = gg + facet_wrap(~ diversity,scales=input$DivScale)
gg = gg + xlab(paste(VarIntBoxDiv,collapse ="-"))+ ylab("Diversity")
gg = gg + scale_fill_manual(values = colors[1:length(unique(dataTmp[,7]))]) + scale_color_manual(values = colors[1:length(unique(dataTmp[,7]))])
## Get interactivity
#ff = ggplotly(gg)
}
return(gg)
......@@ -1305,6 +1333,11 @@ CheckCountsTable <- function(counts)
strsplit_Var <-function(names,ind)
{
return(unlist(strsplit(names,"-"))[ind])
}
## Rarefaction
Plot_Visu_Rarefaction <- function(input,resDiff,xlim,ylim,ylab="Species"){
......@@ -1342,44 +1375,44 @@ CheckCountsTable <- function(counts)
}
rarefaction_curve <- function (x, step = 1, taxo ="Species")
{
tot = rowSums(x)
S = TaxoNumber(x)
if (any(S <= 0)) {
x <- x[S > 0, , drop = FALSE]
tot <- tot[S > 0]
S <- S[S > 0]
}
nr <- nrow(x)
out <- lapply(seq_len(nr), function(i) {
n <- seq(1, tot[i], by = step)
if (n[length(n)] != tot[i]) n <- c(n, tot[i])
drop(rarefy(x[i, ], n))
})
df = data.frame()
for(i in 1: length(out))
{
dftmp = data.frame(x=attr(out[[i]], "Subsample"),y=out[[i]],samples=rep(rownames(x)[i],length(out[[i]])))
df = rbind(df,dftmp)
}
Nmax = sapply(out, function(x) max(attr(x, "Subsample")))
Smax = sapply(out, max)
# plot = nvd3Plot(y ~ x | samples, data = df, id = 'chart', type = 'lineChart',height=600)
# plot$xAxis(axisLabel = 'Sample size')
plot = ggplot(df,aes=c(x=x,y=y, group=samples, colour=samples)) + geom_line()+xlab('Sample size')
plot = plot + theme_bw() + theme(legend.position="bottom")
return(plot)
}
# rarefaction_curve <- function (x, step = 1, taxo ="Species")
# {
#
# tot = rowSums(x)
# S = TaxoNumber(x)
# if (any(S <= 0)) {
# x <- x[S > 0, , drop = FALSE]
# tot <- tot[S > 0]
# S <- S[S > 0]
# }
# nr <- nrow(x)
#
# out <- lapply(seq_len(nr), function(i) {
# n <- seq(1, tot[i], by = step)
# if (n[length(n)] != tot[i]) n <- c(n, tot[i])
# drop(rarefy(x[i, ], n))
# })
#
#
# df = data.frame()
#
# for(i in 1: length(out))
# {
# dftmp = data.frame(x=attr(out[[i]], "Subsample"),y=out[[i]],samples=rep(rownames(x)[i],length(out[[i]])))
# df = rbind(df,dftmp)
# }
#
# Nmax = sapply(out, function(x) max(attr(x, "Subsample")))
# Smax = sapply(out, max)
#
# # plot = nvd3Plot(y ~ x | samples, data = df, id = 'chart', type = 'lineChart',height=600)
# # plot$xAxis(axisLabel = 'Sample size')
#
# plot = ggplot(df,aes=c(x=x,y=y, group=samples, colour=samples)) + geom_line()+xlab('Sample size')
# plot = plot + theme_bw() + theme(legend.position="bottom")
#
# return(plot)
# }
TableDiff_print <- function(input,BaseContrast,resDiff, info = NULL)
......@@ -1476,7 +1509,9 @@ CheckCountsTable <- function(counts)
result = list()
alpha = as.numeric(input$AlphaVal)
cooksCutoff = ifelse(input$CooksCutOff!='Auto',ifelse(input$CooksCutOff!=Inf,input$CutOffVal,Inf),TRUE)
if(nbCont>=2)
{
for(i in 1:nbCont)
{
cont = as.character(SelContrast[i])
......@@ -1498,7 +1533,7 @@ CheckCountsTable <- function(counts)
}
rownames(log2FC) = rownames(result[[SelContrast[1]]])
rownames(padj) = rownames(result[[SelContrast[1]]])
}
return(list(log2FC=as.data.frame(log2FC),padj=padj))
}
......@@ -1521,12 +1556,15 @@ CheckCountsTable <- function(counts)
log2FC = as.matrix(log2FC[ind,])
col <- c(colorRampPalette(c("royalblue4","royalblue3","royalblue2","royalblue1","white"))(n = 100),colorRampPalette(c("white", "firebrick1", "firebrick2", "firebrick3", "firebrick4"))(n = 100))
col1 <- c(colorRampPalette(c("royalblue4","royalblue3","royalblue2","royalblue1","white"))(n = 100),colorRampPalette(c("white", "firebrick1", "firebrick2", "firebrick3", "firebrick4"))(n = 100))
breaks <- c(seq(min(log2FC,-0.01), 0,length=100),seq(0.01,max(log2FC,0.02),length=100))
colorFunc <- col_bin(col1, bins = rescale(breaks))
## Transpose matrix if Horizontal
if(input$SensPlotVisu=="Horizontal") log2FC = t(as.matrix(log2FC))
if(!export) res = d3heatmap(log2FC, dendrogram = "row", Rowv = TRUE, Colv = NA, na.rm = TRUE, width = input$widthVisu, 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) res = heatmap.2(log2FC, dendrogram = "none", Rowv = TRUE, Colv = NA, na.rm = TRUE, width = input$widthVisu, height = input$heightVisu, margins=c(input$lowerMargin,input$rightMargin), density.info="none", show_grid = FALSE, trace="none", col = col, scale = input$scaleHeatmap,cexRow = input$LabelSizeHeatmap,cexCol =input$LabelSizeHeatmap, offsetCol=input$LabelColOffsetHeatmap,offsetRow=input$LabelRowOffsetHeatmap)
if(!export) res = d3heatmap(log2FC, dendrogram = "row", Rowv = TRUE, Colv = NA, na.rm = TRUE, width = input$widthVisu, height = input$heightVisu, show_grid = FALSE, colors = colorFunc, scale = input$scaleHeatmap,cexRow = input$LabelSizeHeatmap,cexCol =input$LabelSizeHeatmap, offsetCol=input$LabelColOffsetHeatmap,offsetRow=input$LabelRowOffsetHeatmap)
if(export) res = heatmap.2(log2FC, dendrogram = "none", Rowv = TRUE, Colv = NA, na.rm = TRUE, width = input$widthVisu, height = input$heightVisu, margins=c(input$lowerMargin,input$rightMargin), density.info="none", show_grid = FALSE, trace="none", col = col1, scale = input$scaleHeatmap,cexRow = input$LabelSizeHeatmap,cexCol =input$LabelSizeHeatmap,
offsetCol=input$LabelColOffsetHeatmap,offsetRow=input$LabelRowOffsetHeatmap,symm=FALSE,symkey=TRUE,symbreaks=TRUE)
}
return(res)
}
......
libraries_updates.R deleted 100644 → 0
View file @ 4860ff1c
#### to avoid conflict between d3heatmap and rnvd3 #####
# the conflict come from the fact that both libraries use d3 but not the same version
# when the most recent one is loaded (the one of d3heatmap), it breaks the one of rNVD3
# the idea here is to modify the d3 of d3heatmap so that the library create an object called d33
# then modify the d3heatmap files so that it use this d33 object instead of d3
# first get d3heatmap javascript library path
d3heatmap_path = paste(.libPaths(), 'd3heatmap/htmlwidgets/lib/', sep='/')
# then get all js files in this directory
js_files = dir(path=d3heatmap_path, pattern = "*.js$", recursive = T, full.names = T)
# then create a function tu update the files
d3_to_d33 = function(target){
# the function will use the bash tool sed on the file target
# it makes 3 replacements
system(command=paste('sed -i .bck -e "s/d3\\ /d33 /g" -e "s/d3\\./d33./g" -e "s/d3;/d33;/g" ', target))
}
# apply the replacement function to all js files
sapply(js_files, d3_to_d33)
# change from d3.min.js to d3.js in the yaml file
system(command=paste('sed -i .bck -e "s/d3\\.min/d3/g" ', .libPaths(), '/d3heatmap/htmlwidgets/d3heatmap.yaml', sep=''))
# it's done. d3heatmap should use d33 object now
#### replacement of the css cals of the rNVD3 ####
# get the rNVD3 path
rNVD3_path = paste(.libPaths(), 'rNVD3/nvd3/css/', sep='/')
# get the path of the current source. may need to be modified (parent.frame(1) or parent.frame(2) or parent.frame(3) or else)
current_path = dirname(parent.frame(2)$ofile)
# get the css files path
css_files = dir(path=current_path, pattern = "*.css$", full.names = T)
# create the function to copy the css file
cp_to_rNVD3 = function(p, dest){
system(paste('cp', p, dest))
}
#apply the copy to all the css files
sapply(css_files, cp_to_rNVD3, rNVD3_path)
# first get d3heatmap javascript library path
scatterD3_path = paste(.libPaths(), 'scatterD3/htmlwidgets/', sep='/')
# then get all js files in this directory
js_files = dir(path=scatterD3_path, pattern = "*.js$", recursive = T, full.names = T)
# then create a function tu update the files
d3_to_d333 = function(target){
# the function will use the bash tool sed on the file target
# it makes 3 replacements
system(command=paste('sed -i .bck -e "s/d3\\ /d333 /g" -e "s/d3\\./d333./g" -e "s/d3;/d333;/g" -e "s/d3=/d333=/g" ', target))
}
# apply the replacement function to all js files
sapply(js_files, d3_to_d333)
# change from d3.min.js to d3.js in the yaml file
system(command=paste('sed -i .bck -e "s/d3$/d333/g" ', .libPaths(), '/scatterD3/htmlwidgets/scatterD3.yaml', sep=''))
server.R
View file @ ec886b9f
......@@ -79,7 +79,16 @@ if (!require(googleVis)) {
suppressPackageStartupMessages(library(googleVis))
}
library(shinyjs)
if (!require(shinyjs)) {
install.packages('shinyjs')
library(shinyjs)
}
if(!require(plotly)){
install.packages('plotly')
library(plotly)
}
# Allow to upload 50M files
options(shiny.maxRequestSize=50*1024^2)
......@@ -1396,19 +1405,31 @@ output$RunButton <- renderUI({
}
})
#### Select color and split for diversity
#
# output$SelectVarBoxDiv <- renderUI({
output$SelectVarBoxDiv <- renderUI({
selectVar = input$VisuVarInt
selectInput("VarBoxDiv", h6(strong("Split by")),selectVar,selectVar[1],multiple = TRUE)
})
# output$SelectVarDivCol <- renderUI({
#
# selectVar = input$VisuVarInt
# VarB = input$VarBoxDiv
#
# if(!is.null(selectVar))
# if(length(selectVar)>1)
# {
# selectInput("VarBoxDiv", h6(strong("By")),selectVar)
# selectInput("VarDivCol", h6(strong("Color by")),c(NULL,selectVar[-which(selectVar%in%VarB)]),multiple = FALSE)
# }
#
# })
#
output$plotVisu <- renderUI({
res=NULL
......
ui.R
View file @ ec886b9f
......@@ -76,6 +76,12 @@ if (!require(googleVis)) {
suppressPackageStartupMessages(library(googleVis))
}
if(!require(plotly)){
install.packages('plotly')
library(plotly)
}
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Home", tabName = "Home", icon = icon("home")),
......@@ -500,12 +506,12 @@ body <- dashboardBody(
## DIVERSITY
##################
conditionalPanel(condition="input.PlotVisuSelect=='Diversity'",
selectizeInput("WhichDiv",h6(strong("Diversity")),c('Alpha','Beta','Gamma'),selected = c('Alpha','Beta','Gamma'),multiple=TRUE),
checkboxInput("AddBoxplotDiv","AddBoxplot",value=FALSE)
selectizeInput("WhichDiv",h6(strong("Diversity")),c('Alpha','Beta','Gamma','Shannon','Simpson','Inv.Simpson'),selected = c('Alpha','Shannon','Simpson','Inv.Simpson'),multiple=TRUE)
),
conditionalPanel(condition="input.PlotVisuSelect=='Diversity'",
uiOutput("SelectVarBoxDiv")
)
# conditionalPanel(condition="input.PlotVisuSelect=='Diversity' && input.AddBoxplotDiv",
# uiOutput("SelectVarBoxDiv")
# )
),
......@@ -528,8 +534,8 @@ body <- dashboardBody(
## DIVERSITY
##################
conditionalPanel(condition="input.PlotVisuSelect=='Diversity'",
sliderInput("sizePointGlobal", h6(strong("Points size")),min=0.5,max=10,value =3,step=0.5),
checkboxInput("SplitVisuGlobal","Split diversity",value=FALSE)
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
......
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