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
94ef920c
Commit
94ef920c
authored
Sep 13, 2018
by
Midoux Cedric
Browse files
networkBScript + heatmapScript
parent
71d1f93e
Changes
1
Hide whitespace changes
Inline
Side-by-side
server.R
View file @
94ef920c
...
...
@@ -578,8 +578,11 @@ shinyServer
script
<-
c
(
script
,
""
,
"# Tables"
)
script
<-
c
(
script
,
glue
(
"t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
),
"write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)"
)
glue
(
"t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
),
"write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)"
)
return
(
glue_collapse
(
script
,
sep
=
"\n"
))
})
...
...
@@ -660,10 +663,12 @@ shinyServer
script
<-
c
(
script
,
"tipColor <- NULL"
)
}
script
<-
c
(
script
,
c
(
script
,
""
,
"p1 <- ggplot(beta, aes(x = x, y = y, fill = distance))"
,
"p1 <- p1 + geom_tile()"
)
"p1 <- p1 + geom_tile()"
)
if
(
!
is.null
(
checkNull
(
input
$
richnessBTitle
)))
{
script
<-
c
(
script
,
glue
(
"p1 <- p1 + ggtitle(\"{input$richnessBTitle}\")"
))
...
...
@@ -755,8 +760,38 @@ shinyServer
"Sample name"
=
"value"
,
sample_variables
(
data16S
())
)
)
),
collapsedBox
(
verbatimTextOutput
(
"networkBScript"
),
title
=
"RCode"
)
)
})
output
$
networkBScript
<-
renderText
({
scriptArgs
<-
c
(
"g"
,
"physeq = data"
,
"hjust = 2"
)
if
(
!
is.null
(
checkNull
(
input
$
netwCol
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"color = \"{input$netwCol}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
netwShape
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"shape = \"{input$netwShape}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
netwLabel
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"label = \"{input$netwLabel}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
netwTitle
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"title = \"{input$netwTitle}\""
))
}
script
<-
c
(
scriptHead
,
"# Plot samples network"
,
glue
(
"g <- make_network(data, distance = \"{input$richnessBDist}\", max.dist = {input$netwMax}, keep.isolates = {input$netwOrphan})"
),
glue
(
"p <- plot_network({glue_collapse(scriptArgs, sep=', ')})"
)
)
script
<-
c
(
script
,
""
,
"plot(p)"
)
return
(
glue_collapse
(
script
,
sep
=
"\n"
))
})
output
$
networkB
<-
renderPlot
({
...
...
@@ -942,8 +977,48 @@ shinyServer
"median"
,
"centroid"
)
),
collapsedBox
(
verbatimTextOutput
(
"heatmapScript"
),
title
=
"RCode"
)
)
})
output
$
heatmapScript
<-
renderText
({
scriptArgs
<-
c
(
glue
(
"prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$heatmapTopOtu}]), data)"
),
glue
(
"distance = \"{input$heatmapDist}\""
),
glue
(
"method = \"{input$heatmapMethod}\""
),
"low = \"yellow\""
,
"high = \"red\""
,
"na.value = \"white\""
)
if
(
!
is.null
(
checkNull
(
input
$
heatmapX
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"sample.order = \"{input$heatmapX}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
heatmapTitle
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"title = \"{input$heatmapTitle}\""
))
}
script
<-
c
(
scriptHead
,
"# Plot heatmap"
,
glue
(
"p <- plot_heatmap({glue_collapse(scriptArgs, sep=', ')})"
)
)
if
(
!
is.null
(
checkNull
(
input
$
heatmapGrid
)))
{
script
<-
c
(
script
,
glue
(
"p <- p + facet_grid(\". ~ {input$heatmapGrid}\", scales = \"free_x\")"
)
)
}
script
<-
c
(
script
,
""
,
"plot(p)"
)
return
(
glue_collapse
(
script
,
sep
=
"\n"
))
})
output
$
Heatmap
<-
renderPlot
({
...
...
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