Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Guillaume Perréal
easy16S
Commits
5511da30
Commit
5511da30
authored
Aug 23, 2018
by
Midoux Cedric
Browse files
Merge branch 'class_sample'
parents
9f80df55
d1e83687
Changes
2
Hide whitespace changes
Inline
Side-by-side
server.R
View file @
5511da30
...
...
@@ -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,13 +44,13 @@ 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"
)
...
...
@@ -58,17 +58,17 @@ shinyServer
## 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
(
...
...
@@ -80,12 +80,12 @@ 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
...
...
@@ -93,17 +93,17 @@ shinyServer
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,12 +149,24 @@ shinyServer
)
data16S
()
})
output
$
sampledataTable
<-
render
Table
({
output
$
sampledataTable
<-
render
UI
({
validate
(
need
(
sample_data
(
data16S
(),
errorIfNULL
=
FALSE
),
""
))
sapply
(
sample_data
(
data16S
()),
class
)
},
rownames
=
TRUE
,
colnames
=
FALSE
,
caption
=
"Class of sample_data"
,
caption.placement
=
"top"
)
box
(
title
=
"Class of sample_data"
,
width
=
NULL
,
status
=
"primary"
,
collapsible
=
TRUE
,
collapsed
=
TRUE
,
renderTable
({
(
sapply
(
sample_data
(
data16S
()),
class
))
},
rownames
=
TRUE
,
colnames
=
FALSE
)
)
#sapply(sample_data(data16S()), class)
#}, rownames = TRUE, colnames = FALSE, caption = "Class of sample_data", caption.placement = "top")
})
output
$
summaryTable
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -178,7 +190,7 @@ shinyServer
)
)
})
output
$
histUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -207,7 +219,7 @@ shinyServer
)
)
})
output
$
histo
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -223,7 +235,7 @@ shinyServer
}
return
(
p
)
})
output
$
histFocusUIfocusRank
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
radioButtons
(
...
...
@@ -233,19 +245,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
(
...
...
@@ -257,21 +269,21 @@ shinyServer
value
=
10
)
})
output
$
histFocusUIfocusGrid
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
selectInput
(
"focusGrid"
,
label
=
"Subplot : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
())))
})
output
$
histFocusUIfocusX
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
selectInput
(
"focusX"
,
label
=
"X : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
())))
})
output
$
histoFocus
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -290,7 +302,7 @@ shinyServer
}
return
(
p
)
})
output
$
clustUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -331,7 +343,7 @@ shinyServer
)
)
})
output
$
clust
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -342,7 +354,7 @@ shinyServer
color
=
checkNull
(
input
$
clustCol
)
)
})
output
$
richnessAUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -403,7 +415,7 @@ shinyServer
)
)
})
output
$
richnessA
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -425,7 +437,7 @@ shinyServer
}
return
(
p
)
})
output
$
richnessATable
<-
renderUI
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -433,7 +445,7 @@ shinyServer
SAMPLE
=
sample_names
(
data16S
()),
round
(
estimate_richness
(
data16S
()),
digits
=
2
)
)))
})
output
$
richnessBUI
<-
renderUI
({
box
(
title
=
"Setting : "
,
...
...
@@ -449,7 +461,7 @@ shinyServer
value
=
"Beta diversity heatmap"
)
)
})
output
$
richnessB
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -482,7 +494,7 @@ shinyServer
)
return
(
p
+
scale_fill_gradient2
())
})
output
$
networkBUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -523,7 +535,7 @@ shinyServer
)
)
})
output
$
networkB
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -544,7 +556,7 @@ shinyServer
)
return
(
p
)
})
output
$
richnessBTable
<-
renderUI
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -554,7 +566,7 @@ shinyServer
),
digits
=
2
)
)))
})
output
$
rarefactionCurve
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -569,16 +581,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
(
...
...
@@ -613,7 +625,7 @@ shinyServer
)
)
})
output
$
HeatmapUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -672,7 +684,7 @@ shinyServer
)
)
})
output
$
Heatmap
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
))
...
...
@@ -694,7 +706,7 @@ shinyServer
}
return
(
p
)
})
output
$
treeUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -733,7 +745,7 @@ shinyServer
)
)
})
output
$
tree
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
),
...
...
@@ -762,7 +774,7 @@ shinyServer
return
(
p
)
}
})
output
$
acpUI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
...
...
@@ -826,7 +838,7 @@ shinyServer
)
)
})
output
$
acp
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
),
...
...
@@ -851,4 +863,4 @@ shinyServer
}
return
(
p
+
theme_bw
())
})
})
\ No newline at end of file
})
ui.R
View file @
5511da30
...
...
@@ -83,7 +83,7 @@ shinyUI(dashboardPage(
tabPanel
(
"Summary"
,
verbatimTextOutput
(
"phyloseqPrint"
),
table
Output
(
"sampledataTable"
),
ui
Output
(
"sampledataTable"
),
withLoader
(
uiOutput
(
"summaryTable"
)),
tags
$
footer
(
"Questions, problems or comments regarding this application should be sent to "
,
...
...
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