Commit b84003b7 authored by dmattek's avatar dmattek
Browse files

Added: download a csv with cluster associations

parent 4132c580
...@@ -61,3 +61,52 @@ userDataGen <- function() { ...@@ -61,3 +61,52 @@ userDataGen <- function() {
return(loc.x) return(loc.x)
} }
# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works wth dist & hclust pair
# For sparse hierarchical clustering use getDataClSpar
# Arguments:
# in.dend - dendrogram; usually output from as.dendrogram(hclust(distance_matrix))
# in.k - level at which dendrogram should be cut
getDataCl = function(in.dend, in.k) {
require(data.table)
cat(file = stderr(), 'getDataCl \n')
loc.m = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE)
#print(loc.m)
# The result of cutree containes named vector with names being cell id's
# THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's
loc.dt.cl = data.table(id = names(loc.m),
cl = loc.m)
#cat('===============\ndataCl:\n')
#print(loc.dt.cl)
return(loc.dt.cl)
}
# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works with sparse hierarchical clustering!
# Arguments:
# in.dend - dendrogram; usually output from as.dendrogram(hclust(distance_matrix))
# in.k - level at which dendrogram should be cut
# in.id - vector of cell id's
getDataClSpar = function(in.dend, in.k, in.id) {
require(data.table)
cat(file = stderr(), 'getDataClSpar \n')
loc.m = dendextend::cutree(in.dend, in.k, order_clusters_as_data = TRUE)
#print(loc.m)
# The result of cutree containes named vector with names being cell id's
# THIS WON'T WORK with sparse hierarchical clustering because there, the dendrogram doesn't have original id's
loc.dt.cl = data.table(id = in.id,
cl = loc.m)
#cat('===============\ndataCl:\n')
#print(loc.dt.cl)
return(loc.dt.cl)
}
...@@ -91,7 +91,8 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") { ...@@ -91,7 +91,8 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
), ),
checkboxInput(ns('selectKey'), checkboxInput(ns('selectKey'),
'Plot colour key', 'Plot colour key',
TRUE) TRUE),
downloadButton(ns('downCellCl'), 'Download CSV with cluster associations')
), ),
column( column(
6, 6,
...@@ -178,7 +179,6 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") { ...@@ -178,7 +179,6 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
) )
), ),
br(), br(),
downPlotUI(ns('downPlotHier'), "Download PDF"), downPlotUI(ns('downPlotHier'), "Download PDF"),
br(), br(),
...@@ -210,11 +210,26 @@ clustHier <- function(input, output, session, dataMod) { ...@@ -210,11 +210,26 @@ clustHier <- function(input, output, session, dataMod) {
}) })
# download a list of IDs with cluster assignments
output$downCellCl <- downloadHandler(
filename = function() {
paste0('clust_hierch_data_',
s.cl.dist[as.numeric(input$selectDist)],
'_',
s.cl.linkage[as.numeric(input$selectLinkage)], '.csv')
},
content = function(file) {
write.csv(x = getDataCl(userFitDendHier(), input$inNclust), file = file, row.names = FALSE)
}
)
# 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
plotHier <- function() { plotHier <- function() {
cat(file = stderr(), 'plotHier \n') cat(file = stderr(), 'plotHier \n')
......
...@@ -84,8 +84,8 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") { ...@@ -84,8 +84,8 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
ticks = TRUE, ticks = TRUE,
round = TRUE round = TRUE
), ),
checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE) checkboxInput(ns('selectPlotHierSparKey'), 'Plot colour key', TRUE),
downloadButton(ns('downCellClSpar'), 'Download CSV with cluster associations')
), ),
column( column(
...@@ -260,7 +260,7 @@ clustHierSpar <- function(input, output, session, dataMod) { ...@@ -260,7 +260,7 @@ clustHierSpar <- function(input, output, session, dataMod) {
) )
return(sparsehc) return(sparsehc)
}) })
userFitDendHierSpar <- reactive({ userFitDendHierSpar <- reactive({
cat(file = stderr(), 'userFitDendHierSpar \n') cat(file = stderr(), 'userFitDendHierSpar \n')
...@@ -275,6 +275,33 @@ clustHierSpar <- function(input, output, session, dataMod) { ...@@ -275,6 +275,33 @@ clustHierSpar <- function(input, output, session, dataMod) {
return(dend) return(dend)
}) })
# return all IDs (created in dataMod)
# used when saving cluster associations in sparse hierarchical
# sparsehc doesn't return original rownames after clustering
getDataIDs <- reactive({
cat(file = stderr(), 'getDataIDs\n')
loc.m = dataMod()
if (is.null(loc.m))
return(NULL)
else
return(rownames(loc.m))
})
# download a list of IDs with cluster assignments
output$downCellClSpar <- downloadHandler(
filename = function() {
paste0('clust_hierchSpar_data_',
s.cl.spar.dist[as.numeric(input$selectPlotHierSparDist)],
'_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.csv')
},
content = function(file) {
write.csv(x = getDataClSpar(userFitDendHierSpar(), input$inPlotHierSparNclust, getDataIDs()), file = file, row.names = FALSE)
}
)
# 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
......
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