Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
E
easy16S
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Guillaume Perréal
easy16S
Commits
5511da30
Commit
5511da30
authored
Aug 23, 2018
by
Midoux Cedric
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'class_sample'
parents
9f80df55
d1e83687
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
68 additions
and
56 deletions
+68
-56
server.R
server.R
+67
-55
ui.R
ui.R
+1
-1
No files found.
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