Commit 79d2e2fe authored by dmattek's avatar dmattek

Added:

- detecting columns with X & Y positions and plotting them in interactive tcourse plot
- option to skip Metadata_Site for contructing unique trackID if it already exists in the dataset
- interactive box plots (works poorly)
- static time course plot (no interaction)
- skipping time points in tcourses
parent 4ce763a6
......@@ -67,11 +67,17 @@ myGgplotTraj = function(dt.arg,
tfreq.arg = 1,
ylim.arg = NULL,
stim.bar.height.arg = 0.1,
stim.bar.width.arg = 0.5) {
stim.bar.width.arg = 0.5,
aux.label1 = NULL,
aux.label2 = NULL) {
# aux.label12 are required for plotting XY positions in the tooltip of the interactive (plotly) graph
p.tmp = ggplot(dt.arg,
aes_string(x = x.arg,
y = y.arg,
group = group.arg))
group = group.arg,
label = aux.label1,
label2 = aux.label2))
if (is.null(line.col.arg)) {
p.tmp = p.tmp +
......
......@@ -18,14 +18,16 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
br(),
fluidRow(
column(
6,
4,
radioButtons(ns('inPlotType'), 'Plot type:', list('Box-plot' = 'box',
'Dot-plot' = 'dot',
'Violin-plot' = 'viol',
'Line-plot' = 'line'))
'Line-plot' = 'line')),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot?'),
actionButton(ns('butPlotBox'), 'Plot!')
),
column(
6,
4,
selectInput(
ns('selPlotBoxLegendPos'),
label = 'Select legend position',
......@@ -39,11 +41,29 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotDotNbins'))
),
column(
4,
numericInput(
ns('inPlotBoxWidth'),
'Width [%]:',
value = 100,
min = 10,
width = '100px',
step = 10
),
numericInput(
ns('inPlotBoxHeight'),
'Height [px]:',
value = 800,
min = 100,
width = '100px',
step = 50
)
)
),
actionButton(ns('butPlotBox'), 'Plot!'),
plotOutput(ns('outPlotBox'), height = 800),
uiOutput(ns('uiPlotBox')),
downPlotUI(ns('downPlotBox'), "Download PDF")
)
......@@ -221,7 +241,41 @@ tabBoxPlot = function(input, output, session, in.data) {
plotBox()
}, height = 800)
})
output$outPlotBoxInt = renderPlotly({
locBut = input$butPlotBox
if (locBut == 0) {
cat(file = stderr(), 'plotBox: 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$chBPlotBoxInt)
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", 'boxplot.pdf', plotBox, TRUE)
......@@ -245,7 +299,7 @@ tabBoxPlot = function(input, output, session, in.data) {
p.out = ggplot(loc.dt, aes(x = as.factor(realtime), y = y))
p.out = ggplot(loc.dt, aes(x = as.factor(realtime), y = y))
if (input$inPlotType == 'box')
p.out = p.out + geom_boxplot(
......
......@@ -29,7 +29,10 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
4,
uiOutput(ns('uiSelTptX')),
uiOutput(ns('uiSelTptY')),
checkboxInput(ns('chBfoldChange'), 'Y-axis displays difference between two t-points'),
checkboxInput(ns('chBfoldChange'), 'Y-axis displays difference between two t-points')
),
column(
4,
numericInput(ns('inNeighTpts'), '#t-pts left & right', value = 0, step = 1, min = 0),
radioButtons(ns('rBstats'), 'Operation:', list('Mean' = 1, 'Min' = 2, 'Max' = 3))
),
......@@ -37,7 +40,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
4,
numericInput(
ns('inPlotHeight'),
'Display plot height',
'Display plot height [px]',
value = 1000,
min = 100,
step = 100
......@@ -53,10 +56,10 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
),
br(),
actionButton(ns('butGoScatter'), 'Plot!'),
checkboxInput(ns('plotInt'),
'Interactive Plot?',
value = FALSE),
actionButton(ns('butGoScatter'), 'Plot!'),
uiOutput(ns("plotInt_ui")),
downPlotUI(ns('downPlotScatter'), "Download PDF")
)
......
......@@ -135,17 +135,20 @@ shinyServer(function(input, output, session) {
output$varSelSite = renderUI({
cat(file = stderr(), 'UI varSelSite\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
cat(locColSel, '\n')
selectInput(
'inSelSite',
'Select FOV (e.g. Metadata_Site or Metadata_Series):',
locCols,
width = '100%',
selected = locColSel
)
if (!input$chBtrackUni) {
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st
cat(locColSel, '\n')
selectInput(
'inSelSite',
'Select FOV (e.g. Metadata_Site or Metadata_Series):',
locCols,
width = '100%',
selected = locColSel
)
}
})
......@@ -377,16 +380,28 @@ shinyServer(function(input, output, session) {
if (is.null(loc.dt))
return(NULL)
loc.types = lapply(loc.dt, class)
if(loc.types[[input$inSelTrackLabel]] == 'numeric')
{
loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
sprintf("%04d", get(input$inSelTrackLabel)),
sep = "_")]
if (!input$chBtrackUni) {
loc.types = lapply(loc.dt, class)
if(loc.types[[input$inSelTrackLabel]] %in% c('numeric', 'integer') & loc.types[[input$inSelSite]] %in% c('numeric', 'integer'))
{
loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
sprintf("%04d", get(input$inSelTrackLabel)),
sep = "_")]
} else if(loc.types[[input$inSelTrackLabel]] %in% c('numeric', 'integer')) {
loc.dt[, trackObjectsLabelUni := paste(sprintf("%s", get(input$inSelSite)),
sprintf("%04d", get(input$inSelTrackLabel)),
sep = "_")]
} else if(loc.types[[input$inSelSite]] %in% c('numeric', 'integer')) {
loc.dt[, trackObjectsLabelUni := paste(sprintf("%03d", get(input$inSelSite)),
sprintf("%s", get(input$inSelTrackLabel)),
sep = "_")]
} else {
loc.dt[, trackObjectsLabelUni := paste(sprintf("%s", get(input$inSelSite)),
sprintf("%s", get(input$inSelTrackLabel)),
sep = "_")]
}
} else {
loc.dt[, trackObjectsLabelUni := paste(sprintf("%03s", get(input$inSelSite)),
sprintf("%s", get(input$inSelTrackLabel)),
sep = "_")]
loc.dt[, trackObjectsLabelUni := get(input$inSelTrackLabel)]
}
......@@ -482,16 +497,39 @@ shinyServer(function(input, output, session) {
loc.tracks.highlight = input$inSelHighlight
locBut = input$chBhighlightTraj
# Find column names with position
loc.s.pos.x = names(loc.dt)[names(loc.dt) %like% 'Location.*X']
loc.s.pos.y = names(loc.dt)[names(loc.dt) %like% 'Location.*Y']
if (length(loc.s.pos.x) == 1 & length(loc.s.pos.y) == 1)
locPos = TRUE
else
locPos = FALSE
# if dataset contains column mid.in with trajectory filtering status,
# then, include it in plotting
if (sum(names(loc.dt) %in% 'mid.in') > 0) {
if (locPos) # position columns present
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)),
pos.x = get(loc.s.pos.x),
pos.y = get(loc.s.pos.y),
mid.in = mid.in
)]
)] else
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)),
mid.in = mid.in
)]
# add 3rd level with status of track selection
# to a column with trajectory filtering status
......@@ -500,12 +538,22 @@ shinyServer(function(input, output, session) {
}
} else {
if (locPos) # position columns present
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt))
)]
realtime = eval(parse(text = loc.s.rt)),
pos.x = get(loc.s.pos.x),
pos.y = get(loc.s.pos.y)
)] else
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt))
)]
# add a column with status of track selection
if (locBut) {
......@@ -513,6 +561,8 @@ shinyServer(function(input, output, session) {
}
}
# add XY location if present in the dataset
# remove NAs
loc.out = loc.out[complete.cases(loc.out)]
......@@ -645,14 +695,30 @@ shinyServer(function(input, output, session) {
})
output$uiPlotTraj = renderUI({
plotlyOutput(
"plotTrajPlotly",
width = paste0(input$inPlotTrajWidth, '%'),
height = paste0(input$inPlotTrajHeight, 'px')
)
if (input$chBplotTrajInt)
plotlyOutput(
"outPlotTrajInt",
width = paste0(input$inPlotTrajWidth, '%'),
height = paste0(input$inPlotTrajHeight, 'px')
) else
plotOutput(
"outPlotTraj",
width = paste0(input$inPlotTrajWidth, '%'),
height = paste0(input$inPlotTrajHeight, 'px')
)
})
output$plotTrajPlotly <- renderPlotly({
output$outPlotTraj <- renderPlot({
loc.p = plotTraj()
if(is.null(loc.p))
return(NULL)
return(loc.p)
})
output$outPlotTrajInt <- renderPlotly({
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
......@@ -668,6 +734,8 @@ shinyServer(function(input, output, session) {
return(plotly_build(loc.p))
})
# Trajectory plot - download pdf
callModule(downPlot, "downPlotTraj", 'tcourses.pdf', plotTraj, TRUE)
......@@ -699,6 +767,15 @@ shinyServer(function(input, output, session) {
loc.line.col.arg = 'mid.in'
else
loc.line.col.arg = NULL
# select every other point for plotting
loc.dt = loc.dt[, .SD[seq(1, .N, input$sliPlotTrajSkip)], by = id]
# check if columns with XY positions are present
if (sum(names(loc.dt) %like% 'pos') == 2)
locPos = TRUE
else
locPos = FALSE
p.out = myGgplotTraj(
dt.arg = loc.dt,
......@@ -708,7 +785,9 @@ shinyServer(function(input, output, session) {
facet.arg = 'group',
facet.ncol.arg = input$inPlotTrajFacetNcol,
xlab.arg = 'Time (min)',
line.col.arg = loc.line.col.arg
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
aux.label2 = if (locPos) 'pos.y' else NULL
)
return(p.out)
......@@ -858,7 +937,7 @@ shinyServer(function(input, output, session) {
}
# download a list of cellIDs with cluster assihnments
# download a list of cellIDs with cluster assignments
output$downCellCl <- downloadHandler(
filename = function() {
paste0('clust_hierch_data_',
......@@ -892,6 +971,7 @@ shinyServer(function(input, output, session) {
# s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv'),
# getDataCl(userFitDendHier, input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim))
#
output$downloadDataClean <- downloadHandler(
filename = 'tCoursesSelected_clean.csv',
content = function(file) {
......
......@@ -30,6 +30,7 @@ shinyUI(fluidPage(
actionButton('inDataGen1', 'Generate artificial dataset'),
tags$hr(),
checkboxInput('chBtrackUni', 'Track Label unique across entire dataset', FALSE),
uiOutput('varSelSite'),
uiOutput('varSelTrackLabel'),
uiOutput('varSelGroup'),
......@@ -68,6 +69,13 @@ shinyUI(fluidPage(
mainPanel(tabsetPanel(
tabPanel(
"Time courses",
h4(
"Plot time series"
),
br(),
checkboxInput('chBhighlightTraj', 'Highlight trajectories?', FALSE),
uiOutput('varSelHighlight'),
br(),
fluidRow(
column(
......@@ -79,18 +87,13 @@ shinyUI(fluidPage(
min = 1,
width = '100px',
step = 1
)
),
checkboxInput('chBplotTrajInt', 'Interactive Plot?'),
actionButton('butPlotTraj', 'Plot!')
),
column(
4,
numericInput(
'inPlotTrajHeight',
'Height [px]:',
value = 800,
min = 100,
width = '100px',
step = 50
)
sliderInput('sliPlotTrajSkip', 'Plot every n-th point:', min = 1, max = 10, value = 5, step = 1)
),
column(
4,
......@@ -102,13 +105,17 @@ shinyUI(fluidPage(
max = 100,
width = '100px',
step = 10
),
numericInput(
'inPlotTrajHeight',
'Height [px]:',
value = 800,
min = 100,
width = '100px',
step = 50
)
)
),
checkboxInput('chBhighlightTraj', 'Highlight trajectories?', FALSE),
uiOutput('varSelHighlight'),
br(),
actionButton('butPlotTraj', 'Plot!'),
uiOutput('uiPlotTraj'),
downPlotUI('downPlotTraj', "Download PDF")
),
......
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