diff --git a/modules/auxfunc.R b/modules/auxfunc.R index fbe68f360b88cf0b768c96ff65bd57805d1c686a..ea2b59ed7aec81bcbf9f3993d6755cefc66a2bc3 100644 --- a/modules/auxfunc.R +++ b/modules/auxfunc.R @@ -198,9 +198,11 @@ myGgplotTraj = function(dt.arg, # data table aes_string(x = x.arg, y = y.arg, group = group.arg, - label = aux.label1, - label2 = aux.label2, - label3 = aux.label3)) + label = group.arg)) + #, + # label = aux.label1, + # label2 = aux.label2, + # label3 = aux.label3)) if (is.null(line.col.arg)) { p.tmp = p.tmp + @@ -310,9 +312,6 @@ myGgplotTraj = function(dt.arg, # data table legend.position = "top" ) - - - return(p.tmp) } diff --git a/modules/boxPlot.R b/modules/boxPlot.R index 93dbadf54b5e93cd16b9fbc3248e8cc8d789e7b4..d8ad1e161e60d339fa80e2bc7043c5a63680f0d3 100644 --- a/modules/boxPlot.R +++ b/modules/boxPlot.R @@ -72,7 +72,7 @@ modBoxPlot = function(input, output, session, meas.y = 'y', group = 'group', id = 'id'), - in.fname = 'boxplot.pdf') { + in.fname) { ns <- session$ns diff --git a/modules/downPlot.R b/modules/downPlot.R index f242a3861dbc8ec0c466b92ed6ff0afdf483eabf..7eeed21a47e635dc87d8e0c04e4903b80fe0d2bd 100644 --- a/modules/downPlot.R +++ b/modules/downPlot.R @@ -46,7 +46,7 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) { output$uiDownButton = renderUI({ ns <- session$ns - if (in.fname %like% 'pdf') { + if (in.fname() %like% 'pdf') { downloadButton(ns('downPlot'), 'PDF') } else { downloadButton(ns('downPlot'), 'PNG') @@ -56,7 +56,8 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) { output$downPlot <- downloadHandler( filename = function() { - in.fname + cat(in.fname(), "\n") + in.fname() }, content = function(file) { @@ -69,7 +70,7 @@ downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) { height = input$inPlotHeight ) } else { - if (in.fname %like% 'pdf') { + if (in.fname() %like% 'pdf') { pdf(file, width = input$inPlotWidth, height = input$inPlotHeight) diff --git a/modules/tabAUC.R b/modules/tabAUC.R index fc91b284d268ff1d9046f5491814b90efb67444a..07f957972d1740db03c28ad76f2c4e9bab2cc35b 100644 --- a/modules/tabAUC.R +++ b/modules/tabAUC.R @@ -19,7 +19,7 @@ modAUCplotUI = function(id, label = "Plot Area Under Curves") { ) } -modAUCplot = function(input, output, session, in.data, in.fname = 'boxplotAUC.pdf') { +modAUCplot = function(input, output, session, in.data, in.fname) { ns <- session$ns diff --git a/modules/tabBoxPlot.R b/modules/tabBoxPlot.R index b3014eb739cbe027846ac09f24c5acd99693971b..89c6d85c26ec472149e2d2bb5b32ca12f31f70d0 100644 --- a/modules/tabBoxPlot.R +++ b/modules/tabBoxPlot.R @@ -21,7 +21,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") { #### ## server box-plot -tabBoxPlot = function(input, output, session, in.data, in.fname = 'boxplotTP.pdf') { +tabBoxPlot = function(input, output, session, in.data, in.fname) { callModule(modStats, 'dispStats', in.data = data4boxPlot, diff --git a/modules/tabClHier.R b/modules/tabClHier.R index 02ebe62e5cc5493daca0835398c5045247feeade..b742911ad841d3a2c7d39c4764c95a278d4d9a07 100644 --- a/modules/tabClHier.R +++ b/modules/tabClHier.R @@ -344,7 +344,14 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) { }) - + createMethodStr = reactive({ + + paste0(s.cl.diss[as.numeric(input$selectPlotHierDiss)], + '_', + s.cl.linkage[as.numeric(input$selectPlotHierLinkage)]) + + }) + # Function instead of reactive as per: # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r # This function is used to plot and to downoad a pdf @@ -369,7 +376,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) { nacol.arg = input$inPlotHierNAcolor, font.row.arg = input$inPlotHierFontX, font.col.arg = input$inPlotHierFontY, - title.arg = paste( + title.arg = paste0( "Distance measure: ", s.cl.diss[as.numeric(input$selectPlotHierDiss)], "\nLinkage method: ", @@ -398,38 +405,61 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot) { plotHier() }, height = getPlotHierHeatMapHeight) + createFnameHeatMap = reactive({ + + paste0('clust_hierch_heatMap_', + s.cl.diss[as.numeric(input$selectPlotHierDiss)], + '_', + s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], + '.png') + }) + + createFnameTrajPlot = reactive({ + + paste0('clust_hierch_tCourses_', + s.cl.diss[as.numeric(input$selectPlotHierDiss)], + '_', + s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], + '.pdf') + }) + + createFnameRibbonPlot = reactive({ + + paste0('clust_hierch_tCoursesMeans_', + s.cl.diss[as.numeric(input$selectPlotHierDiss)], + '_', + s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], + '.pdf') + }) + + createFnameDistPlot = reactive({ + + paste0('clust_hierch_clDist_', + s.cl.diss[as.numeric(input$selectPlotHierDiss)], + '_', + s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf') }) + + # Hierarchical - Heat Map - download pdf - callModule(downPlot, "downPlotHier", paste0('clust_hierch_heatMap_', - s.cl.diss[as.numeric(input$selectPlotHierDiss)], - '_', - s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.png'), plotHier) + callModule(downPlot, "downPlotHier", createFnameHeatMap, plotHier) callModule(modTrajPlot, 'modPlotHierTraj', in.data = data4trajPlotCl, in.facet = 'cl', in.facet.color = getClColHier, - in.fname = paste0('clust_hierch_tCourses_', - s.cl.diss[as.numeric(input$selectPlotHierDiss)], - '_', - s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')) + in.fname = createFnameTrajPlot) callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon', in.data = data4trajPlotCl, in.facet = 'cl', in.facet.color = getClColHier, - in.fname = paste0('clust_hierch_tCoursesMeans_', - s.cl.diss[as.numeric(input$selectPlotHierDiss)], - '_', - s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')) + in.fname = createFnameRibbonPlot) callModule(modClDistPlot, 'hierClDistPlot', in.data = data4clDistPlot, in.cols = getClColHier, - in.fname = paste0('clust_hierch_clDist_', - s.cl.diss[as.numeric(input$selectPlotHierDiss)], - '_', - s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')) + in.fname = createFnameDistPlot) } \ No newline at end of file diff --git a/modules/tabClHierSpar.R b/modules/tabClHierSpar.R index e01a6ceb0c7d160e7aed62348e12c00628cbdd79..832211a39acc89d60adbb9000024ad4597536046 100644 --- a/modules/tabClHierSpar.R +++ b/modules/tabClHierSpar.R @@ -449,33 +449,65 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo return (input$inPlotHierSparHeatMapHeight) } + createFnameHeatMap = reactive({ + + paste0('clust_hierchSparse_heatMap_', + s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], + '_', + s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], + '.png') + }) + + createFnameTrajPlot = reactive({ + + paste0('clust_hierchSparse_tCourses_', + s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], + '_', + s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], + '.pdf') + }) + + createFnameRibbonPlot = reactive({ + + paste0('clust_hierchSparse_tCoursesMeans_', + s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], + '_', + s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], + '.pdf') + }) + + createFnameDistPlot = reactive({ + + paste0('clust_hierchSparse_clDist_', + s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], + '_', + s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf') }) + + + + # Sparse Hierarchical - Heat Map - download pdf + callModule(downPlot, "downPlotHierSparHM", createFnameHeatMap, plotHierSpar) + + + callModule(modTrajPlot, 'modPlotHierSparTraj', in.data = data4trajPlotClSpar, in.facet = 'cl', in.facet.color = getClColHierSpar, - paste0('clust_hierchSparse_tCourses_', - s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], - '_', - s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')) + in.fname = createFnameTrajPlot) callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon', in.data = data4trajPlotClSpar, in.facet = 'cl', in.facet.color = getClColHierSpar, - in.fname = paste0('clust_hierchSparse_tCoursesMeans_', - s.cl.diss[as.numeric(input$selectPlotHierSparDiss)], - '_', - s.cl.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')) + in.fname = createFnameRibbonPlot) callModule(modClDistPlot, 'hierClSparDistPlot', in.data = data4clSparDistPlot, in.cols = getClColHierSpar, - in.fname = paste0('clust_hierchSparse_clDist_', - s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], - '_', - s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')) + in.fname = createFnameDistPlot) @@ -492,11 +524,4 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo plotHierSpar() }, height = getPlotHierSparHeatMapHeight) - # Sparse Hierarchical - Heat Map - download pdf - callModule(downPlot, "downPlotHierSparHM", paste0('clust_hierchSparse_heatMap_', - s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], - '_', - s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.png'), plotHierSpar) - - } \ No newline at end of file diff --git a/modules/tabScatter.R b/modules/tabScatter.R index 1f0225db20bfd014fae333afde04de3a2ac340cc..d15e349c728e5631a3ce292bb1e377b7be84807e 100644 --- a/modules/tabScatter.R +++ b/modules/tabScatter.R @@ -66,7 +66,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") { } # SERVER -tabScatterPlot <- function(input, output, session, in.data) { +tabScatterPlot <- function(input, output, session, in.data, in.fname) { # return all unique time points (real time) # This will be used to display in UI for box-plot @@ -251,7 +251,7 @@ output$outPlotScatterInt <- renderPlotly({ }) # download pdf - callModule(downPlot, "downPlotScatter", "scatter.pdf", plotScatter, TRUE) + callModule(downPlot, "downPlotScatter", in.fname, plotScatter, TRUE) # Hierarchical - choose to display regular heatmap.2 or d3heatmap (interactive) output$plotInt_ui <- renderUI({ diff --git a/modules/trajPlot.R b/modules/trajPlot.R index 957b843077ffd74d7d7a1010a05d18751d7c4a42..0c3eab3096f47f92368f3f13a0a44ae46ffde559 100644 --- a/modules/trajPlot.R +++ b/modules/trajPlot.R @@ -56,7 +56,11 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") { } -modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.facet.color = NULL, in.fname = 'tCourses.pdf') { +modTrajPlot = function(input, output, session, + in.data, + in.fname, + in.facet = 'group', + in.facet.color = NULL) { ns <- session$ns @@ -102,7 +106,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f if(is.null(loc.p)) return(NULL) - return(plotly_build(loc.p)) + return(ggplotly(loc.p)) }) @@ -176,7 +180,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f loc.facet.col = in.facet.color()$cl.col loc.facet.col = loc.facet.col[loc.groups] } - + p.out = myGgplotTraj( dt.arg = loc.dt, diff --git a/modules/trajRibbonPlot.R b/modules/trajRibbonPlot.R index 5032b787310effbd138ea70820c8c066a7e0781c..520bca1dc443338757cdb26bc9c277d8d2d65342 100644 --- a/modules/trajRibbonPlot.R +++ b/modules/trajRibbonPlot.R @@ -49,7 +49,7 @@ modTrajRibbonPlot = function(input, output, session, in.data, in.facet = 'group', in.facet.color = NULL, - in.fname = 'tCoursesMeans.pdf') { + in.fname) { ns <- session$ns @@ -101,7 +101,9 @@ modTrajRibbonPlot = function(input, output, session, # Trajectory plot - download pdf - callModule(downPlot, "downPlotTraj", in.fname, plotTraj, TRUE) + callModule(downPlot, "downPlotTraj", + in.fname = in.fname, + plotTraj, TRUE) plotTraj <- function() { cat(file = stderr(), 'plotTraj: in\n') diff --git a/server.R b/server.R index fb53ff4d634034dd9e3db348e7a16a6c5c000e0b..f264f54eaa9b229709dd0f263d88783a0d6a157f 100644 --- a/server.R +++ b/server.R @@ -449,7 +449,7 @@ shinyServer(function(input, output, session) { cat(file = stderr(), 'dataMod: trajRem not NULL\n') loc.dt.rem = dataLoadTrajRem() - + print(loc.dt.rem) loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])] } @@ -742,12 +742,14 @@ shinyServer(function(input, output, session) { ) ###### Trajectory plotting - callModule(modTrajRibbonPlot, 'modTrajRibbon', data4trajPlot) callModule(modTrajRibbonPlot, 'modTrajRibbon', - in.data = data4trajPlot) + in.data = data4trajPlot, + in.fname = function() return( "tCoursesMeans.pdf")) ###### Trajectory plotting - callModule(modTrajPlot, 'modTrajPlot', data4trajPlot) + callModule(modTrajPlot, 'modTrajPlot', + in.data = data4trajPlot, + in.fname = function() {return( "tCourses.pdf")}) ## UI for selecting trajectories # The output data table of data4trajPlot is modified based on inSelHighlight field @@ -771,13 +773,13 @@ shinyServer(function(input, output, session) { }) ###### AUC calculation and plotting - callModule(modAUCplot, 'tabAUC', data4trajPlot) + callModule(modAUCplot, 'tabAUC', data4trajPlot, in.fname = function() return('boxplotAUC.pdf')) ###### Box-plot - callModule(tabBoxPlot, 'tabBoxPlot', data4trajPlot) + callModule(tabBoxPlot, 'tabBoxPlot', data4trajPlot, in.fname = function() return('boxplotTP.pdf')) ###### Scatter plot - callModule(tabScatterPlot, 'tabScatter', data4trajPlot) + callModule(tabScatterPlot, 'tabScatter', data4trajPlot, in.fname = function() return('scatter.pdf')) ##### Hierarchical clustering callModule(clustHier, 'tabClHier', data4clust, data4trajPlot)