Commit 7b7d8294 authored by dmattek's avatar dmattek

Fixed: file names for downloaded plots

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