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
S
shiny-timecourse-inspector
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
2
Issues
2
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
pertz-lab
shiny-timecourse-inspector
Commits
49b9d1e6
Commit
49b9d1e6
authored
Jul 27, 2017
by
dmattek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added:
- optional stats in time series plotting - optional overlap of boxplot/violin/dotplot
parent
edae527e
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
80 additions
and
30 deletions
+80
-30
modules/auxfunc.R
modules/auxfunc.R
+36
-4
modules/tabBoxPlot.R
modules/tabBoxPlot.R
+40
-24
server.R
server.R
+2
-1
ui.R
ui.R
+2
-1
No files found.
modules/auxfunc.R
View file @
49b9d1e6
...
...
@@ -69,7 +69,12 @@ myGgplotTraj = function(dt.arg,
stim.bar.height.arg
=
0.1
,
stim.bar.width.arg
=
0.5
,
aux.label1
=
NULL
,
aux.label2
=
NULL
)
{
aux.label2
=
NULL
,
stat.arg
=
c
(
''
,
'mean'
,
'CI'
,
'SE'
))
{
# match arguments for stat plotting
loc.stat
=
match.arg
(
stat.arg
,
several.ok
=
TRUE
)
# aux.label12 are required for plotting XY positions in the tooltip of the interactive (plotly) graph
p.tmp
=
ggplot
(
dt.arg
,
...
...
@@ -93,16 +98,43 @@ myGgplotTraj = function(dt.arg,
values
=
c
(
"FALSE"
=
rhg_cols
[
7
],
"TRUE"
=
rhg_cols
[
3
],
"SELECTED"
=
'green'
,
"NOT SEL"
=
rhg_cols
[
7
]))
}
p.tmp
=
p.tmp
+
if
(
'mean'
%in%
loc.stat
)
p.tmp
=
p.tmp
+
stat_summary
(
aes_string
(
y
=
y.arg
,
group
=
1
),
fun.y
=
mean
,
colour
=
'
blue
'
,
colour
=
'
red
'
,
linetype
=
'solid'
,
size
=
1
,
geom
=
"line"
,
group
=
1
)
+
)
if
(
'CI'
%in%
loc.stat
)
p.tmp
=
p.tmp
+
stat_summary
(
aes_string
(
y
=
y.arg
,
group
=
1
),
fun.data
=
mean_cl_normal
,
colour
=
'red'
,
alpha
=
0.5
,
geom
=
"ribbon"
,
group
=
1
)
if
(
'SE'
%in%
loc.stat
)
p.tmp
=
p.tmp
+
stat_summary
(
aes_string
(
y
=
y.arg
,
group
=
1
),
fun.data
=
mean_se
,
colour
=
'red'
,
alpha
=
0.5
,
geom
=
"ribbon"
,
group
=
1
)
p.tmp
=
p.tmp
+
facet_wrap
(
as.formula
(
paste
(
"~"
,
facet.arg
)),
ncol
=
facet.ncol.arg
,
scales
=
"free_x"
)
...
...
modules/tabBoxPlot.R
View file @
49b9d1e6
...
...
@@ -19,10 +19,10 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
fluidRow
(
column
(
4
,
radioButtons
(
ns
(
'inPlotType'
),
'Plot type:'
,
list
(
'Box-plot'
=
'box
'
,
'Dot-plot'
=
'dot'
,
'Violin-plot'
=
'viol'
,
'Line-plot'
=
'line'
)
),
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!'
)
),
...
...
@@ -40,6 +40,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
),
uiOutput
(
ns
(
'uiPlotBoxNotches'
)),
uiOutput
(
ns
(
'uiPlotBoxOutliers'
)),
uiOutput
(
ns
(
'uiPlotBoxAlpha'
)),
uiOutput
(
ns
(
'uiPlotDotNbins'
))
),
column
(
...
...
@@ -139,8 +140,8 @@ tabBoxPlot = function(input, output, session, in.data) {
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'box'
)
checkboxInput
(
ns
(
'inPlotBoxNotches'
),
'Box plot notches?'
,
FALSE
)
if
(
'box'
%in%
input
$
inPlotType
)
checkboxInput
(
ns
(
'inPlotBoxNotches'
),
'Box plot notches?'
,
FALSE
)
})
output
$
uiPlotBoxOutliers
=
renderUI
({
...
...
@@ -148,17 +149,26 @@ tabBoxPlot = function(input, output, session, in.data) {
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'box'
)
if
(
'box'
%in%
input
$
inPlotType
)
checkboxInput
(
ns
(
'inPlotBoxOutliers'
),
'Box plot outliers?'
,
FALSE
)
})
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.1
)
})
output
$
uiPlotDotNbins
=
renderUI
({
cat
(
file
=
stderr
(),
'UI uiPlotDotNbins\n'
)
ns
<-
session
$
ns
if
(
input
$
inPlotType
==
'dot'
)
sliderInput
(
ns
(
'inPlotDotNbins'
),
'Dot-plot bin size (10^x):'
,
min
=
-4
,
max
=
4
,
value
=
0
,
step
=
0.1
)
if
(
'dot'
%in%
input
$
inPlotType
)
sliderInput
(
ns
(
'inPlotDotNbins'
),
'Dot-plot bin size (10^x):'
,
min
=
-4
,
max
=
4
,
value
=
-1.5
,
step
=
0.1
)
})
...
...
@@ -298,28 +308,34 @@ tabBoxPlot = function(input, output, session, in.data) {
cat
(
file
=
stderr
(),
'plotBox:dt not NULL\n'
)
loc.par.dodge
<-
position_dodge
(
width
=
0.4
)
p.out
=
ggplot
(
loc.dt
,
aes
(
x
=
as.factor
(
realtime
),
y
=
y
))
if
(
input
$
inPlotType
==
'box'
)
if
(
'dot'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_dotplot
(
aes
(
fill
=
group
),
binaxis
=
"y"
,
stackdir
=
"center"
,
position
=
loc.par.dodge
,
binwidth
=
10
^
(
input
$
inPlotDotNbins
),
method
=
'histodot'
)
if
(
'viol'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_violin
(
aes
(
fill
=
group
),
position
=
loc.par.dodge
,
width
=
0.2
)
if
(
'line'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_path
(
aes
(
color
=
group
,
group
=
id
))
+
facet_wrap
(
~
group
)
if
(
'box'
%in%
input
$
inPlotType
)
p.out
=
p.out
+
geom_boxplot
(
aes
(
fill
=
group
),
#position = position_dodge(width = 1),
notch
=
input
$
inPlotBoxNotches
,
aes
(
fill
=
group
),
position
=
loc.par.dodge
,
width
=
0.2
,
notch
=
input
$
inPlotBoxNotches
,
alpha
=
input
$
inPlotBoxAlpha
,
outlier.colour
=
if
(
input
$
inPlotBoxOutliers
)
'red'
else
NA
)
if
(
input
$
inPlotType
==
'dot'
)
p.out
=
p.out
+
geom_dotplot
(
aes
(
fill
=
group
),
binaxis
=
"y"
,
stackdir
=
"center"
,
position
=
"dodge"
,
binwidth
=
10
^
(
input
$
inPlotDotNbins
),
method
=
'histodot'
)
if
(
input
$
inPlotType
==
'viol'
)
p.out
=
p.out
+
geom_violin
(
aes
(
fill
=
group
))
if
(
input
$
inPlotType
==
'line'
)
p.out
=
p.out
+
geom_path
(
aes
(
color
=
group
,
group
=
id
))
)
p.out
=
p.out
+
scale_fill_discrete
(
name
=
''
)
+
...
...
server.R
View file @
49b9d1e6
...
...
@@ -787,7 +787,8 @@ shinyServer(function(input, output, session) {
xlab.arg
=
'Time (min)'
,
line.col.arg
=
loc.line.col.arg
,
aux.label1
=
if
(
locPos
)
'pos.x'
else
NULL
,
aux.label2
=
if
(
locPos
)
'pos.y'
else
NULL
aux.label2
=
if
(
locPos
)
'pos.y'
else
NULL
,
stat.arg
=
input
$
chBPlotTrajStat
)
return
(
p.out
)
...
...
ui.R
View file @
49b9d1e6
...
...
@@ -93,7 +93,8 @@ shinyUI(fluidPage(
),
column
(
4
,
sliderInput
(
'sliPlotTrajSkip'
,
'Plot every n-th point:'
,
min
=
1
,
max
=
10
,
value
=
1
,
step
=
1
)
sliderInput
(
'sliPlotTrajSkip'
,
'Plot every n-th point:'
,
min
=
1
,
max
=
10
,
value
=
1
,
step
=
1
),
checkboxGroupInput
(
'chBPlotTrajStat'
,
'Stats:'
,
list
(
'Mean'
=
'mean'
,
'95% conf. interv.'
=
'CI'
,
'Std. error'
=
'SE'
))
),
column
(
4
,
...
...
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