Skip to content

GitLab

S
shiny-timecourse-inspector
Commit 7b7d8294 authored by dmattek's avatar dmattek
Browse files
Options

Fixed: file names for downloaded plots

parent a50e814e
Hide whitespace changes
Inline Side-by-side
Showing with 126 additions and 63 deletions
modules/auxfunc.R
View file @ 7b7d8294
......@@ -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)
}
......
modules/boxPlot.R
View file @ 7b7d8294
......@@ -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
......
modules/downPlot.R
View file @ 7b7d8294
......@@ -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)
......
modules/tabAUC.R
View file @ 7b7d8294
......@@ -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
......
modules/tabBoxPlot.R
View file @ 7b7d8294
......@@ -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,
......
modules/tabClHier.R
View file @ 7b7d8294
......@@ -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
modules/tabClHierSpar.R
View file @ 7b7d8294
......@@ -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
modules/tabScatter.R
View file @ 7b7d8294
......@@ -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({
......
modules/trajPlot.R
View file @ 7b7d8294
......@@ -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,
......
modules/trajRibbonPlot.R
View file @ 7b7d8294
......@@ -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')
......
server.R
View file @ 7b7d8294
......@@ -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)
......
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