From ad349ecfae952508a56f8b3db673301da47c2b11 Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 22:10:10 -0400 Subject: [PATCH 1/6] bugfix: check comparison.subcluster count --- markers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/markers.R b/markers.R index 32c098a..5481772 100644 --- a/markers.R +++ b/markers.R @@ -143,7 +143,7 @@ output$dt.subcluster.markers.heading <- renderUI({ if (isTruthy(current.subcluster.i())) { target.names.tbl <- select(inner_join(experiments, current.subcluster(), by='exp.label'), exp.abbrev, subcluster.disp) target.names <- paste(glue("{target.names.tbl$exp.abbrev} {target.names.tbl$subcluster.disp}"),collapse='+') - if (comparison.subcluster()$subcluster=='global') { + if (nrow(comparison.subcluster())==1 && comparison.subcluster()$subcluster=='global') { comparison.names <- comparison.subcluster()$subcluster.disp } else { comparison.names.tbl <- select(inner_join(experiments, comparison.subcluster(), by='exp.label'), exp.abbrev, subcluster.disp) From 70f3e9f05be4a042be9ccbc9bd3c8172611a7ddf Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 22:10:44 -0400 Subject: [PATCH 2/6] if plot fails, make sure file is removed --- plot.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/plot.R b/plot.R index 829f178..122f0ea 100644 --- a/plot.R +++ b/plot.R @@ -31,10 +31,12 @@ renderCacheImage <- function(plot.func, key, width, height=width, opt.use.cache= if (!file.exists(fn) || !opt.use.cache) { write.log(glue("Generating plot {fn}")) if (!is.null(progress)) progress$set(value=0.1) - a.plot <- plot.func(progress) - png(fn, width=width, height=height) - print(a.plot) - dev.off() + tryCatch({ + a.plot <- plot.func(progress) + png(fn, width=width, height=height) + print(a.plot) + dev.off() + }, error = function(e) { dev.off(); unlink(fn) }) if (!is.null(progress)) progress$set(value=1) } else { if (!is.null(progress)) progress$set(value=0.9, detail="Retrieved cached plot") From 2a70ad36c1912f6f22efa0529fb0794c37411009 Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 22:11:17 -0400 Subject: [PATCH 3/6] Remove subclusters with no XY --- tSNE.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/tSNE.R b/tSNE.R index b186ac9..4d11052 100644 --- a/tSNE.R +++ b/tSNE.R @@ -319,7 +319,7 @@ tsne.label <- function(is.global=TRUE, show.subclusters=FALSE, show.cells=TRUE, if (!is.null(progress)) progress$inc(0.2, detail="Reading XY data") if (show.subclusters) { if (is.global) { - global.xy.subcluster.selected() + global.xy.subcluster.selected() %>% filter(!is.na(V1)) } else { local.xy.selected() } @@ -538,7 +538,6 @@ tsne.label <- function(is.global=TRUE, show.subclusters=FALSE, show.cells=TRUE, ) # bag.data, loop.data and center.data are the polygon and point data associated with each (sub)cluster - alpha.limits <- if (opt.tx.scale=='fixed') c(0,7) else c(0,max(center.data$alpha)) if (opt.show.bags) { if (opt.tx.alpha) { alpha.limits <- if (opt.tx.scale=='fixed') c(0,7) else c(0,max(center.data$alpha)) @@ -561,7 +560,12 @@ tsne.label <- function(is.global=TRUE, show.subclusters=FALSE, show.cells=TRUE, bag.gg <- geom_polygon(data=bag.data, aes(x=x,y=y,group=cx), fill='grey', alpha=0.2) loop.gg <- geom_polygon(data=loop.data, aes(x=x,y=y,group=cx), fill='grey', alpha=0.1) center.gg <- geom_blank_tsne - alpha.range <- scale_alpha_continuous(guide="none", range=c(0,1), limit=alpha.limits) + if (opt.tx.alpha) { + alpha.limits <- if (opt.tx.scale=='fixed') c(0,7) else c(0,max(center.data$alpha)) + alpha.range <- scale_alpha_continuous(guide="none", range=c(0,1), limit=alpha.limits) + } else { + alpha.range <- scale_alpha() + } } # the facet.label.gg is a text label in the top left of each faceted plot. From ceddda6bf51b110d6637d5e862df1d08df187c2f Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 23:18:54 -0400 Subject: [PATCH 4/6] Update docs --- app.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/app.R b/app.R index c8fd077..692232b 100644 --- a/app.R +++ b/app.R @@ -88,8 +88,6 @@ server <- function(input, output, session) { js$setgenes(items=as.list(strsplit(input$user.genes.bak,",")[[1]])) }, once=TRUE) - output$user.genes.bak <- renderText({ input$user.genes.bak }) - # after network disconnect, client will try to reconnect using current state session$allowReconnect(TRUE) } @@ -125,21 +123,21 @@ help.doc <- list(tsne.local.label.dl=withTags(span(h4("Help for t-SNE plot of su p('Clusters are highlighted in different colors based on the filtering choices in the',b('Query'),'section in the left panel. Labels and other display features can be customized in the ',b('Display'),'panel'), p('If a row in the differentially expressed genes table, below, or one or more genes are entered by name in the',b('Query'), 'panel to the left, then the selected genes\' expression levels will be displayed in black (one row of t-SNE plots per gene) and the mean expression level for that gene in the subcluster is displayed by a color gradient or transparency, depending on settings.'))), gene.expr.scatter.subcluster.dl=withTags(span(h4('Subcluster scatter plot'), - p('Each point is the mean log normalized transcript count among all cells in the target and comparison subclusters (or region). Large points meet the fold ratio and transcript amount criteria in the ',b('Compare'),'panel. Points are shaded according to their significance. Selected rows in the table of differentially expressed genes are displayed in green or red depending on whether they pass the criteria.'))), + p('Each point is the mean log normalized transcript count among all cells in the target and comparison subclusters (or region). Large points meet the fold ratio and transcript amount criteria in the ',b('Clusters'),'panel. Points are shaded according to their significance. Selected rows in the table of differentially expressed genes are displayed in green or red depending on whether they pass the criteria.'))), gene.expr.scatter.cluster.dl=withTags(span(h4('Cluster scatter plot'), - p('Each point is the mean log normalized transcript count among all cells in the target and comparison clusters (or region). Large points meet the fold ratio and transcript amount criteria in the ',b('Compare'),'panel. Points are shaded according to their significance. Selected rows in the table of differentially expressed genes are displayed in green or red depending on whether they pass the criteria.'))), + p('Each point is the mean log normalized transcript count among all cells in the target and comparison clusters (or region). Large points meet the fold ratio and transcript amount criteria in the ',b('Clusters'),'panel. Points are shaded according to their significance. Selected rows in the table of differentially expressed genes are displayed in green or red depending on whether they pass the criteria.'))), dt.cluster.markers.dl=withTags(span(h4("Differentially expressed genes in clusters"), - p("Select a 'target' cluster in the left ",b('Compare'),"panel to display those genes that are over-expressed in that cluster with respect to the remaining cells in the region or a chosen comparison cluster. Adjust filter criteria using the ",b("Compare"),"panel."), + p("Select a 'target' cluster in the left ",b('Clusters')," panel to display those genes that are over-expressed in that cluster with respect to the remaining cells in the region or a chosen comparison cluster. Adjust filter criteria using the ",b("Clusters"),"panel."), p("Any manually added genes are always displayed in the table and colored green if the expression criteria is met and colored red otherwise."), p("One or more rows can be selected to display gene expression in the t-SNE and scatter plots."))), dt.subcluster.markers.dl=withTags(span(h4("Differentially expressed genes in subclusters"), - p("Select a 'target' subcluster in the left ",b('Compare'),"panel to display those genes that are over-expressed in that subcluster with respect to the remaining cells in the region or a chosen comparison subcluster. Adjust filter criteria using the ",b("Compare"),"panel."), + p("Select a 'target' subcluster in the left ",b('Clusters'),"panel to display those genes that are over-expressed in that subcluster with respect to the remaining cells in the region or a chosen comparison subcluster. Adjust filter criteria using the ",b("Clusters"),"panel."), p("Any manually added genes are always displayed in the table and colored green if the expression criteria is met and colored red otherwise."), p("One or more rows can be selected to display gene expression in the t-SNE and scatter plots, above."))), config=withTags(span(h4("Configuration Panels"), h5('Query'),p('The configuration panel allows for filtering, comparisons and display adjustments. The ',b('Query'),'panel accepts entry of one or more gene symbols. If entered, then the plots on the right will display the expression with respect to the entered genes. The panel provides auto-complete for a large set of commonly used genes, but other named genes can also be entered.'), p('In addition to gene entry, the ',b('Query'),'panel allows filtering of the dataset to focus on a subset of the regions, classes, clusters or subclusters. For example, you can limit your search to only "Hippocampus" or to only "Neurons" or to a specific named cluster or subcluster. Choose the t-SNE display on the right to easily visualize what data matches your filtering criteria.'), - h5('Compare'),p('The ',b('Compare'),'panel accepts entry of "target" and "comparison" clusters or subclusters (depending on the current plot display). If the meta-group option is enabled, then more than one cluster or subcluster may be combined as the target or comparison. A meta-group sums the expression levels across the chosen clusters or subclusters. Once target and comparisons are selected, then a table is displayed in the bottom right of those genes that are differentially expressed between the two groups. Multiple parameters are provided to modify the classification criteria. Choose the ',b('Scatter'),' panel on the right to visualize how parameter changes affect classification.'), + h5('Clusters'),p('The ',b('Clusters'),'panel accepts entry of "target" and "comparison" clusters or subclusters (depending on the current plot display). If the meta-group option is enabled, then more than one cluster or subcluster may be combined as the target or comparison. A meta-group sums the expression levels across the chosen clusters or subclusters. Once target and comparisons are selected, then a table is displayed in the bottom right of those genes that are differentially expressed between the two groups. Multiple parameters are provided to modify the classification criteria. Choose the ',b('Scatter'),' panel on the right to visualize how parameter changes affect classification.'), h5('Display'),p('The ',b('Display'),'panel provides parameters for changing some of the plotting parameters. Only parameters that are relevant to the currently displayed plot on the right are available to the user.'))), gene.expr.rank.cluster.dl=withTags(span(h4("Cluster Levels"), p("The plot displays the relative expression of the selected gene(s) among clusters. The error bars represent binomially distributed sampling noise given the number of cells in each cluster; it does not represent heterogeneity in expression among cells within the cluster. Only clusters filtered in the ",b('Query'),"panel are displayed. The plot is limited to only two entered genes. If more than two genes are chosen, then the display switches to a heatmap-like table."))), From 0e8e38efa27cedb5cae19bf27269cf92ca8d983f Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 23:19:33 -0400 Subject: [PATCH 5/6] Set filter.vals on bookmark restore --- cell_types.R | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/cell_types.R b/cell_types.R index da210bf..c6e832d 100644 --- a/cell_types.R +++ b/cell_types.R @@ -12,8 +12,8 @@ filter.vals.init <- function() { filter.vals$user.genes <- NULL filter.vals$tissue <- NULL filter.vals$cell.class <- NULL - filter.vals$cell.cluster <- cell.cluster <- NULL - filter.vals$cell.type <- cell.type <- NULL + filter.vals$cell.cluster <- NULL + filter.vals$cell.type <- NULL } filter.vals.init() @@ -25,32 +25,49 @@ observeEvent(input$go, { filter.vals$cell.class <- isolate(input$cell.class) filter.vals$cell.cluster <- isolate(input$cell.cluster) filter.vals$cell.type <- isolate(input$cell.type) -}) +}, ignoreInit=TRUE) # returns true if a==b. # blank and null are considered the same input.cmp <- function(a, b) { if (is.null(a)) a <- '' if (is.null(b)) b <- '' - return(a==b) + return(all(a==b)) } # if the user changes any of these parameters, then # set the dirty indicator until presses go. observe({ +# write.log("Checking filter.vals === input") +# fields <- c('user.genes','tissue','cell.class','cell.cluster','cell.type') +# print(str(reactiveValuesToList(filter.vals)[fields])) +# print(str(reactiveValuesToList(input)[fields])) + if (input.cmp(filter.vals$user.genes, input$user.genes) && input.cmp(filter.vals$tissue, input$tissue) && input.cmp(filter.vals$cell.class, input$cell.class) && input.cmp(filter.vals$cell.cluster, input$cell.cluster) && input.cmp(filter.vals$cell.type, input$cell.type)) { + write.log("Equal") removeCssClass("filter-params", "dirty-controls") disable("go") } else { + write.log("Mismatch") addCssClass("filter-params", "dirty-controls") enable("go") } }) +onRestore(function(state) { + filter.vals$user.genes <- state$input$user.genes + filter.vals$tissue <- state$input$tissue + filter.vals$cell.class <- state$input$cell.class + filter.vals$cell.cluster <- state$input$cell.cluster + filter.vals$cell.type <- state$input$cell.type +}) + + + ##################################################################################################### # Cell Type Filter options used to generate the selectizeInputs # From 76244741e7ca3f9fc75c847a405a0661250c68d7 Mon Sep 17 00:00:00 2001 From: David Kulp Date: Tue, 10 Apr 2018 23:20:01 -0400 Subject: [PATCH 6/6] If no xy.data then error --- tSNE.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tSNE.R b/tSNE.R index 4d11052..01e7fa7 100644 --- a/tSNE.R +++ b/tSNE.R @@ -330,6 +330,8 @@ tsne.label <- function(is.global=TRUE, show.subclusters=FALSE, show.cells=TRUE, tibble() }) + if (show.cells && nrow(xy.data)==0) return(plot.text("No cell data to display.")) + if (!is.null(progress) && nrow(xy.data)>0) progress$inc(0.2, detail=glue("Read {nrow(xy.data)} cells")) # labels