Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Guillaume Perréal
easy16S
Commits
a949d8e1
Commit
a949d8e1
authored
Aug 17, 2018
by
Midoux Cedric
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Table with agglomerate taxe but not DataTable formatting
parent
2f2009bb
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
77 additions
and
50 deletions
+77
-50
server.R
server.R
+77
-50
No files found.
server.R
View file @
a949d8e1
...
...
@@ -17,7 +17,7 @@ shinyServer
return
(
x
)
}
}
beautifulTable
<-
function
(
data
)
{
DT
::
datatable
(
data
=
data
,
...
...
@@ -27,7 +27,7 @@ shinyServer
options
=
list
(
dom
=
"lBtip"
,
pageLength
=
10
,
lengthMenu
=
list
(
c
(
10
,
25
,
50
,
100
,
-1
),
list
(
'10'
,
'25'
,
'50'
,
'100'
,
'All'
)),
lengthMenu
=
list
(
c
(
10
,
25
,
50
,
100
,
-1
),
list
(
'10'
,
'25'
,
'50'
,
'100'
,
'All'
)),
buttons
=
list
(
'colvis'
,
list
(
...
...
@@ -44,32 +44,31 @@ shinyServer
height
=
"auto"
)
}
source
({
"https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
})
source
(
"internals.R"
)
data16S
<-
reactive
({
## BIOM input
if
(
input
$
dataset
==
"input"
)
{
## Unhappy path
if
(
is.null
(
input
$
fileBiom
))
return
()
## Happy path
## Import biom
d
<-
.import_biom
(
input
)
## Format tax table
tax_table
(
d
)
<-
.format_tax_table
(
tax_table
(
d
))
## import metadata and store it in phyloseq object
sample_data
(
d
)
<-
.import_sample_data
(
input
,
d
)
## Rarefy data
if
(
input
$
rareData
)
{
d
<-
rarefy_even_depth
(
...
...
@@ -81,29 +80,30 @@ shinyServer
}
return
(
d
)
}
## Rdata input
if
(
input
$
dataset
==
"rdata"
)
{
## .import_from_rdata(input) ## does not work as a function for some reason
## Happy path
ne
<-
new.env
()
## new env to store RData content and avoid border effects
ne
<-
new.env
()
## new env to store RData content and avoid border effects
if
(
!
is.null
(
input
$
fileRData
))
load
(
input
$
fileRData
$
datapath
,
envir
=
ne
)
if
(
class
(
ne
$
data
)
==
"phyloseq"
)
return
(
ne
$
data
)
## Unhappy paths: everything else
return
()
}
## Default case
load
(
"demo/demo.RData"
)
return
(
get
(
input
$
dataset
))
})
data
<-
reactiveValues
()
{
observe
({
...
...
@@ -111,7 +111,7 @@ shinyServer
isolate
(
data
<<-
data16S
())
})
}
output
$
downloadData
<-
{
downloadHandler
(
filename
=
function
()
{
...
...
@@ -122,7 +122,7 @@ shinyServer
}
)
}
output
$
downloadUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
tags
$
div
(
...
...
@@ -131,15 +131,15 @@ shinyServer
downloadButton
(
"downloadData"
,
"Download"
,
style
=
"color: black; background-color: gray90"
)
)
})
output
$
rarefactionMin
<-
renderText
({
validate
(
need
(
input
$
fileBiom
,
""
),
need
(
input
$
dataset
==
"input"
,
""
))
paste
(
"(min sample ="
,
format
(
min
(
sample_sums
(
data16S
(
))),
big.mark
=
" "
),
"reads)"
)
})
output
$
phyloseqPrint
<-
renderPrint
({
validate
(
need
(
...
...
@@ -149,7 +149,7 @@ shinyServer
)
data16S
()
})
output
$
summaryTable
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -169,11 +169,38 @@ shinyServer
#as.data.frame(sapply(sample_data(data16S()), class)),
beautifulTable
(
data.frame
(
SAMPLE
=
sample_names
(
data16S
()),
sample_data
(
data16S
()))
))
)),
tabPanel
(
"agglomerate_taxa"
,
radioButtons
(
"glomRank"
,
label
=
"Taxonomic rank : "
,
choices
=
rank_names
(
data16S
()),
inline
=
TRUE
),
dataTableOutput
(
"tableGlom"
)
)
)
)
})
output
$
tableGlom
<-
renderDataTable
({
Glom
<-
tax_glom
(
data16S
(),
input
$
glomRank
)
taxTableGlom
<-
Glom
%>%
tax_table
()
%>%
as.data.frame
()
%>%
dplyr
::
select
(
1
:
input
$
glomRank
)
%>%
tibble
::
rownames_to_column
()
otuTableGlom
<-
Glom
%>%
otu_table
()
%>%
as.data.frame
()
%>%
tibble
::
rownames_to_column
()
joinGlom
<-
dplyr
::
left_join
(
taxTableGlom
,
otuTableGlom
,
by
=
"rowname"
)
%>%
dplyr
::
select
(
-
rowname
)
return
(
joinGlom
)
})
output
$
histUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -202,7 +229,7 @@ shinyServer
)
)
})
output
$
histo
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -218,7 +245,7 @@ shinyServer
}
return
(
p
)
})
output
$
histFocusUIfocusRank
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
radioButtons
(
...
...
@@ -228,19 +255,19 @@ shinyServer
inline
=
TRUE
)
})
output
$
histFocusUIfocusTaxa
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
selectInput
(
"focusTaxa"
,
label
=
"Selected taxa : "
,
choices
=
unique
(
as.vector
(
tax_table
(
data16S
(
))[,
input
$
focusRank
])),
selected
=
TRUE
)
})
output
$
histFocusUIfocusNbTaxa
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
sliderInput
(
...
...
@@ -285,7 +312,7 @@ shinyServer
}
return
(
p
)
})
output
$
clustUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -326,7 +353,7 @@ shinyServer
)
)
})
output
$
clust
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -337,7 +364,7 @@ shinyServer
color
=
checkNull
(
input
$
clustCol
)
)
})
output
$
richnessAUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -398,7 +425,7 @@ shinyServer
)
)
})
output
$
richnessA
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -420,7 +447,7 @@ shinyServer
}
return
(
p
)
})
output
$
richnessATable
<-
renderUI
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -428,7 +455,7 @@ shinyServer
SAMPLE
=
sample_names
(
data16S
()),
round
(
estimate_richness
(
data16S
()),
digits
=
2
)
)))
})
output
$
richnessBUI
<-
renderUI
({
box
(
title
=
"Setting : "
,
...
...
@@ -444,7 +471,7 @@ shinyServer
value
=
"Beta diversity heatmap"
)
)
})
output
$
richnessB
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -477,7 +504,7 @@ shinyServer
)
return
(
p
+
scale_fill_gradient2
())
})
output
$
networkBUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -518,7 +545,7 @@ shinyServer
)
)
})
output
$
networkB
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -539,7 +566,7 @@ shinyServer
)
return
(
p
)
})
output
$
richnessBTable
<-
renderUI
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -549,7 +576,7 @@ shinyServer
),
digits
=
2
)
)))
})
output
$
rarefactionCurve
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -564,16 +591,16 @@ shinyServer
if
(
!
is.null
(
checkNull
(
input
$
rarefactionGrid
)))
{
p
<-
p
+
facet_grid
(
paste
(
"."
,
"~"
,
input
$
rarefactionGrid
))
}
if
(
input
$
rarefactionMin
)
{
p
<-
p
+
geom_vline
(
xintercept
=
min
(
sample_sums
(
data16S
())),
color
=
"gray60"
)
}
return
(
p
+
ggtitle
(
input
$
rarefactionTitle
))
})
output
$
rarefactionCurveUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -608,7 +635,7 @@ shinyServer
)
)
})
output
$
HeatmapUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -667,7 +694,7 @@ shinyServer
)
)
})
output
$
Heatmap
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -689,7 +716,7 @@ shinyServer
}
return
(
p
)
})
output
$
treeUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -728,7 +755,7 @@ shinyServer
)
)
})
output
$
tree
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
),
...
...
@@ -757,7 +784,7 @@ shinyServer
return
(
p
)
}
})
output
$
acpUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -821,7 +848,7 @@ shinyServer
)
)
})
output
$
acp
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
),
...
...
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