Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Amine GHOZLANE
shaman
Commits
a3f86691
Commit
a3f86691
authored
Nov 26, 2015
by
stevenn
Browse files
Ajout export
parent
04901d36
Changes
3
Hide whitespace changes
Inline
Side-by-side
internal.R
View file @
a3f86691
...
...
@@ -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
server.R
View file @
a3f86691
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
))
...
...
ui.R
View file @
a3f86691
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
)
)
)
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment