Commit 49b9d1e6 authored by dmattek's avatar dmattek

Added:

- optional stats in time series plotting
- optional overlap of boxplot/violin/dotplot
parent edae527e
......@@ -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")
......
......@@ -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 = '') +
......
......@@ -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)
......
......@@ -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,
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment