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
5cdae939
Commit
5cdae939
authored
Dec 10, 2018
by
Midoux Cedric
Browse files
mdsUI
parent
6f478fa6
Changes
2
Hide whitespace changes
Inline
Side-by-side
server.R
View file @
5cdae939
...
...
@@ -1185,21 +1185,21 @@ shinyServer
}
})
output
$
acp
UI
<-
renderUI
({
output
$
mds
UI
<-
renderUI
({
validate
(
need
(
data16S
(),
""
))
box
(
title
=
"Setting : "
,
width
=
NULL
,
status
=
"primary"
,
checkboxGroupInput
(
"
acp
Axes"
,
"
mds
Axes"
,
label
=
"Axes : "
,
choices
=
seq
(
10
),
selected
=
c
(
1
,
2
),
inline
=
TRUE
),
selectInput
(
"
acp
Dist"
,
"
mds
Dist"
,
label
=
"Distance : "
,
selected
=
"bray"
,
choices
=
list
(
...
...
@@ -1213,78 +1213,78 @@ shinyServer
)
),
selectInput
(
"
acp
Method"
,
"
mds
Method"
,
label
=
"Method : "
,
selected
=
"MDS"
,
choices
=
list
(
"DCA"
,
"CCA"
,
"RDA"
,
"CAP"
,
"DPCoA"
,
"NMDS"
,
"MDS"
,
"PCoA"
)
),
textInput
(
"
acp
Title"
,
textInput
(
"
mds
Title"
,
label
=
"Title : "
,
value
=
"Samples ordination graphic"
),
selectInput
(
"
acp
Label"
,
"
mds
Label"
,
label
=
"Label : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
()))
),
selectInput
(
"
acp
Col"
,
"
mds
Col"
,
label
=
"Color : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
()))
),
selectInput
(
"
acp
Shape"
,
"
mds
Shape"
,
label
=
"Shape : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
()))
),
selectInput
(
"
acp
Ellipse"
,
"
mds
Ellipse"
,
label
=
"Ellipses : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
()))
),
selectInput
(
"
acp
Rep"
,
"
mds
Rep"
,
label
=
"Barycenters : "
,
choices
=
c
(
"..."
=
0
,
sample_variables
(
data16S
()))
),
collapsedBox
(
verbatimTextOutput
(
"
acp
Script"
),
title
=
"RCode"
)
collapsedBox
(
verbatimTextOutput
(
"
mds
Script"
),
title
=
"RCode"
)
)
})
output
$
acp
Script
<-
renderText
({
output
$
mds
Script
<-
renderText
({
scriptArgs
<-
c
(
"physeq = data"
,
glue
(
"ordination = ordinate(data, method = \"{input$
acp
Method}\", distance = \"{input$
acp
Dist}\")"
"ordination = ordinate(data, method = \"{input$
mds
Method}\", distance = \"{input$
mds
Dist}\")"
),
glue
(
"axes = c({glue_collapse(input$
acp
Axes, sep = ', ')})"
)
glue
(
"axes = c({glue_collapse(input$
mds
Axes, sep = ', ')})"
)
)
if
(
!
is.null
(
checkNull
(
input
$
acp
Col
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"color = \"{input$
acp
Col}\""
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Col
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"color = \"{input$
mds
Col}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
acp
Shape
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"shape = \"{input$
acp
Shape}\""
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Shape
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"shape = \"{input$
mds
Shape}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
acp
Rep
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"replicate = \"{input$
acp
Rep}\""
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Rep
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"replicate = \"{input$
mds
Rep}\""
))
}
else
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"replicate = NULL"
))
}
if
(
!
is.null
(
checkNull
(
input
$
acp
Label
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"label = \"{input$
acp
Label}\""
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Label
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"label = \"{input$
mds
Label}\""
))
}
if
(
!
is.null
(
checkNull
(
input
$
acp
Title
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"title = \"{input$
acp
Title}\""
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Title
)))
{
scriptArgs
<-
c
(
scriptArgs
,
glue
(
"title = \"{input$
mds
Title}\""
))
}
script
<-
c
(
scriptHead
,
"# MultiDimensional scaling"
,
glue
(
"p <- plot_samples({glue_collapse(scriptArgs, sep=', ')})"
)
)
if
(
!
is.null
(
checkNull
(
input
$
acp
Ellipse
)))
{
if
(
!
is.null
(
checkNull
(
input
$
mds
Ellipse
)))
{
script
<-
c
(
script
,
glue
(
"p <- p + stat_ellipse(aes_string(group = \"{input$
acp
Ellipse}\"))"
"p <- p + stat_ellipse(aes_string(group = \"{input$
mds
Ellipse}\"))"
)
)
}
...
...
@@ -1293,31 +1293,31 @@ shinyServer
return
(
glue_collapse
(
script
,
sep
=
"\n"
))
})
output
$
acp
<-
renderPlot
({
output
$
mds
<-
renderPlot
({
validate
(
need
(
data16S
(),
"Requires an abundance dataset"
),
need
(
length
(
input
$
acp
Axes
)
==
2
,
"Requires two projections axes"
)
need
(
length
(
input
$
mds
Axes
)
==
2
,
"Requires two projections axes"
)
)
p
<-
plot_samples
(
data16S
(),
ordination
=
ordinate
(
data16S
(),
method
=
input
$
acp
Method
,
distance
=
input
$
acp
Dist
method
=
input
$
mds
Method
,
distance
=
input
$
mds
Dist
),
axes
=
as.numeric
(
input
$
acp
Axes
),
title
=
checkNull
(
input
$
acp
Title
),
color
=
checkNull
(
input
$
acp
Col
),
replicate
=
if
(
is.null
(
checkNull
(
input
$
acp
Rep
)))
{
axes
=
as.numeric
(
input
$
mds
Axes
),
title
=
checkNull
(
input
$
mds
Title
),
color
=
checkNull
(
input
$
mds
Col
),
replicate
=
if
(
is.null
(
checkNull
(
input
$
mds
Rep
)))
{
NULL
}
else
{
checkNull
(
input
$
acp
Rep
)
checkNull
(
input
$
mds
Rep
)
},
shape
=
checkNull
(
input
$
acp
Shape
),
label
=
checkNull
(
input
$
acp
Label
)
shape
=
checkNull
(
input
$
mds
Shape
),
label
=
checkNull
(
input
$
mds
Label
)
)
if
(
!
is.null
(
checkNull
(
input
$
acp
Ellipse
)))
{
p
<-
p
+
stat_ellipse
(
aes_string
(
group
=
input
$
acp
Ellipse
))
if
(
!
is.null
(
checkNull
(
input
$
mds
Ellipse
)))
{
p
<-
p
+
stat_ellipse
(
aes_string
(
group
=
input
$
mds
Ellipse
))
}
return
(
p
+
theme_bw
())
})
...
...
ui.R
View file @
5cdae939
...
...
@@ -155,8 +155,8 @@ shinyUI(dashboardPage(
),
tabPanel
(
"MultiDimensional Scaling"
,
withLoader
(
plotOutput
(
"
acp
"
,
height
=
700
)),
uiOutput
(
"
acp
UI"
)
withLoader
(
plotOutput
(
"
mds
"
,
height
=
700
)),
uiOutput
(
"
mds
UI"
)
),
tabPanel
(
"Phylogenetic tree"
,
...
...
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