Commit a3f86691 authored by stevenn's avatar stevenn
Browse files

Ajout export

parent 04901d36
......@@ -5,7 +5,10 @@
{
counts = biom_data(dataBIOM)
taxo = observation_metadata(dataBIOM)
counts = as.matrix(counts)
counts = as.data.frame(counts)
taxo = as.data.frame(observation_metadata(dataBIOM))
return(list(counts=counts,taxo=taxo))
}
......@@ -70,6 +73,7 @@
labels = target[,1]
ind = which(colnames(CT)%in%labels)
if(length(ind)==length(labels))
{
CT = CT[,ind]
......@@ -835,7 +839,7 @@
if(input$SensPlotVisuHM=="Horizontal") counts_tmp_combined = t(as.matrix(counts_tmp_combined))
#print(counts_tmp_combined)
return(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.4,cexCol = 0.4))
col = col, scale = input$scaleHeatmap,cexRow = 0.6))
# return(d3heatmap(counts_tmp_combined, dendrogram = "none", Rowv = NA, Colv = NA, na.rm = TRUE,
# width = 1500, height = 1000, show_grid = FALSE, colors = col, scale = input$scaleHeatmap,
# cexRow = 0.6))
......@@ -1388,7 +1392,7 @@
samples.supp <- colnames(counts(dds))[group %in% conds.supp]
col.supp <- c(samples.supp, paste("norm", samples.supp, sep = "."))
complete.name <- complete.name[, -which(names(complete.name) %in% col.supp)]
}
}
### ??????????
res.name <- data.frame(Id = rownames(result[[name]]),
......@@ -1422,64 +1426,4 @@
}
Get_log2FC <-function(input,BaseContrast,resDiff, info = NULL)
{
VarInt = input$VarInt
dds = resDiff$dds
counts = resDiff$counts
target = resDiff$target
SelContrast = input$ContrastList_table_FC
nbCont = length(SelContrast)
result = list()
alpha = input$AlphaVal
cooksCutoff = ifelse(input$CooksCutOff!='Auto',ifelse(input$CooksCutOff!=Inf,input$CutOffVal,Inf),TRUE)
for(i in 1:nbCont)
{
cont = as.character(SelContrast[i])
result[[cont]] <- results(dds,contrast=BaseContrast[,cont],pAdjustMethod=input$AdjMeth,
cooksCutoff=cooksCutoff,
independentFiltering=input$IndFiltering,alpha=alpha)
}
log2FC = as.matrix(round(result[[SelContrast[1]]][, "log2FoldChange"], 3))
if(nbCont>1)
{
for(i in 2:nbCont)
{
log2FC = cbind(log2FC,round(result[[SelContrast[i]]][, "log2FoldChange"], 3))
}
colnames(log2FC) = names(result)
}
rownames(log2FC) = rownames(result[[SelContrast[1]]])
return(log2FC)
}
Plot_Visu_Heatmap_FC <- function(input,BaseContrast,resDiff){
log2FC = Get_log2FC(input,BaseContrast,resDiff, info = NULL)
ind_taxo = input$selectTaxoPlotHM
ind = rownames(log2FC)%in%ind_taxo
log2FC = log2FC[ind,]
col <- switch(input$colors,
"green-blue"=colorRampPalette(brewer.pal(9,"GnBu"))(200),
"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))
col <- c(colorRampPalette(c("blue","white"))(n = 100),colorRampPalette(c("white", "firebrick1", "firebrick2", "firebrick3", "firebrick4"))(n = 100))
## Transpose matrix if Horizontal
if(input$SensPlotVisuHM=="Horizontal") log2FC = t(as.matrix(log2FC))
return(heatmap.2(log2FC, dendrogram = "row", Rowv = TRUE, Colv = NA, 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))
}
\ No newline at end of file
library(shiny)
library(psych)
library(ggplot2)
library(vegan)
library(ggdendro)
library(dendextend)
library(circlize)
library(shinydashboard)
if (!require(rNVD3)) {
install.packages('rNVD3')
library(rNVD3)
}
if (!require(psych)) {
install.packages('psych')
library(psych)
}
if (!require(ggplot2)) {
install.packages('ggplot2')
library(ggplot2)
}
if (!require(vegan)) {
install.packages('vegan')
library(vegan)
}
# if (!require(ggdendro)) {
# install.packages('ggdendro')
# library(ggdendro)
# }
if (!require(dendextend)) {
install.packages('dendextend')
library(dendextend)
}
if (!require(circlize)) {
install.packages('circlize')
library(circlize)
}
if (!require(d3heatmap)) {
install.packages('d3heatmap')
library(d3heatmap)
}
library(rNVD3)
if (!require(biom)) {
install.packages('biom')
library(biom)
}
source("internal.R")
renderDataTable <- DT::renderDataTable
......@@ -27,10 +51,10 @@ shinyServer(function(input, output,session) {
## Create base for contrast
rand = floor(runif(1,0,1e9))
# namesfile = paste("www/base/BaseContrast_",rand,".txt",sep="")
# file.create(namesfile,showWarnings=FALSE)
namesfile = paste("www/base/BaseContrast_",rand,".txt",sep="")
file.create(namesfile,showWarnings=FALSE)
namesfile = "www/All_Contrast.txt"
#namesfile = "www/All_Contrast.txt"
## Counts file
dataInputCounts <-reactive({
......@@ -97,14 +121,9 @@ namesfile = "www/All_Contrast.txt"
inFile <- input$fileBiom
if (is.null(inFile)) return(NULL)
data = read_biom(inFile$datapath)
data = read.csv(inFile$datapath,sep=",",header=TRUE)
## Rownames
rownames(data)=data[,1];data=data[,-1]
return(as.data.frame(data))
return(data)
})
......@@ -149,7 +168,6 @@ namesfile = "www/All_Contrast.txt"
counts = tmp$counts
CheckTarget = tmp$CheckTarget
}
return(list(counts=counts,CheckTarget=CheckTarget))
})
......@@ -358,11 +376,12 @@ namesfile = "www/All_Contrast.txt"
filename = function() { 'NomrCounts.csv' },
content = function(file){write.csv(dataMergeCounts()$counts, file, sep='\t')}
)
## Export in .csv
output$ExportRelative <- downloadHandler(
filename = function() { 'RelativeAb.csv' },
content = function(file){write.csv(dataMergeCounts()$counts/colSums(dataMergeCounts()$counts), file,, sep='\t')}
)
## Export in .csv
output$ExportRelative <- downloadHandler(
filename = function() { 'RelativeAb.csv' },
content = function(file){write.csv(dataMergeCounts()$counts/colSums(dataMergeCounts()$counts), file,, sep='\t')}
)
#################################################
......@@ -481,7 +500,6 @@ output$ExportRelative <- downloadHandler(
Contrast = colnames(as.matrix(tmp))
updateSelectInput(session, "ContrastList","Contrasts",Contrast)
updateSelectInput(session, "ContrastList_table","Contrasts",Contrast)
updateSelectInput(session, "ContrastList_table_FC","Contrasts",Contrast)
})
## Add contrast
......@@ -509,7 +527,6 @@ output$ExportRelative <- downloadHandler(
else file.create(namesfile,showWarnings=FALSE)
updateSelectInput(session, "ContrastList","Contrasts",ContrastKept)
updateSelectInput(session, "ContrastList_table","Contrasts",ContrastKept)
updateSelectInput(session, "ContrastList_table_FC","Contrasts",ContrastKept)
}
})
......@@ -732,28 +749,20 @@ output$ExportRelative <- downloadHandler(
##
#####################################################
## PDF
output$exportPDFdiag <- downloadHandler(
filename <- function() { paste(input$DiagPlot,'meta16S.pdf',sep="_")},
content <- function(file) {
pdf(file)
print(Plot_diag(input,ResDiffAnal()))
dev.off()
}
)
## PNG
output$exportPNGdiag <- downloadHandler(
filename <- function() { paste(input$DiagPlot,'meta16S.png',sep="_") },
#### Export Diag
output$exportdiag <- downloadHandler(
filename <- function() { paste(input$DiagPlot,paste('meta16S',input$Exp_format,sep="."),sep="_") },
content <- function(file) {
png(file, width = 1000, height = 1000)
if(input$Exp_format=="png") png(file, width = input$widthDiagExport, height = input$heightDiagExport)
if(input$Exp_format=="pdf") pdf(file, width = input$widthDiagExport/96, height = input$heightDiagExport/96)
if(input$Exp_format=="eps") postscript(file, width = input$widthDiagExport/96, height = input$heightDiagExport/96)
if(input$Exp_format=="svg") svg(file, width = input$widthDiagExport/96, height = input$heightDiagExport/96)
print(Plot_diag(input,ResDiffAnal()))
dev.off()
}
)
#####################################################
##
## EXPORT VISU GRAPH
......@@ -900,12 +909,7 @@ output$ExportRelative <- downloadHandler(
output$heatmap <- renderPlot({
resDiff = ResDiffAnal()
BaseContrast = read.table(namesfile,header=TRUE)
if(!is.null(resDiff$dds))
{
if(input$HeatMapType=="Counts") Plot_Visu_Heatmap(input,resDiff)
if(input$HeatMapType=="Log2FC") Plot_Visu_Heatmap_FC(input,BaseContrast,resDiff)
}
if(!is.null(resDiff$dds)) Plot_Visu_Heatmap(input,resDiff)
},height=reactive(input$heightHeat))
......
library(shinydashboard)
library(DT)
library(biom)
library(DESeq2)
library(rNVD3)
library(RColorBrewer)
library(gplots)
library(ggdendro)
library(dendextend)
library(circlize)
library(ade4)
if (!require(rNVD3)) {
install.packages('rNVD3')
library(rNVD3)
}
if (!require(psych)) {
install.packages('psych')
library(psych)
}
if (!require(ggplot2)) {
install.packages('ggplot2')
library(ggplot2)
}
if (!require(vegan)) {
install.packages('vegan')
library(vegan)
}
if (!require(dendextend)) {
install.packages('dendextend')
library(dendextend)
}
if (!require(circlize)) {
install.packages('circlize')
library(circlize)
}
if (!require(biom)) {
install.packages('biom')
library(biom)
}
if (!require(DT)) {
install.packages('DT')
library(DT)
}
if (!require(RColorBrewer)) {
install.packages('RColorBrewer')
library(RColorBrewer)
}
if (!require(gplots)) {
install.packages('gplots')
library(gplots)
}
if (!require(DESeq2)) {
source("https://bioconductor.org/biocLite.R")
biocLite("DESeq2")
library(DESeq2)
}
if (!require(ade4)) {
install.packages('ade4')
library(ade4)
}
sidebar <- dashboardSidebar(
sidebarMenu(
......@@ -205,9 +243,7 @@ body <- dashboardBody(
selectInput("DistPCOA","Distance",c("euclidean", "canberra", "bray", "kulczynski", "jaccard",
"gower", "altGower", "morisita", "horn","mountford","raup","binomial",
"chao","cao","mahalanobis"),selected="jaccard")
),
downloadButton("exportPDFdiag", "Download pdf"),
downloadButton("exportPNGdiag", "Download png")
)
# conditionalPanel(condition="input.RadioPlotBi=='Nuage'",selectInput("ColorBiplot", "Couleur",choices=c("Bleue" = 'blue',"Rouge"='red',"Vert"='green', "Noir"='black'),width="50%")),
# sliderInput("TransAlphaBi", "Transparence",min=1, max=100, value=50, step=1),
# conditionalPanel(condition="input.RadioPlotBi!='Nuage'", radioButtons("SensGraphBi","Sens du graph",choices=c("Vertical"="Vert","Horizontal"="Hori"))),
......@@ -236,6 +272,20 @@ body <- dashboardBody(
# sliderInput("widthDiag", "width",min=100,max=1500,value = 1000,step =10)
),
box(title = "Export", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE,
selectInput("Exp_format",h5(strong("Export format")),c("png"="png","pdf"="pdf","eps"="eps","svg"="svg"), multiple = FALSE),
fluidRow(
column(width=6,numericInput("heightDiagExport", "Height (in px)",min=100,max=NA,value = 500,step =1)),
column(width=6,numericInput("widthDiagExport", "Width (in px)",min=100,max=NA,value = 500,step =1))
),
downloadButton("exportdiag", "Export")
# downloadButton("exportPDFdiag", "Download pdf"),
# downloadButton("exportPNGdiag", "Download png"),
# downloadButton("exportEPSdiag", "Download eps"),
# downloadButton("exportSVGdiag", "Download svg"),
)
)
)
......@@ -289,8 +339,6 @@ body <- dashboardBody(
column(width=3,
box(title = "Options", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= FALSE,
selectInput(inputId = "HeatMapType",label = h6(strong("Data")),choices = c("Counts" = "Counts", "Log2FC" = "Log2FC"),selected = "Counts"),
selectInput("ContrastList_table_FC",h6(strong("Contrast list")),"", multiple = TRUE),
uiOutput("VarIntVisuHM"),
uiOutput("TaxoToPlotHM"),
radioButtons(inputId = "SensPlotVisuHM",label = "Type: ",choices = c("Vertical" = "Vertical", "Horizontal" = "Horizontal"),selected = "Vertical"),
......@@ -298,8 +346,7 @@ body <- dashboardBody(
),
box(title = "Appearance", width = NULL, status = "primary", solidHeader = TRUE,collapsible = TRUE,collapsed= TRUE,
selectInput("colors", label="Gradient of colors:",choices = c("green-blue", "blue-white-red", "purple-white-orange", "red-yellow-green")),
sliderInput("heightHeat", h6(strong("Height")),min=100,max=2000,value = 800),
sliderInput("LabelSizeHeatmap", h6(strong("Label size")),min=0.1,max=2,value = 0.7,step = 0.1)
sliderInput("heightHeat", h6(strong("Height")),min=100,max=2000,value = 800)
)
)
)
......
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