Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
082b907a
Commit
082b907a
authored
Oct 02, 2019
by
dmattek
Browse files
Bug fixes
parent
c167348d
Changes
13
Hide whitespace changes
Inline
Side-by-side
global.R
View file @
082b907a
...
...
@@ -7,10 +7,11 @@ source('modules/dispTrackStats.R')
source
(
'modules/trajPlot.R'
)
source
(
'modules/trajRibbonPlot.R'
)
source
(
'modules/trajPsdPlot.R'
)
source
(
'modules/
box
Plot.R'
)
source
(
'modules/
tabAUC
.R'
)
source
(
'modules/
auc
Plot.R'
)
source
(
'modules/
distPlot
.R'
)
source
(
'modules/clDistPlot.R'
)
source
(
'modules/tabScatter.R'
)
source
(
'modules/tabBoxPlot.R'
)
source
(
'modules/tabDist.R'
)
source
(
'modules/tabAUC.R'
)
source
(
'modules/tabClHier.R'
)
source
(
'modules/tabClHierSpar.R'
)
\ No newline at end of file
modules/
box
Plot.R
→
modules/
auc
Plot.R
View file @
082b907a
...
...
@@ -2,7 +2,7 @@
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting a choice of box/violin/dot-plots
# This module is for plotting
AUC as
a choice of box/violin/dot-plots
# Assumes in.data contains columns:
# realtime
# y
...
...
@@ -10,44 +10,46 @@
# id
# UI ----
mod
BoxP
lotUI
=
function
(
id
,
label
=
"Plot
Box-plot
s"
)
{
mod
AUCp
lotUI
=
function
(
id
,
label
=
"Plot
AUC distribution
s"
)
{
ns
<-
NS
(
id
)
tagList
(
fluidRow
(
column
(
4
,
checkboxGroupInput
(
ns
(
'inPlotType'
),
'Plot type:'
,
list
(
'Dot-plot'
=
'dot'
,
'Violin-plot'
=
'viol'
,
'Box-plot'
=
'box'
,
'Line-plot'
=
'line'
),
selected
=
'box'
),
checkboxInput
(
ns
(
'chBPlotBoxInt'
),
'Interactive Plot'
),
actionButton
(
ns
(
'butPlotBox'
),
'Plot!'
)
checkboxInput
(
ns
(
"chBPlotTypeBox"
),
"Box-plot"
,
value
=
T
),
checkboxInput
(
ns
(
"chBPlotTypeDot"
),
"Dot-plot"
,
value
=
F
),
checkboxInput
(
ns
(
"chBPlotTypeViol"
),
"Violin-plot"
,
value
=
F
),
checkboxInput
(
ns
(
'chBPlotInt'
),
'Interactive Plot'
),
actionButton
(
ns
(
'butPlot'
),
'Plot!'
)
),
column
(
4
,
uiOutput
(
ns
(
'uiPlotBoxNotches'
)),
uiOutput
(
ns
(
'uiPlotBoxOutliers'
)),
uiOutput
(
ns
(
'uiPlotDotNbins'
)),
uiOutput
(
ns
(
'uiPlotDotShade'
))
),
column
(
4
,
selectInput
(
ns
(
'selPlot
Box
LegendPos'
),
ns
(
'selPlotLegendPos'
),
label
=
'Legend position'
,
choices
=
list
(
"Top"
=
'top'
,
"Right"
=
'right'
,
"Bottom"
=
'bottom'
),
),
width
=
"120px"
,
selected
=
'top'
),
uiOutput
(
ns
(
'uiPlotBoxNotches'
)),
uiOutput
(
ns
(
'uiPlotBoxOutliers'
)),
uiOutput
(
ns
(
'uiPlotBoxDodge'
)),
#uiOutput(ns('uiPlotBoxWidth')),
uiOutput
(
ns
(
'uiPlotBoxAlpha'
)),
uiOutput
(
ns
(
'uiPlotDotNbins'
))
),
column
(
4
,
radioButtons
(
ns
(
"rBAxisLabelsRotate"
),
"X-axis labels"
,
c
(
"horizontal"
=
0
,
"45 deg"
=
45
,
"90 deg"
=
90
)),
numericInput
(
ns
(
'inPlotBoxWidth'
),
'Width [%]
:
'
,
'Width [%]'
,
value
=
PLOTWIDTH
,
min
=
10
,
width
=
'100px'
,
...
...
@@ -55,16 +57,12 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
),
numericInput
(
ns
(
'inPlotBoxHeight'
),
'Height [px]
:
'
,
'Height [px]'
,
value
=
PLOTBOXHEIGHT
,
min
=
100
,
width
=
'100px'
,
step
=
50
),
radioButtons
(
ns
(
"rBAxisLabelsRotate"
),
"X-axis labels:"
,
c
(
"horizontal"
=
0
,
"45 deg"
=
45
,
"90 deg"
=
90
))
)
)
),
...
...
@@ -74,76 +72,63 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
}
# SERVER ----
mod
BoxP
lot
=
function
(
input
,
output
,
session
,
in.data
,
in.cols
=
list
(
meas.x
=
COLRT
,
mod
AUCp
lot
=
function
(
input
,
output
,
session
,
in.data
,
# input data table in long format
in.cols
=
list
(
meas.x
=
COLRT
,
# column names
meas.y
=
COLY
,
group
=
COLGR
,
id
=
COLID
),
in.fname
)
{
in.labels
=
list
(
x
=
""
,
# plot labels
y
=
""
,
legend
=
""
),
in.fname
)
{
# file name for saving the plot
ns
<-
session
$
ns
# optional UI depending on the type of the plot chosen
output
$
uiPlotBoxNotches
=
renderUI
({
cat
(
file
=
stderr
(),
'
UI
uiPlotBoxNotches\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
uiPlotBoxNotches\n'
)
ns
<-
session
$
ns
if
(
'box'
%in%
input
$
in
PlotType
)
checkboxInput
(
ns
(
'
inP
lotBoxNotches'
),
'
Box plot notches
'
,
FALSE
)
if
(
input
$
chB
PlotType
Box
)
checkboxInput
(
ns
(
'
chBp
lotBoxNotches'
),
'
Notches in box-plot
'
,
FALSE
)
})
output
$
uiPlotBoxOutliers
=
renderUI
({
cat
(
file
=
stderr
(),
'
UI
uiPlotBoxNotches\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
uiPlotBoxNotches\n'
)
ns
<-
session
$
ns
if
(
'box'
%in%
input
$
in
PlotType
)
checkboxInput
(
ns
(
'
inP
lotBoxOutliers'
),
'
Box plot outliers
'
,
FALSE
)
if
(
input
$
chB
PlotType
Box
)
checkboxInput
(
ns
(
'
chBp
lotBoxOutliers'
),
'
Outliers in box-plot
'
,
FALSE
)
})
output
$
uiPlotBoxDodge
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotBoxDodge\n'
)
ns
<-
session
$
ns
if
(
!
(
'line'
%in%
input
$
inPlotType
))
sliderInput
(
ns
(
'inPlotBoxDodge'
),
'Space between groups:'
,
min
=
0
,
max
=
1
,
value
=
.4
,
step
=
0.05
)
})
output
$
uiPlot
BoxWidth
=
renderUI
({
cat
(
file
=
stderr
(),
'
UI uiPlotBoxWidth
\n'
)
output
$
uiPlot
DotShade
=
renderUI
({
cat
(
file
=
stderr
(),
'
aucPlot:uiPlotDotShade
\n'
)
ns
<-
session
$
ns
if
(
'box'
%in%
input
$
inPlotType
)
sliderInput
(
ns
(
'inPlotBoxWidth'
),
'Box plot width:'
,
min
=
0
,
max
=
1
,
value
=
.2
,
step
=
0.1
)
})
output
$
uiPlotBoxAlpha
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotBoxAlpha\n'
)
ns
<-
session
$
ns
if
(
'box'
%in%
input
$
inPlotType
)
sliderInput
(
ns
(
'inPlotBoxAlpha'
),
'Box plot transparency:'
,
min
=
0
,
max
=
1
,
value
=
1
,
step
=
0.05
)
if
(
input
$
chBPlotTypeDot
)
sliderInput
(
ns
(
'slPlotDotShade'
),
"Shade of grey in dot-plot"
,
min
=
0
,
max
=
1
,
value
=
0.5
,
step
=
0.1
)
})
output
$
uiPlotDotNbins
=
renderUI
({
cat
(
file
=
stderr
(),
'
UI
uiPlotDotNbins\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
uiPlotDotNbins\n'
)
ns
<-
session
$
ns
if
(
'dot'
%in%
input
$
in
PlotType
)
sliderInput
(
ns
(
'
in
PlotDotNbins'
),
'
#B
ins
for
dot-plot
:
'
,
min
=
2
,
max
=
50
,
value
=
30
,
step
=
1
)
if
(
input
$
chB
PlotType
Dot
)
sliderInput
(
ns
(
'
sl
PlotDotNbins'
),
'
Number of b
ins
in
dot-plot'
,
min
=
2
,
max
=
50
,
value
=
30
,
step
=
1
)
})
# Boxplot - display
output
$
outPlotBox
=
renderPlot
({
locBut
=
input
$
butPlot
Box
locBut
=
input
$
butPlot
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'
plotBox:
Go button not pressed\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
Go button not pressed\n'
)
return
(
NULL
)
}
...
...
@@ -153,10 +138,10 @@ modBoxPlot = function(input, output, session,
output
$
outPlotBoxInt
=
renderPlotly
({
locBut
=
input
$
butPlot
Box
locBut
=
input
$
butPlot
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'
plotBox:
Go button not pressed\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
Go button not pressed\n'
)
return
(
NULL
)
}
...
...
@@ -175,7 +160,7 @@ modBoxPlot = function(input, output, session,
output
$
uiPlotBox
<-
renderUI
({
ns
<-
session
$
ns
if
(
input
$
chBPlot
Box
Int
)
if
(
input
$
chBPlotInt
)
plotlyOutput
(
ns
(
"outPlotBoxInt"
),
width
=
paste0
(
input
$
inPlotBoxWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotBoxHeight
,
'px'
))
...
...
@@ -193,7 +178,7 @@ modBoxPlot = function(input, output, session,
# This function is used to plot and to downoad a pdf
plotBox
<-
function
()
{
cat
(
file
=
stderr
(),
'plotBox\n'
)
cat
(
file
=
stderr
(),
'
aucPlot:
plotBox\n'
)
loc.dt
=
in.data
()
...
...
@@ -205,54 +190,56 @@ modBoxPlot = function(input, output, session,
cat
(
file
=
stderr
(),
'plotBox:dt not NULL\n'
)
loc.par.dodge
<-
position_dodge
(
width
=
input
$
inPlotBoxDodge
)
p.out
=
ggplot
(
loc.dt
,
aes_string
(
x
=
sprintf
(
"factor(%s)"
,
in.cols
$
meas.x
),
y
=
in.cols
$
meas.y
))
p.out
=
ggplot
(
loc.dt
,
aes_string
(
x
=
sprintf
(
"factor(%s)"
,
in.cols
$
meas.x
),
y
=
in.cols
$
meas.y
))
if
(
'dot'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_dotplot
(
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
if
(
input
$
chBPlotTypeDot
)
{
# calculate bin width for dot-plot based on nBins provided in the UI
loc.binwidth
=
abs
(
max
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
)
-
min
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
))
/
(
input
$
slPlotDotNbins
-
1
)
p.out
=
p.out
+
geom_dotplot
(
fill
=
grey
(
input
$
slPlotDotShade
),
color
=
NA
,
binaxis
=
in.cols
$
meas.y
,
binaxis
=
"y"
,
stackdir
=
"center"
,
position
=
loc.par.dodge
,
binwidth
=
abs
(
max
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
)
-
min
(
loc.dt
[[
in.cols
$
meas.y
]],
na.rm
=
T
))
/
(
input
$
inPlotDotNbins
-
1
),
binwidth
=
loc.binwidth
,
method
=
'histodot'
)
}
if
(
'viol'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_violin
(
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
position
=
loc.par.dodge
,
width
=
0.2
)
if
(
'line'
%in%
input
$
inPlotType
)
if
(
input
$
chBPlotTypeViol
)
p.out
=
p.out
+
geom_path
(
aes_string
(
color
=
in.cols
[[
COLGR
]],
group
=
in.cols
[[
COLID
]]))
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
in.cols
[[
COLGR
]])))
geom_violin
(
fill
=
NA
,
color
=
"black"
,
width
=
0.2
)
if
(
'box'
%in%
input
$
in
PlotType
)
if
(
input
$
chB
PlotType
Box
)
p.out
=
p.out
+
geom_boxplot
(
aes_string
(
fill
=
in.cols
[[
COLGR
]]),
position
=
loc.par.dodge
,
#width = 0.2, #input$inPlotBoxWidth,
notch
=
input
$
inPlotBoxNotches
,
alpha
=
input
$
inPlotBoxAlpha
,
outlier.colour
=
if
(
input
$
inPlotBoxOutliers
)
fill
=
NA
,
color
=
"black"
,
notch
=
input
$
chBplotBoxNotches
,
outlier.colour
=
if
(
input
$
chBplotBoxOutliers
)
'red'
else
NA
)
p.out
=
p.out
+
scale_fill_discrete
(
name
=
''
)
+
xlab
(
''
)
+
ylab
(
''
)
+
scale_fill_discrete
(
name
=
in.labels
$
legend
)
+
xlab
(
in.labels
$
x
)
+
ylab
(
in.labels
$
y
)
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
in.font.axis.text
=
PLOTFONTAXISTEXT
,
in.font.axis.title
=
PLOTFONTAXISTITLE
,
in.font.strip
=
PLOTFONTFACETSTRIP
,
in.font.legend
=
PLOTFONTLEGEND
)
+
theme
(
legend.position
=
input
$
selPlot
Box
LegendPos
,
theme
(
legend.position
=
input
$
selPlotLegendPos
,
axis.text.x
=
LOCrotatedAxisElementText
(
as.numeric
(
input
$
rBAxisLabelsRotate
),
size
=
PLOTFONTAXISTEXT
))
return
(
p.out
)
}
...
...
modules/auxfunc.R
View file @
082b907a
...
...
@@ -129,16 +129,16 @@ l.col.pal.dend.2 = list(
# Clustering algorithms ----
s.cl.linkage
=
c
(
"
averag
e"
,
"
complet
e"
,
s.cl.linkage
=
c
(
"
complet
e"
,
"
averag
e"
,
"single"
,
"centroid"
,
"ward.D"
,
"ward.D2"
,
"mcquitty"
)
s.cl.spar.linkage
=
c
(
"
averag
e"
,
"
complet
e"
,
s.cl.spar.linkage
=
c
(
"
complet
e"
,
"
averag
e"
,
"single"
,
"centroid"
)
...
...
@@ -191,10 +191,9 @@ help.text.short = c(
'Normalise with respect to this time span.'
,
#12
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.'
,
#13
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.'
,
#14
'Instead of the value at a selected time point, y-axis can display a difference between values at t
ime points on y- and x-axis.'
,
#15
'Instead of the value at a selected time point, y-axis can display a difference between values at t
wo selected time points.'
,
#15
'Add a line with linear regression and regions of 95% confidence interval.'
,
#16
'A number of time points left & right of selected time points; use the mean/min/max of values from these time points for the scatterplot.'
,
#17
'Operations to perform on values at time points selected in the field above.'
#18
'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.'
#17
)
# Functions for data processing ----
...
...
@@ -809,7 +808,7 @@ LOCggplotScat = function(dt.arg,
trend.arg
=
T
,
ci.arg
=
0.95
)
{
p.tmp
=
ggplot
(
dt.arg
,
aes
(
x
=
x
,
y
=
y
))
+
p.tmp
=
ggplot
(
dt.arg
,
aes
(
x
=
x
,
y
=
y
,
label
=
id
))
+
geom_point
(
alpha
=
alpha.arg
)
if
(
trend.arg
)
{
...
...
modules/clDistPlot.R
View file @
082b907a
...
...
@@ -65,7 +65,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out
=
p.out
+
scale_y_continuous
(
labels
=
percent
)
+
ylab
(
"Percentage of time
-
series\n"
)
+
ylab
(
"Percentage of time
series\n"
)
+
xlab
(
"Groups"
)
+
LOCggplotTheme
(
in.font.base
=
PLOTFONTBASE
,
in.font.axis.text
=
PLOTFONTAXISTEXT
,
...
...
modules/distPlot.R
0 → 100644
View file @
082b907a
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting distrubutions at selected time points as a choice of box/violin/dot-plots
# Assumes in.data contains columns:
# realtime
# y
# group
# id
# UI ----
modDistPlotUI
=
function
(
id
,
label
=
"Plot distributions"
)
{
ns
<-
NS
(
id
)
tagList
(
fluidRow
(
column
(
4
,
checkboxInput
(
ns
(
"chBplotTypeBox"
),
"Box-plot"
,
value
=
T
),
checkboxInput
(
ns
(
"chBplotTypeDot"
),
"Dot-plot"
,
value
=
F
),
checkboxInput
(
ns
(
"chBplotTypeViol"
),
"Violin-plot"
,
value
=
F
),
checkboxInput
(
ns
(
"chBplotTypeLine"
),
"Line-plot"
,
value
=
F
),
checkboxInput
(
ns
(
'chBplotInt'
),
'Interactive Plot'
),
actionButton
(
ns
(
'butPlot'
),
'Plot!'
)
),
column
(
4
,
uiOutput
(
ns
(
'uiPlotBoxNotches'
)),
uiOutput
(
ns
(
'uiPlotBoxOutliers'
)),
uiOutput
(
ns
(
'uiPlotBoxDodge'
)),
uiOutput
(
ns
(
'uiPlotBoxAlpha'
)),
uiOutput
(
ns
(
'uiPlotDotNbins'
)),
uiOutput
(
ns
(
'uiPlotDotAlpha'
)),
uiOutput
(
ns
(
'uiPlotViolAlpha'
)),
uiOutput
(
ns
(
'uiPlotLineAlpha'
))
),
column
(
4
,
selectInput
(
ns
(
'selPlotBoxLegendPos'
),
label
=
'Legend position'
,
choices
=
list
(
"Top"
=
'top'
,
"Right"
=
'right'
,
"Bottom"
=
'bottom'
),
width
=
"120px"
,
selected
=
'top'
),
radioButtons
(
ns
(
"rBAxisLabelsRotate"
),
"X-axis labels"
,
c
(
"horizontal"
=
0
,
"45 deg"
=
45
,
"90 deg"
=
90
)),
numericInput
(
ns
(
'inPlotBoxWidth'
),
'Width [%]'
,
value
=
PLOTWIDTH
,
min
=
10
,
width
=
'100px'
,
step
=
10
),
numericInput
(
ns
(
'inPlotBoxHeight'
),
'Height [px]'
,
value
=
PLOTBOXHEIGHT
,
min
=
100
,
width
=
'100px'
,
step
=
50
)
)
),
uiOutput
(
ns
(
'uiPlotBox'
)),
downPlotUI
(
ns
(
'downPlotBox'
),
"Download PDF"
)
)
}
# SERVER ----
modDistPlot
=
function
(
input
,
output
,
session
,
in.data
,
# input data table in long format
in.cols
=
list
(
meas.x
=
COLRT
,
# column names
meas.y
=
COLY
,
group
=
COLGR
,
id
=
COLID
),
in.labels
=
list
(
x
=
""
,
# plot labels
y
=
""
,
legend
=
""
),
in.fname
)
{
# file name for saving the plot
ns
<-
session
$
ns
output
$
uiPlotBoxNotches
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotBoxNotches\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeBox
)
checkboxInput
(
ns
(
'chBplotBoxNotches'
),
'Notches in box-plot '
,
FALSE
)
})
output
$
uiPlotBoxOutliers
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotBoxOutliers\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeBox
)
checkboxInput
(
ns
(
'chBplotBoxOutliers'
),
'Outliers in box-plot'
,
FALSE
)
})
output
$
uiPlotBoxDodge
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotBoxDodge\n'
)
ns
<-
session
$
ns
# Adjust spacing between box-, violin-, dot-plots.
# Valid only when plotting multiple groups at a time point.
# For line plot, each group is drawn separately per facet, thus no need for dodging..
if
(
!
input
$
chBplotTypeLine
)
sliderInput
(
ns
(
'slPlotBoxDodge'
),
'Space between groups'
,
min
=
0
,
max
=
1
,
value
=
.4
,
step
=
0.05
)
})
output
$
uiPlotBoxAlpha
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotBoxAlpha\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeBox
)
sliderInput
(
ns
(
'slPlotBoxAlpha'
),
'Box-plot transparency'
,
min
=
0
,
max
=
1
,
value
=
1
,
step
=
0.1
)
})
output
$
uiPlotViolAlpha
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotViolAlpha\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeViol
)
sliderInput
(
ns
(
'slPlotViolAlpha'
),
'Violin-plot transparency'
,
min
=
0
,
max
=
1
,
value
=
1
,
step
=
0.1
)
})
output
$
uiPlotDotAlpha
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotDotAlpha\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeDot
)
sliderInput
(
ns
(
'slPlotDotAlpha'
),
'Dot-plot transparency'
,
min
=
0
,
max
=
1
,
value
=
1
,
step
=
0.1
)
})
output
$
uiPlotLineAlpha
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotLineAlpha\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeLine
)
sliderInput
(
ns
(
'slPlotLineAlpha'
),
'Line-plot transparency'
,
min
=
0
,
max
=
1
,
value
=
1
,
step
=
0.1
)
})
output
$
uiPlotDotNbins
=
renderUI
({
cat
(
file
=
stderr
(),
'boxPlot:uiPlotDotNbins\n'
)
ns
<-
session
$
ns
if
(
input
$
chBplotTypeDot
)
sliderInput
(
ns
(
'slPlotDotNbins'
),
'Number of bins in dot-plot'
,
min
=
2
,
max
=
50
,
value
=
30
,
step
=
1
)
})
# Boxplot - display
output
$
outPlotBox
=
renderPlot
({
locBut
=
input
$
butPlot
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'boxPlot:Go button not pressed\n'
)
return
(
NULL
)
}
plotBox
()
})
output
$
outPlotBoxInt
=
renderPlotly
({
locBut
=
input
$
butPlot
if
(
locBut
==
0
)
{
cat
(
file
=
stderr
(),
'boxPlot:Go button not pressed\n'
)
return
(
NULL
)
}
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if
(
names
(
dev.cur
())
!=
"null device"
)
dev.off
()
pdf
(
NULL
)
return
(
ggplotly
(
plotBox
())
%>%
layout
(
boxmode
=
'group'
,
width
=
'100%'
,
height
=
'100%'
))
})
output
$
uiPlotBox
<-
renderUI
({
ns
<-
session
$
ns
if
(
input
$
chBplotInt
)
plotlyOutput
(
ns
(
"outPlotBoxInt"
),
width
=
paste0
(
input
$
inPlotBoxWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotBoxHeight
,
'px'
))
else
plotOutput
(
ns
(
'outPlotBox'
),
width
=
paste0
(
input
$
inPlotBoxWidth
,
'%'
),
height
=
paste0
(
input
$
inPlotBoxHeight
,
'px'
))
})
# Boxplot - download pdf
callModule
(
downPlot
,
"downPlotBox"
,
in.fname
,
plotBox
,
TRUE
)
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r