diff --git a/modules/auxfunc.R b/modules/auxfunc.R index eaac356515c72156d122c11751bb82b0d0e757c5..87a10fe8f0d0f9327ee1e9da238b435166cab888 100644 --- a/modules/auxfunc.R +++ b/modules/auxfunc.R @@ -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 + diff --git a/modules/tabBoxPlot.R b/modules/tabBoxPlot.R index 4822c290f3ba4cb59ecd784c170a9a98a29f35ab..c53478a2133c3583f2529c4f04b97f84225df5a0 100644 --- a/modules/tabBoxPlot.R +++ b/modules/tabBoxPlot.R @@ -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 : 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( diff --git a/modules/tabScatter.R b/modules/tabScatter.R index acdbd685732cd1da26417ec87e0124a05cc0ce33..1f0225db20bfd014fae333afde04de3a2ac340cc 100644 --- a/modules/tabScatter.R +++ b/modules/tabScatter.R @@ -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") ) diff --git a/server.R b/server.R index 55f6199d02f7dc04535829d359b1bac115ad182e..4016b1738b07ec2bd3ce2901408d89f035810e77 100644 --- a/server.R +++ b/server.R @@ -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 : 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) { diff --git a/ui.R b/ui.R index dd4e4ae392619f282c29c47dbeef5295e3048456..f6b190ddd3716817c881a63568edda13596285d8 100644 --- a/ui.R +++ b/ui.R @@ -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") ),