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