Commit 22f5a492 authored by dmattek's avatar dmattek

Changed:

- modularized plot download

Added:
- download CSV with cellIDs and cluster assignment
- download CSV after cleaning
parent ea935f44
source('auxfunc.R') source('modules/auxfunc.R')
\ No newline at end of file source('modules/downPlot.R')
source('modules/downCellIDsCls.R')
\ No newline at end of file
...@@ -152,8 +152,8 @@ userDataGen <- function() { ...@@ -152,8 +152,8 @@ userDataGen <- function() {
dt.nuc = data.table(Metadata_Site = rep(1:locNsites, each = locNtp * locNtracks), dt.nuc = data.table(Metadata_Site = rep(1:locNsites, each = locNtp * locNtracks),
Metadata_Well = rep(1:locNwells, each = locNtp * locNsites * locNtracks / locNwells), Metadata_Well = rep(1:locNwells, each = locNtp * locNsites * locNtracks / locNwells),
Metadata_RealTime = rep(1:locNtp, locNsites* locNtracks), Metadata_RealTime = rep(1:locNtp, locNsites* locNtracks),
objCyto_Intensity_MeanIntensity_imErkCor = rnorm(locNtp * locNtracks * locNsites, .5, 0.1), objCyto_Intensity_MeanIntensity_imErkCor = c(rnorm(locNtp * locNtracks * locNsites * 0.5, .5, 0.1), rnorm(locNtp * locNtracks * locNsites * 0.5, 1, 0.2)),
objNuc_Intensity_MeanIntensity_imErkCor = rnorm(locNtp * locNtracks * locNsites, .5, 0.1), objNuc_Intensity_MeanIntensity_imErkCor = c(rnorm(locNtp * locNtracks * locNsites * 0.5, .25, 0.1), rnorm(locNtp * locNtracks * locNsites * 0.5, .5, 0.2)),
TrackLabel = rep(1:(locNtracks*locNsites), each = locNtp)) TrackLabel = rep(1:(locNtracks*locNsites), each = locNtp))
cat(colnames(dt.nuc)) cat(colnames(dt.nuc))
......
# RShiny module for downloading cellIDs with cluster numbers
# Use:
# in ui.R
# downPlotUI('uniqueID', "your_label")
#
# in server.R
# callModule(downPlot, "uniqueID", 'fname.pdf', input_plot_to_save)
downCellClUI <- function(id, label = "Download Data") {
ns <- NS(id)
tagList(
# Label to display as h4 header
h4(label),
downloadButton(ns('downCellCl'), 'CSV')
)
}
downCellCl <- function(input, output, session, in.fname, in.data) {
output$downCellCl <- downloadHandler(
filename = function() {
in.fname
},
content = function(file) {
write.csv(x = in.data, file = file, row.names = FALSE)
}
)
}
\ No newline at end of file
# RShiny module for downloading pdf of the plot
# Use:
# in ui.R
# downPlotUI('uniqueID', "your_label")
#
# in server.R
# callModule(downPlot, "uniqueID", 'fname.pdf', input_plot_to_save)
downPlotUI <- function(id, label = "Download Plot") {
ns <- NS(id)
tagList(
# Label to display as h4 header
h4(label),
fluidRow(
column(
3,
numericInput(
ns('inPlotWidth'),
"Width",
17,
min = 1,
width = 100
)
),
column(
3,
numericInput(
ns('inPlotHeight'),
"Height",
10,
min = 1,
width = 100
)
),
column(6,
downloadButton(ns('downPlot'), 'PDF'))
)
)
}
downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {
output$downPlot <- downloadHandler(
filename = function() {
in.fname
},
content = function(file) {
if (in.gg) {
ggsave(
file,
limitsize = FALSE,
in.plot(),
width = input$inPlotWidth,
height = input$inPlotHeight
)
} else {
pdf(file,
width = input$inPlotWidth,
height = input$inPlotHeight)
in.plot()
dev.off()
}
}
)
}
\ No newline at end of file
...@@ -21,7 +21,6 @@ library(scales) # for percentages on y scale ...@@ -21,7 +21,6 @@ library(scales) # for percentages on y scale
# increase file upload limit # increase file upload limit
options(shiny.maxRequestSize = 30 * 1024 ^ 2) options(shiny.maxRequestSize = 30 * 1024 ^ 2)
source('auxfunc.R')
shinyServer(function(input, output, session) { shinyServer(function(input, output, session) {
useShinyjs() useShinyjs()
...@@ -287,9 +286,20 @@ shinyServer(function(input, output, session) { ...@@ -287,9 +286,20 @@ shinyServer(function(input, output, session) {
value = 99, value = 99,
step = 0.1 step = 0.1
) )
} }
}) })
output$uiTxtOutliers = renderUI({
if (input$chBoutliers) {
p("Total tracks")
}
})
#### ####
## data processing ## data processing
...@@ -522,6 +532,12 @@ shinyServer(function(input, output, session) { ...@@ -522,6 +532,12 @@ shinyServer(function(input, output, session) {
setnames(loc.out, 'y.norm', 'y') setnames(loc.out, 'y.norm', 'y')
} }
##### MOD HERE
## display number of filtered tracks in textUI: uiTxtOutliers
## How?
## 1. through reactive values?
## 2. through additional comumn to tag outliers?
# Remove outliers # Remove outliers
# 1. Scale all points (independently per track) # 1. Scale all points (independently per track)
# 2. Pick time points that exceed the bounds # 2. Pick time points that exceed the bounds
...@@ -592,12 +608,23 @@ shinyServer(function(input, output, session) { ...@@ -592,12 +608,23 @@ shinyServer(function(input, output, session) {
# get cell IDs with cluster assignments depending on dendrogram cut # get cell IDs with cluster assignments depending on dendrogram cut
getDataCl = function(in.dend, in.k) { getDataCl = function(in.dend, in.k, in.ids) {
loc.dt.cl = data.table(id = getDataTrackObjLabUni_afterTrim(), cat(file = stderr(), 'getDataCl \n')
cat(in.k, '\n')
loc.dt.cl = data.table(id = in.ids,
cl = cutree(as.dendrogram(in.dend), k = in.k)) cl = cutree(as.dendrogram(in.dend), k = in.k))
} }
getDataHierClReact = reactive({
cat(file = stderr(), 'getDataHierClReact \n')
cat(input$inPlotHierNclust, '\n')
loc.dt.cl = data.table(id = getDataTrackObjLabUni_afterTrim(),
cl = cutree(userFitDendHier(), k = input$inPlotHierNclust))
loc.dt.cl = merge(loc.dt.cl, getDataCond(), by = 'id')
})
#### ####
## UI for trajectory plot ## UI for trajectory plot
...@@ -645,19 +672,7 @@ shinyServer(function(input, output, session) { ...@@ -645,19 +672,7 @@ shinyServer(function(input, output, session) {
}) })
# Trajectory plot - download pdf # Trajectory plot - download pdf
output$downPlotTraj <- downloadHandler( callModule(downPlot, "downPlotTraj", 'tcourses.pdf', plotTraj, TRUE)
filename = 'tcourses.pdf',
content = function(file) {
ggsave(
file,
limitsize = FALSE,
plotTraj(),
width = input$inPlotTrajDownWidth,
height = input$inPlotTrajDownHeight
)
}
)
plotTraj <- function() { plotTraj <- function() {
cat(file = stderr(), 'plotTraj: in\n') cat(file = stderr(), 'plotTraj: in\n')
...@@ -737,20 +752,7 @@ shinyServer(function(input, output, session) { ...@@ -737,20 +752,7 @@ shinyServer(function(input, output, session) {
}, height = 800) }, height = 800)
# Boxplot - download pdf # Boxplot - download pdf
output$downPlotBox <- downloadHandler( callModule(downPlot, "downPlotBox", 'boxplot.pdf', plotBox, TRUE)
filename = 'boxplot.pdf',
content = function(file) {
ggsave(
file,
limitsize = FALSE,
plotBox(),
width = input$inPlotBoxWidth,
height = input$inPlotBoxHeight
)
}
)
# 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
...@@ -812,15 +814,6 @@ shinyServer(function(input, output, session) { ...@@ -812,15 +814,6 @@ shinyServer(function(input, output, session) {
} }
}) })
output$uiPlotHierClDistClSel = renderUI({
if(input$chBPlotHierClDistSel) {
selectInput('inPlotHierClDistClSel', 'Select clusters to display',
choices = seq(1, input$inPlotHierNclust, 1),
multiple = TRUE,
selected = 1)
}
})
userFitDendHier <- reactive({ userFitDendHier <- reactive({
dm.t = data4clust() dm.t = data4clust()
if (is.null(dm.t)) { if (is.null(dm.t)) {
...@@ -869,11 +862,6 @@ shinyServer(function(input, output, session) { ...@@ -869,11 +862,6 @@ shinyServer(function(input, output, session) {
var.tmp.2 = "none" var.tmp.2 = "none"
} }
#cat(loc.dm, '\n')
#cat(var.tmp.1, '\n')
cat(var.tmp.2, '\n')
loc.p = heatmap.2( loc.p = heatmap.2(
loc.dm, loc.dm,
Colv = "NA", Colv = "NA",
...@@ -920,7 +908,7 @@ shinyServer(function(input, output, session) { ...@@ -920,7 +908,7 @@ shinyServer(function(input, output, session) {
cat(file = stderr(), 'plotHierTraj: dt not NULL\n') cat(file = stderr(), 'plotHierTraj: dt not NULL\n')
# get cellIDs with cluster assignments based on dendrogram cut # get cellIDs with cluster assignments based on dendrogram cut
loc.dt.cl = getDataCl(userFitDendHier(), isolate(input$inPlotHierNclust)) loc.dt.cl = getDataCl(userFitDendHier(), input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim())
loc.dt = merge(loc.dt, loc.dt.cl, by = 'id') loc.dt = merge(loc.dt, loc.dt.cl, by = 'id')
# display only selected clusters # display only selected clusters
...@@ -950,6 +938,49 @@ shinyServer(function(input, output, session) { ...@@ -950,6 +938,49 @@ shinyServer(function(input, output, session) {
} }
# download a list of cellIDs with cluster assihnments
output$downCellCl <- downloadHandler(
filename = function() {
paste0('clust_hierch_data_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv')
},
content = function(file) {
write.csv(x = getDataCl(userFitDendHier(), input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim()), file = file, row.names = FALSE)
}
)
output$downCellClSpar <- downloadHandler(
filename = function() {
paste0('clust_hierchSpar_data_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
'_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.csv')
},
content = function(file) {
write.csv(x = getDataCl(userFitDendHierSpar(), input$inPlotHierSparNclust, getDataTrackObjLabUni_afterTrim()), file = file, row.names = FALSE)
}
)
# callModule(downCellCl, 'downDataHier', paste0('clust_hierch_data_',
# s.cl.diss[as.numeric(input$selectPlotHierDiss)],
# '_',
# s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv'),
# getDataCl(userFitDendHier, input$inPlotHierNclust, getDataTrackObjLabUni_afterTrim))
#
# output$downloadDataClean <- downloadHandler(
# filename = 'tCoursesSelected_clean.csv',
# content = function(file) {
# write.csv(data4trajPlot(), file, row.names = FALSE)
# }
# )
# Barplot with distribution of clusters across conditions # Barplot with distribution of clusters across conditions
plotHierClDist = function() { plotHierClDist = function() {
cat(file = stderr(), 'plotClDist: in\n') cat(file = stderr(), 'plotClDist: in\n')
...@@ -965,6 +996,7 @@ shinyServer(function(input, output, session) { ...@@ -965,6 +996,7 @@ shinyServer(function(input, output, session) {
cl = cutree(as.dendrogram(loc.dend), k = input$inPlotHierNclust)) cl = cutree(as.dendrogram(loc.dend), k = input$inPlotHierNclust))
# get cellIDs with condition name
loc.dt.gr = isolate(getDataCond()) loc.dt.gr = isolate(getDataCond())
if (is.null(loc.dt.gr)) { if (is.null(loc.dt.gr)) {
cat(file = stderr(), 'plotClDist: loc.dt.gr is NULL\n') cat(file = stderr(), 'plotClDist: loc.dt.gr is NULL\n')
...@@ -1040,59 +1072,24 @@ shinyServer(function(input, output, session) { ...@@ -1040,59 +1072,24 @@ shinyServer(function(input, output, session) {
}) })
# Hierarchical - Heat Map - download pdf
output$downPlotHier <- downloadHandler(
filename = function() {
paste0('clust_hierch_heatMap_', s.cl.spar.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')
},
content = function(file) {
pdf(
file,
width = input$inPlotHierWidth,
height = input$inPlotHierHeight
)
plotHier() # Hierarchical - Heat Map - download pdf
dev.off() callModule(downPlot, "downPlotHier", paste0('clust_hierch_heatMap_',
} s.cl.diss[as.numeric(input$selectPlotHierDiss)],
) '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'), plotHier)
# Hierarchical - Trajectories - download pdf # Hierarchical - Trajectories - download pdf
output$downPlotHierTraj <- downloadHandler( callModule(downPlot, "downPlotHierTraj", paste0('clust_hierch_tCourses_',
filename = function() { s.cl.diss[as.numeric(input$selectPlotHierDiss)],
paste0('clust_hierch_tCourses_', s.cl.spar.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf') '_',
}, s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'), plotHierTraj, TRUE)
content = function(file) {
ggsave(plot = plotHierTraj(),
filename = file,
width = input$inPlotHierTrajWidth,
height = input$inPlotHierTrajHeight
)
#dev.off()
}
)
# Hierarchical - Bar Plot - download pdf # Hierarchical - Bar Plot - download pdf
output$downPlotHierClDist <- downloadHandler( callModule(downPlot, "downPlotHierClDist", paste0('clust_hierch_clDist_',
filename = function() { s.cl.diss[as.numeric(input$selectPlotHierDiss)],
paste0('clust_hierch_clDist_', s.cl.spar.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf') '_',
}, s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf'), plotHierClDist, TRUE)
content = function(file) {
ggsave(plot = plotHierClDist(),
filename = file,
width = input$inPlotHierClDistWidth,
height = input$inPlotHierClDistHeight
)
}
)
##### Sparse hierarchical clustering using sparcl ##### Sparse hierarchical clustering using sparcl
...@@ -1270,7 +1267,7 @@ shinyServer(function(input, output, session) { ...@@ -1270,7 +1267,7 @@ shinyServer(function(input, output, session) {
cat(file = stderr(), 'plotHierSparTraj: dt not NULL\n') cat(file = stderr(), 'plotHierSparTraj: dt not NULL\n')
# get cellIDs with cluster assignments based on dendrogram cut # get cellIDs with cluster assignments based on dendrogram cut
loc.dt.cl = getDataCl(userFitDendHierSpar(), isolate(input$inPlotHierSparNclust)) loc.dt.cl = getDataCl(userFitDendHierSpar(), isolate(input$inPlotHierSparNclust), getDataTrackObjLabUni_afterTrim())
loc.dt = merge(loc.dt, loc.dt.cl, by = 'id') loc.dt = merge(loc.dt, loc.dt.cl, by = 'id')
# plot only selected clusters # plot only selected clusters
...@@ -1383,58 +1380,22 @@ shinyServer(function(input, output, session) { ...@@ -1383,58 +1380,22 @@ shinyServer(function(input, output, session) {
# Sparse Hierarchical - Heat Map - download pdf # Sparse Hierarchical - Heat Map - download pdf
output$downPlotHierSpar <- downloadHandler( callModule(downPlot, "downPlotHierSparHM", paste0('clust_hierchSparse_heatMap_',
filename = function() { s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
paste0('clust_hierchSparse_heatMap_', s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf') '_',
}, s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'), plotHierSpar)
content = function(file) {
pdf(
file,
width = input$inPlotHierSparWidth,
height = input$inPlotHierSparHeight
)
plotHierSpar()
dev.off()
}
)
# Sparse Hierarchical - Trajectories - download pdf # Sparse Hierarchical - Trajectories - download pdf
output$downPlotHierSparTraj <- downloadHandler( callModule(downPlot, "downPlotHierSparTraj", paste0('clust_hierchSparse_tCourses_',
filename = function() { s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
paste0('clust_hierchSparse_tCourses_', s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf') '_',
}, s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'), plotHierSparTraj, TRUE)
content = function(file) { # Sparse Hierarchical - Bar Plot - download pdf
ggsave(plot = plotHierSparTraj(), callModule(downPlot, "downPlotHierSparClDist", paste0('clust_hierchSparse_clDist_',
filename = file, s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)],
width = input$inPlotHierSparTrajWidth, '_',
height = input$inPlotHierSparTrajHeight s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf'), plotHierSparClDist, TRUE)
)
#dev.off()
}
)
# Sparse Hierarchical - Trajectories - download pdf
output$downPlotHierSparClDist <- downloadHandler(
filename = function() {
paste0('clust_hierchSparse_clDist_', s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf')
},
content = function(file) {
ggsave(plot = plotHierSparClDist(),
filename = file,
width = input$inPlotHierSparClDistWidth,
height = input$inPlotHierSparClDistHeight
)
#dev.off()
}
)
# Sparse Hierarchical clustering (sparcl) interactive version # Sparse Hierarchical clustering (sparcl) interactive version
......
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