Commit 1b4ec97e authored by dmattek's avatar dmattek

Improve flow with validate-need syntax

parent 352c21f8
This diff is collapsed.
...@@ -171,7 +171,7 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") { ...@@ -171,7 +171,7 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") {
), ),
br(), br(),
actionButton(ns('butPlotHierSparHeatMap'), 'Plot!'), actionButton(ns('butPlot'), 'Plot!'),
downPlotUI(ns('downPlotHierSparHM'), "Download Plot"), downPlotUI(ns('downPlotHierSparHM'), "Download Plot"),
withSpinner(plotOutput(ns('outPlotHierSpar'))) withSpinner(plotOutput(ns('outPlotHierSpar')))
...@@ -198,12 +198,18 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") { ...@@ -198,12 +198,18 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") {
# SERVER ---- # SERVER ----
clustHierSpar <- function(input, output, session, clustHierSpar <- function(input, output, session,
in.data4clust, in.dataWide,
in.data4trajPlot, in.data4trajPlot,
in.data4stimPlot) { in.data4stimPlot) {
ns = session$ns ns = session$ns
# Return the number of clusters from the slider
# and delay by a constant in milliseconds defined in auxfunc.R
returnNclust = reactive({
return(input$inPlotHierSparNclust)
}) %>% debounce(MILLIS)
# UI for advanced options # UI for advanced options
output$uiPlotHierSparNperms = renderUI({ output$uiPlotHierSparNperms = renderUI({
ns <- session$ns ns <- session$ns
...@@ -284,7 +290,7 @@ clustHierSpar <- function(input, output, session, ...@@ -284,7 +290,7 @@ clustHierSpar <- function(input, output, session,
userFitHierSpar <- reactive({ userFitHierSpar <- reactive({
cat(file = stderr(), 'userFitHierSpar \n') cat(file = stderr(), 'userFitHierSpar \n')
dm.t = in.data4clust() dm.t = in.dataWide()
if (is.null(dm.t)) { if (is.null(dm.t)) {
return() return()
} }
...@@ -299,7 +305,7 @@ clustHierSpar <- function(input, output, session, ...@@ -299,7 +305,7 @@ clustHierSpar <- function(input, output, session,
dissimilarity = input$selectPlotHierSparDiss dissimilarity = input$selectPlotHierSparDiss
) )
sparsehc <- HierarchicalSparseCluster( loc.hc <- HierarchicalSparseCluster(
dists = perm.out$dists, dists = perm.out$dists,
wbound = perm.out$bestw, wbound = perm.out$bestw,
niter = ifelse(input$inHierSparAdv, input$inPlotHierSparNiter, 1), niter = ifelse(input$inHierSparAdv, input$inPlotHierSparNiter, 1),
...@@ -307,22 +313,22 @@ clustHierSpar <- function(input, output, session, ...@@ -307,22 +313,22 @@ clustHierSpar <- function(input, output, session,
dissimilarity = input$selectPlotHierSparDiss dissimilarity = input$selectPlotHierSparDiss
) )
#cat('=============\nsparsehc:\n') #cat('=============\nloc.hc:\n')
#print(sparsehc$hc) #print(loc.hc$hc)
return(sparsehc) return(loc.hc)
}) })
# return dendrogram colour coded according to the cut level of the dendrogram # return dendrogram colour coded according to the cut level of the dendrogram
userFitDendHierSpar <- reactive({ userFitDendHierSpar <- reactive({
sparsehc = userFitHierSpar() loc.hc = userFitHierSpar()
if (is.null(sparsehc)) { if (is.null(loc.hc)) {
return() return()
} }
# number of clusters at which dendrigram is cut # number of clusters at which dendrogram is cut
loc.k = input$inPlotHierSparNclust loc.k = input$inPlotHierSparNclust
# make a palette with the amount of colours equal to the number of clusters # make a palette with the amount of colours equal to the number of clusters
...@@ -330,7 +336,7 @@ clustHierSpar <- function(input, output, session, ...@@ -330,7 +336,7 @@ clustHierSpar <- function(input, output, session,
loc.col = ggthemes::tableau_color_pal(input$selectPlotHierSparPaletteDend)(n = loc.k) loc.col = ggthemes::tableau_color_pal(input$selectPlotHierSparPaletteDend)(n = loc.k)
dend <- as.dendrogram(sparsehc$hc) dend <- as.dendrogram(loc.hc$hc)
dend <- color_branches(dend, dend <- color_branches(dend,
col = loc.col, col = loc.col,
k = loc.k) k = loc.k)
...@@ -358,7 +364,7 @@ clustHierSpar <- function(input, output, session, ...@@ -358,7 +364,7 @@ clustHierSpar <- function(input, output, session,
# This will be used to display in UI for trajectory highlighting # This will be used to display in UI for trajectory highlighting
getDataTrackObjLabUni_afterTrim <- reactive({ getDataTrackObjLabUni_afterTrim <- reactive({
cat(file = stderr(), 'getDataTrackObjLabUni_afterTrim\n') cat(file = stderr(), 'getDataTrackObjLabUni_afterTrim\n')
loc.dt = in.data4clust() loc.dt = in.dataWide()
if (is.null(loc.dt)) if (is.null(loc.dt))
return(NULL) return(NULL)
...@@ -394,7 +400,7 @@ clustHierSpar <- function(input, output, session, ...@@ -394,7 +400,7 @@ clustHierSpar <- function(input, output, session,
cat(file = stderr(), 'data4trajPlotClSpar: dt not NULL\n') cat(file = stderr(), 'data4trajPlotClSpar: dt not NULL\n')
#cat('rownames: ', rownames(in.data4clust()), '\n') #cat('rownames: ', rownames(in.dataWide()), '\n')
# get cellIDs with cluster assignments based on dendrogram cut # get cellIDs with cluster assignments based on dendrogram cut
loc.dt.cl = getDataClSpar(userFitDendHierSpar(), loc.dt.cl = getDataClSpar(userFitDendHierSpar(),
...@@ -485,28 +491,44 @@ clustHierSpar <- function(input, output, session, ...@@ -485,28 +491,44 @@ clustHierSpar <- function(input, output, session,
# 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
plotHierSpar <- function() { plotHierSpar <- function() {
cat(file = stderr(), 'plotHierSpar: in\n')
# make the f-n dependent on the button click
locBut = input$butPlot
# Check if main data exists
# Thanks to solate all mods in the left panel are delayed
# until clicking the Plot button
loc.dm = isolate(in.dataWide())
loc.hc = isolate(userFitHierSpar())
loc.dend = isolate(userFitDendHierSpar())
validate(
need(!is.null(loc.dm), "Nothing to plot. Load data first!"),
need(!is.null(loc.hc), "Did not cluster"),
need(!is.null(loc.dend), "Did not create dendrogram")
)
loc.dm = in.data4clust() # Dummy dependency to redraw the heatmap without clicking Plot
if (is.null(loc.dm)) { # when changing the number of clusters to highlight
return() loc.k = returnNclust()
}
sparsehc <- userFitHierSpar()
loc.dend <- userFitDendHierSpar()
loc.colnames = paste0(ifelse(sparsehc$ws == 0, "", # create column labels according to importance weights
loc.colnames = paste0(ifelse(loc.hc$ws == 0, "",
ifelse( ifelse(
sparsehc$ws <= 0.1, loc.hc$ws <= 0.1,
"* ", "* ",
ifelse(sparsehc$ws <= 0.5, "** ", "*** ") ifelse(loc.hc$ws <= 0.5, "** ", "*** ")
)), colnames(loc.dm)) )), colnames(loc.dm))
loc.colcol = ifelse(sparsehc$ws == 0, # add color to column labels according to importance weights
loc.colcol = ifelse(loc.hc$ws == 0,
"black", "black",
ifelse( ifelse(
sparsehc$ws <= 0.1, loc.hc$ws <= 0.1,
"blue", "blue",
ifelse(sparsehc$ws <= 0.5, "green", "red") ifelse(loc.hc$ws <= 0.5, "green", "red")
)) ))
loc.col.bounds = NULL loc.col.bounds = NULL
...@@ -625,14 +647,6 @@ clustHierSpar <- function(input, output, session, ...@@ -625,14 +647,6 @@ clustHierSpar <- function(input, output, session,
# Sparse Hierarchical - display heatmap # Sparse Hierarchical - display heatmap
output$outPlotHierSpar <- renderPlot({ output$outPlotHierSpar <- renderPlot({
locBut = input$butPlotHierSparHeatMap
if (locBut == 0) {
cat(file = stderr(), 'outPlotHierSpar: Go button not pressed\n')
return(NULL)
}
plotHierSpar() plotHierSpar()
}, height = getPlotHierSparHeatMapHeight) }, height = getPlotHierSparHeatMapHeight)
......
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