Browse code

fix type error

Ludvig Bergenstråhle authored on 31/03/2020 18:24:32
Showing1 changed files
... ...
@@ -145,27 +145,23 @@ globalVariables(c(
145 145
         map(lift(maximumOverlap))
146 146
 
147 147
     ## Sync reassignments by propagating them forward
148
-    if (length(reassignments) > 1) {
149
-        reassignments <- accumulate(
150
-            reassignments,
151
-            function(prev, cur) {
152
-                lapply(cur, function(x) {
153
-                    if (x %in% names(prev)) prev[[x]]
154
-                    else x
155
-                })
156
-            }
157
-        )
158
-    }
148
+    reassignments <- accumulate(
149
+        reassignments,
150
+        function(prev, cur) {
151
+            list(lapply(cur, function(x) {
152
+                if (x %in% names(prev[[1]])) prev[[1]][[x]]
153
+                else x
154
+            }))
155
+        },
156
+        .init = list(setNames(nm = unique(xss[[1]])))
157
+    )
159 158
 
160 159
     ## Apply reassignments
161
-    c(
162
-        list(xss[[1]]),
163
-        list(tail(xss, -1), reassignments) %>%
164
-            transpose %>%
165
-            map(lift(function(xs, reassignment) {
166
-                vapply(xs, function(x) reassignment[[x]], character(1))
167
-            }))
168
-    ) %>%
160
+    list(xss, reassignments) %>%
161
+        transpose() %>%
162
+        map(lift(function(xs, reassignment) {
163
+            vapply(xs, function(x) reassignment[[x]], character(1))
164
+        })) %>%
169 165
         setNames(names(xss))
170 166
 }
171 167
 
Browse code

raise error if no assigments are provided

Ludvig Bergenstråhle authored on 31/03/2020 17:34:48
Showing1 changed files
... ...
@@ -180,6 +180,10 @@ globalVariables(c(
180 180
 .tidyAssignments <- function(
181 181
     assignments
182 182
 ) {
183
+    if (length(assignments) == 0) {
184
+        stop("Need at least one resolution")
185
+    }
186
+
183 187
     ## Add "root" resolution
184 188
     units <- names(assignments[[1]])
185 189
     assignments <- c(
Browse code

Fix linting error

Ludvig Bergenstråhle authored on 06/12/2019 16:52:27
Showing1 changed files
... ...
@@ -661,7 +661,8 @@ globalVariables(c(
661 661
                 0.1 * (first(.data$ymax) - first(.data$ymin))
662 662
         ) %>%
663 663
         mutate(
664
-          label = as.character(levels(assignments$resolution)[.data$resolution])
664
+            label = as.character(
665
+                levels(assignments$resolution)[.data$resolution])
665 666
         )
666 667
 
667 668
     tooltips <-
Browse code

Rename cluster tree to cluster graph

Ludvig Bergenstråhle authored on 06/12/2019 16:52:16
Showing1 changed files
... ...
@@ -539,7 +539,7 @@ globalVariables(c(
539 539
 }
540 540
 
541 541
 
542
-#' Cluster tree
542
+#' Cluster graph
543 543
 #'
544 544
 #' @param assignments \code{\link[base]{data.frame}} with columns `"name"`,
545 545
 #' `"resolution"`, and `"cluster"`.
... ...
@@ -559,9 +559,9 @@ globalVariables(c(
559 559
 #' threshold.
560 560
 #' @param numTopFeatures \code{\link[base]{integer}} specifying the number of
561 561
 #' features to show in the hover tooltips.
562
-#' @return \code{\link[ggplot2]{ggplot}} object of the cluster tree.
562
+#' @return \code{\link[ggplot2]{ggplot}} object of the cluster graph.
563 563
 #' @keywords internal
564
-.clusterTree <- function(
564
+.clusterGraph <- function(
565 565
     assignments,
566 566
     clusterMeans,
567 567
     featureName,
... ...
@@ -794,9 +794,9 @@ globalVariables(c(
794 794
         spotSize        <- reactive({ input$spotSize        }) %>% debounce(1000)
795 795
 
796 796
         ###
797
-        ## CLUSTER TREE
798
-        treePlot <- reactive({
799
-            p <- .clusterTree(
797
+        ## CLUSTER GRAPH
798
+        clusterGraph <- reactive({
799
+            p <- .clusterGraph(
800 800
                 assignments,
801 801
                 clusterMeans,
802 802
                 transitionProportions = edgeProportions(),
... ...
@@ -807,9 +807,9 @@ globalVariables(c(
807 807
                 scale_color_manual(values = colors)
808 808
         })
809 809
 
810
-        output$tree <- ggiraph::renderGirafe({
810
+        output$clusterGraph <- ggiraph::renderGirafe({
811 811
             plot <- ggiraph::girafe_options(
812
-                x = ggiraph::girafe(ggobj = treePlot()),
812
+                x = ggiraph::girafe(ggobj = clusterGraph()),
813 813
                 ggiraph::opts_toolbar(saveaspng = FALSE)
814 814
             )
815 815
             plot
... ...
@@ -881,8 +881,8 @@ globalVariables(c(
881 881
         outputs <- reactive({
882 882
             list(
883 883
                 clusters = assignments %>% select(-.data$name),
884
-                treePlot = treePlot(),
885
-                piePlots = lapply(
884
+                clusterGraph = clusterGraph(),
885
+                arrayPlot = lapply(
886 886
                     setNames(nm = resolutions),
887 887
                     function(x) eval(call(arrayName(x)))
888 888
                 )
... ...
@@ -943,8 +943,8 @@ globalVariables(c(
943 943
 #' @param view \code{\link[shiny]{viewer}} object.
944 944
 #' @return a list with the following items:
945 945
 #' - `"clusters"`: Cluster assignments (may differ from `assignments`)
946
-#' - `"treePlot"`: The cluster tree ggplot object
947
-#' - `"piePots"`: The pie plot ggplot objects
946
+#' - `"clusterGraph"`: The cluster tree ggplot object
947
+#' - `"arrayPlot"`: The pie plot ggplot objects
948 948
 #' @export
949 949
 #' @examples
950 950
 #' if (interactive()) {
Browse code

Make sure that cluster labels are natural numbers

Ludvig Bergenstråhle authored on 29/11/2019 16:11:45
Showing1 changed files
... ...
@@ -132,6 +132,12 @@ globalVariables(c(
132 132
             })
133 133
     }
134 134
 
135
+    ## Convert cluster labels to natural numbers
136
+    xss <- map(
137
+        xss,
138
+        function(x) setNames(as.character(as.integer(as.factor(x))), names(x))
139
+    )
140
+
135 141
     ## Compute reassignment map between each label pair
136 142
     reassignments <-
137 143
         list(unname(head(xss, -1)), unname(tail(xss, -1))) %>%
Browse code

Fix error when only running on one resolution

Ludvig Bergenstråhle authored on 29/11/2019 15:53:30
Showing1 changed files
... ...
@@ -139,20 +139,22 @@ globalVariables(c(
139 139
         map(lift(maximumOverlap))
140 140
 
141 141
     ## Sync reassignments by propagating them forward
142
-    syncedReassignments <- accumulate(
143
-        reassignments,
144
-        function(prev, cur) {
145
-            lapply(cur, function(x) {
146
-                if (x %in% names(prev)) prev[[x]]
147
-                else x
148
-            })
149
-        }
150
-    )
142
+    if (length(reassignments) > 1) {
143
+        reassignments <- accumulate(
144
+            reassignments,
145
+            function(prev, cur) {
146
+                lapply(cur, function(x) {
147
+                    if (x %in% names(prev)) prev[[x]]
148
+                    else x
149
+                })
150
+            }
151
+        )
152
+    }
151 153
 
152 154
     ## Apply reassignments
153 155
     c(
154 156
         list(xss[[1]]),
155
-        list(tail(xss, -1), syncedReassignments) %>%
157
+        list(tail(xss, -1), reassignments) %>%
156 158
             transpose %>%
157 159
             map(lift(function(xs, reassignment) {
158 160
                 vapply(xs, function(x) reassignment[[x]], character(1))
Browse code

Make resolution labels smaller

Ludvig Bergenstråhle authored on 29/11/2019 15:38:12
Showing1 changed files
... ...
@@ -652,10 +652,9 @@ globalVariables(c(
652 652
             y = first(.data$ymax) +
653 653
                 0.1 * (first(.data$ymax) - first(.data$ymin))
654 654
         ) %>%
655
-        mutate(label = sprintf(
656
-            "Resolution %s",
657
-            as.character(levels(assignments$resolution)[.data$resolution])
658
-        ))
655
+        mutate(
656
+          label = as.character(levels(assignments$resolution)[.data$resolution])
657
+        )
659 658
 
660 659
     tooltips <-
661 660
         clusterMeans %>%
Browse code

Fix linting errors

Ludvig Bergenstråhle authored on 16/10/2019 08:38:22
Showing1 changed files
... ...
@@ -20,6 +20,7 @@
20 20
 #' @importFrom rlang !! := .data sym
21 21
 #' @importFrom shiny debounce observeEvent reactive
22 22
 #' @importFrom shinyjs hideElement
23
+#' @importFrom shinyWidgets radioGroupButtons materialSwitch
23 24
 #' @importFrom stats dist kmeans setNames sd
24 25
 #' @importFrom SummarizedExperiment assay
25 26
 #' @importFrom tibble column_to_rownames rownames_to_column
... ...
@@ -51,7 +52,8 @@ globalVariables(c(
51 52
 #' Logsumexp
52 53
 #'
53 54
 #' Adapted from https://stat.ethz.ch/pipermail/r-help/2011-February/269205.html
54
-#' @param xs
55
+#' @param xs input vector
56
+#' @return log of summed exponentials
55 57
 #' @keywords internal
56 58
 .logsumexp <- function(xs) {
57 59
     idx <- which.max(xs)
... ...
@@ -221,7 +223,9 @@ globalVariables(c(
221 223
 
222 224
     clusterColors <- cbind(
223 225
         50,
224
-        200 * t((t(clusterLoadings) - minLoading) / (maxLoading - minLoading + 1e-10))
226
+        200 * t(
227
+            (t(clusterLoadings) - minLoading)
228
+            / (maxLoading - minLoading + 1e-10))
225 229
         - 100
226 230
     )
227 231
 
Browse code

Add support for large array plots

Ludvig Bergenstråhle authored on 15/10/2019 14:31:23
Showing1 changed files
... ...
@@ -855,7 +855,8 @@ globalVariables(c(
855 855
                     {
856 856
                         ggiraph::girafe_options(
857 857
                             x = ggiraph::girafe(
858
-                                ggobj = eval(call(arrayName(r_)))),
858
+                                ggobj = eval(call(arrayName(r_))),
859
+                                xml_reader_options = list(options = "HUGE")),
859 860
                             ggiraph::opts_toolbar(saveaspng = FALSE),
860 861
                             ggiraph::opts_zoom(max = 5)
861 862
                         )
Browse code

Remove superfluous whitespace

Ludvig Bergenstråhle authored on 15/10/2019 14:29:59
Showing1 changed files
... ...
@@ -967,7 +967,7 @@ runCPie <- function(
967 967
     spotCoordinates = NULL,
968 968
     margin = "spot",
969 969
     resolutions = 2:4,
970
-    assignmentFunction = function(k, x) kmeans(x, centers =  k)$cluster,
970
+    assignmentFunction = function(k, x) kmeans(x, centers = k)$cluster,
971 971
     view = NULL
972 972
 ) {
973 973
     if (is(counts, "SummarizedExperiment")) {
Browse code

Add support for non-int resolutions

Ludvig Bergenstråhle authored on 15/10/2019 14:24:04
Showing1 changed files
... ...
@@ -1,4 +1,5 @@
1 1
 #' @importFrom data.table as.data.table
2
+#' @importFrom digest sha1
2 3
 #' @importFrom dplyr
3 4
 #' arrange filter first group_by inner_join mutate n rename select summarize
4 5
 #' ungroup
... ...
@@ -163,41 +164,19 @@ globalVariables(c(
163 164
 #'
164 165
 #' @param assignments list of assignment vectors.
165 166
 #' @return a \code{\link[base]{data.frame}} containing the `assignments`, with
166
-#' the data relabeled so that (1) for each resolution `r`, labels are in
167
-#' `[1..r]` and (2) the overlap between consecutive assignment vectors is
168
-#' maximized. Additionally, an `r = 1` resolution is added if it does not
169
-#' already exist.
167
+#' the data relabeled so that the overlap between consecutive assignment
168
+#' vectors is maximized. Additionally, a "root" resolution is added.
170 169
 #' @keywords internal
171 170
 .tidyAssignments <- function(
172 171
     assignments
173 172
 ) {
174
-    ## Make sure that all labels in resolution r are in [1..r]
175
-    assignments <- lapply(
176
-        assignments,
177
-        function(assignment) {
178
-            oldLabels <- unique(assignment)
179
-            newLabels <- setNames(seq_along(oldLabels), nm = oldLabels)
180
-            setNames(
181
-                newLabels[as.character(assignment)],
182
-                nm = names(assignment)
183
-            )
184
-        }
173
+    ## Add "root" resolution
174
+    units <- names(assignments[[1]])
175
+    assignments <- c(
176
+        list("root" = setNames(rep(1, length(assignments[[1]])), nm = units)),
177
+        assignments
185 178
     )
186 179
 
187
-    ## Sort resolutions
188
-    names(assignments) <- assignments %>% map_int(max)
189
-    assignments <- assignments[
190
-        as.character(sort(as.numeric(names(assignments))))]
191
-
192
-    ## Add first resolution if it does not exist
193
-    if (names(assignments)[1] != "1") {
194
-        units <- names(assignments[[1]])
195
-        assignments <- c(
196
-            list("1" = setNames(rep(1, length(units)), nm = units)),
197
-            assignments
198
-        )
199
-    }
200
-
201 180
     ## Relabel the data to maximize overlap between labels in consecutive
202 181
     ## resolutions
203 182
     message("Maximizing label overlap in consecutive resolutions")
... ...
@@ -242,7 +221,7 @@ globalVariables(c(
242 221
 
243 222
     clusterColors <- cbind(
244 223
         50,
245
-        200 * t((t(clusterLoadings) - minLoading) / (maxLoading - minLoading))
224
+        200 * t((t(clusterLoadings) - minLoading) / (maxLoading - minLoading + 1e-10))
246 225
         - 100
247 226
     )
248 227
 
... ...
@@ -312,7 +291,7 @@ globalVariables(c(
312 291
     assignments <-
313 292
         resolutions %>%
314 293
         map(function(r) {
315
-            message(sprintf("Clustering resolution %d", r))
294
+            message(sprintf("Clustering resolution %s", deparse(r)))
316 295
             assignmentFunction(
317 296
                 r,
318 297
                 if (margin == "spot") t(counts)
... ...
@@ -671,7 +650,7 @@ globalVariables(c(
671 650
         ) %>%
672 651
         mutate(label = sprintf(
673 652
             "Resolution %s",
674
-            levels(assignments$resolution)[.data$resolution]
653
+            as.character(levels(assignments$resolution)[.data$resolution])
675 654
         ))
676 655
 
677 656
     tooltips <-
... ...
@@ -785,8 +764,7 @@ globalVariables(c(
785 764
 ) {
786 765
     resolutions <-
787 766
         levels(assignments$resolution) %>%
788
-        as.numeric() %>%
789
-        keep(~. != 1)
767
+        keep(~. != "root")
790 768
 
791 769
     function(input, output, session) {
792 770
         if (is.null(image)) {
... ...
@@ -828,7 +806,7 @@ globalVariables(c(
828 806
 
829 807
         ###
830 808
         ## ARRAY PLOT
831
-        arrayName <- function(r) sprintf("array%d", as.numeric(r))
809
+        arrayName <- function(r) sprintf("array%s", sha1(r))
832 810
 
833 811
         for (r in resolutions) {
834 812
             shiny::insertUI("#array", "beforeEnd",
Browse code

Add new UI

Ludvig Bergenstråhle authored on 23/08/2019 13:50:19
Showing1 changed files
... ...
@@ -7,7 +7,7 @@
7 7
 #' aes_ aes_string coord_fixed element_blank geom_segment ggplot ggtitle guides
8 8
 #' guide_legend
9 9
 #' labs
10
-#' theme theme_bw
10
+#' theme theme_bw theme_minimal
11 11
 #' scale_color_manual scale_fill_manual scale_size
12 12
 #' scale_x_continuous scale_y_continuous
13 13
 #' @importFrom grid unit
... ...
@@ -18,6 +18,7 @@
18 18
 #' @importFrom readr read_file write_file
19 19
 #' @importFrom rlang !! := .data sym
20 20
 #' @importFrom shiny debounce observeEvent reactive
21
+#' @importFrom shinyjs hideElement
21 22
 #' @importFrom stats dist kmeans setNames sd
22 23
 #' @importFrom SummarizedExperiment assay
23 24
 #' @importFrom tibble column_to_rownames rownames_to_column
... ...
@@ -537,11 +538,12 @@ globalVariables(c(
537 538
         coord_fixed() +
538 539
         scale_x_continuous(expand = c(0, 0), limits = c(xmin, xmax)) +
539 540
         scale_y_continuous(expand = c(0, 0), limits = c(ymin, ymax)) +
540
-        theme_bw() +
541
+        theme_minimal() +
541 542
         theme(
542 543
             axis.text = element_blank(),
543 544
             axis.title = element_blank(),
544
-            axis.ticks = element_blank()
545
+            axis.ticks = element_blank(),
546
+            panel.grid = element_blank()
545 547
         )
546 548
 }
547 549
 
... ...
@@ -787,6 +789,11 @@ globalVariables(c(
787 789
         keep(~. != 1)
788 790
 
789 791
     function(input, output, session) {
792
+        if (is.null(image)) {
793
+            hideElement("showImage")
794
+            hideElement("spotOpacity")
795
+        }
796
+
790 797
         ###
791 798
         ## INPUTS
792 799
         edgeProportions <- reactive({ input$edgeProportions })
... ...
@@ -804,7 +811,7 @@ globalVariables(c(
804 811
                 assignments,
805 812
                 clusterMeans,
806 813
                 transitionProportions = edgeProportions(),
807
-                transitionLabels = edgeLabels() == "Show",
814
+                transitionLabels = edgeLabels(),
808 815
                 transitionThreshold = edgeThreshold(),
809 816
                 featureName = featureName
810 817
             ) +
... ...
@@ -814,39 +821,23 @@ globalVariables(c(
814 821
         output$tree <- ggiraph::renderGirafe({
815 822
             plot <- ggiraph::girafe_options(
816 823
                 x = ggiraph::girafe(ggobj = treePlot()),
817
-                ggiraph::opts_hover(css = paste(
818
-                    "stroke:#888;",
819
-                    "stroke-width:0.2em;",
820
-                    "stroke-opacity:0.5;"
821
-                )),
822
-                ggiraph::opts_selection(css = paste(
823
-                    "stroke:#000;",
824
-                    "stroke-width:0.2em;",
825
-                    "stroke-opacity:0.5;"
826
-                ))
824
+                ggiraph::opts_toolbar(saveaspng = FALSE)
827 825
             )
828
-
829
-            ## Copy selection from the previous tree
830
-            if (length(input$tree_selected) > 0) {
831
-                session$onFlushed(function()
832
-                    shiny::isolate(session$sendCustomMessage(
833
-                        "tree_set",
834
-                        input$tree_selected
835
-                    )
836
-                ))
837
-            }
838
-
839 826
             plot
840 827
         })
841 828
 
842
-        ## Set initial selection
843
-        session$onFlushed(function() session$sendCustomMessage(
844
-            "tree_set", as.character(resolutions)
845
-        ))
846
-
847 829
         ###
848 830
         ## ARRAY PLOT
831
+        arrayName <- function(r) sprintf("array%d", as.numeric(r))
832
+
849 833
         for (r in resolutions) {
834
+            shiny::insertUI("#array", "beforeEnd",
835
+                shiny::div(class = "array", "data-resolution" = r,
836
+                    ggiraph::girafeOutput(arrayName(r)) %>%
837
+                    shinycssloaders::withSpinner()
838
+                ),
839
+                immediate = TRUE
840
+            )
850 841
             ## We evaluate the below block in a new frame (with anonymous
851 842
             ## function call) in order to protect the value of `r`, which
852 843
             ## will have changed when the reactive expressions are
... ...
@@ -856,8 +847,7 @@ globalVariables(c(
856 847
                 scores_ <-
857 848
                     scores %>%
858 849
                     filter(.data$resolution == r_)
859
-                plotName <- sprintf("array_%s", r_)
860
-                assign(envir = parent.frame(), plotName, reactive(
850
+                assign(envir = parent.frame(), arrayName(r_), reactive(
861 851
                     .arrayPlot(
862 852
                         scores = scores_ %>%
863 853
                             select(.data$spot, .data$name, .data$score),
... ...
@@ -865,7 +855,7 @@ globalVariables(c(
865 855
                         counts = counts,
866 856
                         image =
867 857
                             if (!is.null(image) && !is.null(coordinates) &&
868
-                                    showImage() == "Show")
858
+                                    showImage())
869 859
                                 grid::rasterGrob(
870 860
                                     image,
871 861
                                     width = unit(1, "npc"),
... ...
@@ -875,57 +865,27 @@ globalVariables(c(
875 865
                             else NULL,
876 866
                         scoreMultiplier = 2 ** scoreMultiplier(),
877 867
                         spotScale = spotSize() / 5,
878
-                        spotOpacity = spotOpacity() / 100
868
+                        spotOpacity = spotOpacity()
879 869
                     ) +
880 870
                         guides(fill = guide_legend(title = "Cluster")) +
881 871
                         scale_fill_manual(
882 872
                             values = colors,
883 873
                             labels = unique(scores_$cluster)
884
-                        ) +
885
-                        ggtitle(sprintf("Resolution %s", r_))
874
+                        )
886 875
                 ))
887
-                output[[paste0("plot", r_)]] <- shiny::renderPlot(
876
+                output[[arrayName(r_)]] <- ggiraph::renderGirafe(
888 877
                     {
889
-                        message(sprintf("Loading resolution \"%s\"...", r_))
890
-                        eval(call(plotName))
891
-                    },
892
-                    width = 600, height = 500
878
+                        ggiraph::girafe_options(
879
+                            x = ggiraph::girafe(
880
+                                ggobj = eval(call(arrayName(r_)))),
881
+                            ggiraph::opts_toolbar(saveaspng = FALSE),
882
+                            ggiraph::opts_zoom(max = 5)
883
+                        )
884
+                    }
893 885
                 )
894 886
             })()
895 887
         }
896 888
 
897
-        output$array <- shiny::renderUI({
898
-            sort(as.numeric(input$tree_selected)) %>%
899
-                map(~paste0("plot", .)) %>%
900
-                keep(~. %in% names(shiny::outputOptions(output))) %>%
901
-                map(~shiny::div(
902
-                    style = "display: inline-block;",
903
-                    shiny::div(
904
-                        style = "position: relative",
905
-                        list(
906
-                            shiny::plotOutput(., height="auto"),
907
-                            shiny::div(
908
-                                style = paste(
909
-                                    "z-index: -1;",
910
-                                    "position: absolute;",
911
-                                    "top: 50%; left: 50%;"
912
-                                ),
913
-                                shiny::div(
914
-                                    style = paste(
915
-                                        "background: #eee;",
916
-                                        "padding: 1em;",
917
-                                        "position: relative;",
918
-                                        "left: -50%;"
919
-                                    ),
920
-                                    "Loading..."
921
-                                )
922
-                            )
923
-                        )
924
-                    )
925
-                )) %>%
926
-                invoke(shiny::div, style = "text-align:center", .)
927
-        })
928
-
929 889
         ###
930 890
         ## EXPORT
931 891
         outputs <- reactive({
... ...
@@ -933,8 +893,8 @@ globalVariables(c(
933 893
                 clusters = assignments %>% select(-.data$name),
934 894
                 treePlot = treePlot(),
935 895
                 piePlots = lapply(
936
-                    setNames(nm = input$tree_selected),
937
-                    function(x) eval(call(sprintf("array_%s", x)))
896
+                    setNames(nm = resolutions),
897
+                    function(x) eval(call(arrayName(x)))
938 898
                 )
939 899
             )
940 900
         })
... ...
@@ -945,94 +905,11 @@ globalVariables(c(
945 905
 
946 906
 #' SpatialCPie UI
947 907
 #'
948
-#' @param imageButton \code{\link[base]{logical}} specifying if the UI should
949
-#' include a "show image" radio button.
950 908
 #' @return SpatialCPie UI, to be passed to \code{\link[shiny]{shinyApp}}.
951 909
 #' @keywords internal
952
-.makeUI <- function(
953
-    imageButton = FALSE
954
-) {
955
-    miniUI::miniPage(
956
-        shiny::tags$head(shiny::tags$style(shiny::HTML(
957
-            paste(sep = "\n",
958
-                "h3 { font-size: 1.3em }",
959
-                "h3:first-child { margin-top: 0 }",
960
-
961
-                "input[type=radio] { margin-top: 0 }",
962
-                # ^ Remove radio button top margin (shiny bug?)
963
-
964
-                ".recalculating { position: relative; z-index: -2 }",
965
-                # ^ Position loading boxes
966
-
967
-                ".ggiraph-toolbar { display: none }",
968
-                # ^ Hide ggiraph toolbar
969
-
970
-                ".row { display: flex }",
971
-                "#tree svg { height: 500px !important }"
972
-                # ^ Set tree plot size explicitly
973
-            )
974
-        ))),
975
-        miniUI::gadgetTitleBar("SpatialCPie"),
976
-        miniUI::miniContentPanel(
977
-            shiny::fillPage(
978
-                shiny::sidebarLayout(
979
-                    shiny::sidebarPanel(width = 3,
980
-                        shiny::h3("Cluster Tree"),
981
-                        shiny::radioButtons(
982
-                            "edgeLabels",
983
-                            "Edge labels:", c("Show", "Hide")
984
-                        ),
985
-                        shiny::radioButtons(
986
-                            "edgeProportions",
987
-                            "Edge proportions:", c("To", "From")
988
-                        ),
989
-                        shiny::numericInput(
990
-                            "edgeThreshold",
991
-                            "Min proportion:",
992
-                            max = 1.00, min = 0.00, value = 0.05, step = 0.01
993
-                        )
994
-                    ),
995
-                    shiny::mainPanel(style = "text-align: center",
996
-                        ggiraph::girafeOutput(
997
-                            "tree",
998
-                            width = "100%", height = "100%"
999
-                        )
1000
-                    )
1001
-                ),
1002
-                shiny::hr(),
1003
-                shiny::sidebarLayout(
1004
-                    shiny::sidebarPanel(width = 3,
1005
-                        shiny::h3("Array Plots"),
1006
-                        if (isTRUE(imageButton))
1007
-                            shiny::radioButtons(
1008
-                                "showImage",
1009
-                                "HE image:", c("Show", "Hide")
1010
-                            )
1011
-                        else NULL,
1012
-                        shiny::numericInput(
1013
-                            "scoreMultiplier",
1014
-                            "Score log-multiplier:",
1015
-                            max = 10, min = -10, value = 5, step = 0.1
1016
-                        ),
1017
-                        shiny::numericInput(
1018
-                            "spotOpacity",
1019
-                            "Opacity:",
1020
-                            max = 100,
1021
-                            min = 1,
1022
-                            value = if (imageButton) 70 else 100,
1023
-                            step = 10
1024
-                        ),
1025
-                        shiny::numericInput(
1026
-                            "spotSize",
1027
-                            "Size:",
1028
-                            max = 10, min = 1, value = 5, step = 1
1029
-                        )
1030
-                    ),
1031
-                    shiny::mainPanel(shiny::uiOutput("array"))
1032
-                )
1033
-            )
1034
-        )
1035
-    )
910
+.makeUI <- function() {
911
+    shiny::htmlTemplate(system.file(
912
+        "www", "default", "index.html", package = "SpatialCPie"))
1036 913
 }
1037 914
 
1038 915
 
... ...
@@ -1045,7 +922,7 @@ globalVariables(c(
1045 922
 .makeApp <- function(image, ...) {
1046 923
     data <- .preprocessData(...)
1047 924
     shiny::shinyApp(
1048
-        ui = .makeUI(!is.null(image)),
925
+        ui = .makeUI(),
1049 926
         server = .makeServer(
1050 927
             assignments = data$assignments,
1051 928
             clusterMeans = data$means,
... ...
@@ -1127,6 +1004,6 @@ runCPie <- function(
1127 1004
             resolutions = resolutions,
1128 1005
             assignmentFunction = assignmentFunction
1129 1006
         ),
1130
-        viewer = view %||% shiny::dialogViewer("SpatialCPie")
1007
+        viewer = view %||% shiny::paneViewer()
1131 1008
     )
1132 1009
 }
Browse code

Add top genes barplot to array plot tooltip

Ludvig Bergenstråhle authored on 23/08/2019 13:46:24
Showing1 changed files
... ...
@@ -404,6 +404,7 @@ globalVariables(c(
404 404
 
405 405
     list(
406 406
         assignments = assignments %>% rename(unit = !! sym(margin)),
407
+        counts = longCounts,
407 408
         means = clusterMeans,
408 409
         scores = normalizedScores,
409 410
         colors = colors,
... ...
@@ -413,6 +414,41 @@ globalVariables(c(
413 414
 }
414 415
 
415 416
 
417
+#' SVG barplot
418
+#'
419
+#' @param xs named vector with observations
420
+#' @return \code{\link{character}} SVG barplot
421
+#' @keywords internal
422
+.SVGBarplot <- function(xs) {
423
+    invoke(
424
+        paste,
425
+        sprintf(
426
+            paste0(
427
+                "<svg width=\"20em\" height=\"1.5em\">",
428
+                paste0(
429
+                    "<rect width=\"%f%%\" height=\"1.5em\" ",
430
+                    "style=\"fill:rgb(125,125,125)\"></rect>"
431
+                ),
432
+                paste0(
433
+                    "<text x=\"2%%\" y=\"50%%\" fill=\"black\"",
434
+                    "dominant-baseline=\"central\">%s</text>"
435
+                ),
436
+                paste0(
437
+                    "<text x=\"%f%%\" y=\"50%%\" fill=\"white\"",
438
+                    "dominant-baseline=\"central\" >%.2f</text>"
439
+                ),
440
+                "</svg>"
441
+            ),
442
+            70 * xs / max(xs),
443
+            names(xs),
444
+            70 * xs / max(xs) + 2,
445
+            xs
446
+        ),
447
+        sep="\n"
448
+    )
449
+}
450
+
451
+
416 452
 #' Array pie plot
417 453
 #'
418 454
 #' @param scores \code{\link[base]{data.frame}} with cluster scores for each
... ...
@@ -430,10 +466,12 @@ globalVariables(c(
430 466
 .arrayPlot <- function(
431 467
     scores,
432 468
     coordinates,
469
+    counts = NULL,
433 470
     image = NULL,
434 471
     scoreMultiplier = 1.0,
435 472
     spotScale = 1,
436
-    spotOpacity = 1
473
+    spotOpacity = 1,
474
+    numTopGenes = 5
437 475
 ) {
438 476
     spots <- intersect(scores$spot, rownames(coordinates))
439 477
 
... ...
@@ -465,6 +503,26 @@ globalVariables(c(
465 503
         mutate(score = .data$score ^ scoreMultiplier) %>%
466 504
         mutate(tooltip = .data$spot)
467 505
 
506
+    if (!is.null(counts)) {
507
+        topGenes <-
508
+            counts %>%
509
+            group_by(.data$spot) %>%
510
+            mutate(rank = rank(-.data$count, ties.method = "first")) %>%
511
+            filter(.data$rank <= numTopGenes) %>%
512
+            arrange(-.data$count) %>%
513
+            summarize(topGenes = paste(
514
+                .SVGBarplot(setNames(.data$count, .data$gene))
515
+            ))
516
+        df <-
517
+            df %>%
518
+            inner_join(topGenes, by = "spot") %>%
519
+            mutate(tooltip = paste(sep = "<br />",
520
+                .data$tooltip,
521
+                .data$topGenes
522
+            )) %>%
523
+            select(-.data$topGenes)
524
+    }
525
+
468 526
     ggplot() +
469 527
         annotation +
470 528
         geom_scatterpie_interactive(
... ...
@@ -621,32 +679,10 @@ globalVariables(c(
621 679
         mutate(rank = rank(-.data$mean, ties.method = "first")) %>%
622 680
         filter(.data$rank <= numTopFeatures) %>%
623 681
         arrange(-.data$mean) %>%
624
-        summarize(tooltip = invoke(
625
-            paste,
626
-            sprintf(
627
-                paste0(
628
-                    "<svg width=\"20em\" height=\"1.5em\">",
629
-                        paste0(
630
-                            "<rect width=\"%f%%\" height=\"1.5em\" ",
631
-                            "style=\"fill:rgb(125,125,125)\"></rect>"
632
-                        ),
633
-                        paste0(
634
-                            "<text x=\"2%%\" y=\"50%%\" fill=\"black\"",
635
-                            "dominant-baseline=\"central\">%s</text>"
636
-                        ),
637
-                        paste0(
638
-                            "<text x=\"%f%%\" y=\"50%%\" fill=\"white\"",
639
-                            "dominant-baseline=\"central\" >%.2f</text>"
640
-                        ),
641
-                    "</svg>"
642
-                ),
643
-                70 * mean / max(mean),
644
-                !! sym(featureName),
645
-                70 * mean / max(mean) + 2,
646
-                mean
647
-            ),
648
-            sep="\n"
649
-        ))
682
+        summarize(tooltip = .SVGBarplot(setNames(
683
+            mean,
684
+            nm = !! sym(featureName)
685
+        )))
650 686
     vertices <-
651 687
         vertices %>%
652 688
         inner_join(tooltips, by = "name") %>%
... ...
@@ -738,6 +774,7 @@ globalVariables(c(
738 774
 .makeServer <- function(
739 775
     assignments,
740 776
     clusterMeans,
777
+    counts,
741 778
     scores,
742 779
     colors,
743 780
     image,
... ...
@@ -825,6 +862,7 @@ globalVariables(c(
825 862
                         scores = scores_ %>%
826 863
                             select(.data$spot, .data$name, .data$score),
827 864
                         coordinates = coordinates,
865
+                        counts = counts,
828 866
                         image =
829 867
                             if (!is.null(image) && !is.null(coordinates) &&
830 868
                                     showImage() == "Show")
... ...
@@ -1011,6 +1049,7 @@ globalVariables(c(
1011 1049
         server = .makeServer(
1012 1050
             assignments = data$assignments,
1013 1051
             clusterMeans = data$means,
1052
+            counts = data$counts,
1014 1053
             scores = data$scores,
1015 1054
             colors = data$colors,
1016 1055
             image = image,
... ...
@@ -1081,8 +1120,8 @@ runCPie <- function(
1081 1120
     }
1082 1121
     shiny::runGadget(
1083 1122
         app = .makeApp(
1084
-            counts = counts,
1085 1123
             image = image,
1124
+            counts = counts,
1086 1125
             coordinates = spotCoordinates,
1087 1126
             margin = margin,
1088 1127
             resolutions = resolutions,
Browse code

Make default scoring less data sensitive

Ludvig Bergenstråhle authored on 23/08/2019 13:37:19
Showing1 changed files
... ...
@@ -369,7 +369,10 @@ globalVariables(c(
369 369
             ]
370 370
             distances %>%
371 371
                 group_by(.data$resolution, .data$spot) %>%
372
-                mutate(score = .likeness(.data$distance)) %>%
372
+                mutate(
373
+                    score = .likeness(.data$distance / sum(.data$distance),
374
+                    c = 40.
375
+                )) %>%
373 376
                 ungroup() %>%
374 377
                 select(-.data$distance)
375 378
         } else {
Browse code

Make array plots interactive

Ludvig Bergenstråhle authored on 23/08/2019 12:40:33
Showing1 changed files
... ...
@@ -455,20 +455,23 @@ globalVariables(c(
455 455
 
456 456
     coordinates$y <- ymax - coordinates$y + ymin
457 457
 
458
-    wideScores <-
459
-        scores %>%
458
+    df <-
459
+        coordinates %>%
460
+        rownames_to_column("spot") %>%
461
+        inner_join(scores, by="spot") %>%
460 462
         mutate(score = .data$score ^ scoreMultiplier) %>%
461
-        spread(.data$name, .data$score) %>%
462
-        as.data.frame() %>%
463
-        column_to_rownames("spot")
463
+        mutate(tooltip = .data$spot)
464 464
 
465 465
     ggplot() +
466 466
         annotation +
467
-        scatterpie::geom_scatterpie(
468
-            mapping = aes_string(x = "x", y = "y", r = "r"),
469
-            data = cbind(wideScores[spots, ], coordinates[spots, ]),
470
-            cols = colnames(wideScores),
471
-            alpha = spotOpacity
467
+        geom_scatterpie_interactive(
468
+            mapping = ggplot2::aes_string(
469
+                x0 = "x", y0 = "y", r = "r", amount = "score", fill = "name",
470
+                tooltip = "tooltip"
471
+            ),
472
+            data = df,
473
+            alpha = spotOpacity,
474
+            n = 64
472 475
         ) +
473 476
         coord_fixed() +
474 477
         scale_x_continuous(expand = c(0, 0), limits = c(xmin, xmax)) +
Browse code

Improve numerical stability

Ludvig Bergenstråhle authored on 23/08/2019 12:29:10
Showing1 changed files
... ...
@@ -46,6 +46,17 @@ globalVariables(c(
46 46
 ))
47 47
 
48 48
 
49
+#' Logsumexp
50
+#'
51
+#' Adapted from https://stat.ethz.ch/pipermail/r-help/2011-February/269205.html
52
+#' @param xs
53
+#' @keywords internal
54
+.logsumexp <- function(xs) {
55
+    idx <- which.max(xs)
56
+    log1p(sum(exp(xs[-idx] - xs[idx]))) + xs[idx]
57
+}
58
+
59
+
49 60
 #' Likeness score
50 61
 #'
51 62
 #' @param d distance vector.
... ...
@@ -56,8 +67,7 @@ globalVariables(c(
56 67
     d,
57 68
     c = 1.0
58 69
 ) {
59
-    score <- exp(-c * d)
60
-    score / sum(score)
70
+    exp(-c * d - .logsumexp(-c * d))
61 71
 }
62 72
 
63 73
 #' Z-score
... ...
@@ -386,7 +396,7 @@ globalVariables(c(
386 396
     normalizedScores <-
387 397
         scores %>%
388 398
         group_by(.data$resolution, .data$spot) %>%
389
-        mutate(score = .data$score / sum(.data$score)) %>%
399
+        mutate(score = .data$score / max(.data$score)) %>%
390 400
         ungroup()
391 401
 
392 402
     list(
Browse code

Add log messages

Ludvig Bergenstråhle authored on 23/08/2019 12:26:37
Showing1 changed files
... ...
@@ -189,6 +189,7 @@ globalVariables(c(
189 189
 
190 190
     ## Relabel the data to maximize overlap between labels in consecutive
191 191
     ## resolutions
192
+    message("Maximizing label overlap in consecutive resolutions")
192 193
     assignments <- .maximizeOverlap(assignments)
193 194
 
194 195
     ## Concatenate assignments to `data.frame`
... ...
@@ -299,16 +300,19 @@ globalVariables(c(
299 300
 
300 301
     assignments <-
301 302
         resolutions %>%
302
-        map(~assignmentFunction(
303
-            .,
304
-            if (margin == "spot") t(counts)
305
-            else {
306
-                log(as.matrix(counts) + 1) %>%
307
-                    prop.table(margin = 2) %>%
308
-                    apply(1, .zscore) %>%
309
-                    t()
310
-            }
311
-        )) %>%
303
+        map(function(r) {
304
+            message(sprintf("Clustering resolution %d", r))
305
+            assignmentFunction(
306
+                r,
307
+                if (margin == "spot") t(counts)
308
+                else {
309
+                    log(as.matrix(counts) + 1) %>%
310
+                        prop.table(margin = 2) %>%
311
+                        apply(1, .zscore) %>%
312
+                        t()
313
+                }
314
+            )
315
+        }) %>%
312 316
         setNames(resolutions) %>%
313 317
         .tidyAssignments() %>%
314 318
         rename(!! sym(margin) := .data$unit)
... ...
@@ -343,6 +347,7 @@ globalVariables(c(
343 347
         column_to_rownames(otherMargin) %>%
344 348
         .computeClusterColors()
345 349
 
350
+    message("Scoring spot-cluster affinity")
346 351
     scores <-
347 352
         if (margin == "spot") {
348 353
             countsAndMeans <-
Browse code

Use data.table instead of dplyr to speed up aggregation

Ludvig Bergenstråhle authored on 23/08/2019 12:18:08
Showing1 changed files
... ...
@@ -1,3 +1,4 @@
1
+#' @importFrom data.table as.data.table
1 2
 #' @importFrom dplyr
2 3
 #' arrange filter first group_by inner_join mutate n rename select summarize
3 4
 #' ungroup
... ...
@@ -33,7 +34,12 @@
33 34
 ## (ref: https://stackoverflow.com/a/12429344)
34 35
 globalVariables(c(
35 36
     ".",
37
+    "cluster",
38
+    "count",
39
+    "name",
36 40
     "otherMargin",
41
+    "resolution",
42
+    "spot",
37 43
     "xcoord",
38 44
     "ycoord",
39 45
     NULL
... ...
@@ -339,18 +345,14 @@ globalVariables(c(
339 345
 
340 346
     scores <-
341 347
         if (margin == "spot") {
342
-            longCounts %>%
343
-                inner_join(clusterMeans, by = "gene") %>%
344
-                group_by(
345
-                    .data$resolution,
346
-                    .data$spot,
347
-                    .data$cluster,
348
-                    .data$name
349
-                ) %>%
350
-                summarize(
351
-                    distance = sqrt(mean((.data$count - .data$mean) ^ 2))
352
-                ) %>%
353
-                ungroup() %>%
348
+            countsAndMeans <-
349
+                longCounts %>%
350
+                inner_join(clusterMeans, by = "gene")
351
+            distances <- as.data.table(countsAndMeans)[,
352
+                .(distance = sqrt(mean((count - mean) ^ 2))),
353
+                by = .(resolution, cluster, spot, name)
354
+            ]
355
+            distances %>%
354 356
                 group_by(.data$resolution, .data$spot) %>%
355 357
                 mutate(score = .likeness(.data$distance)) %>%
356 358
                 ungroup() %>%
Browse code

Add top features barplot to cluster tree tooltip

Ludvig Bergenstråhle authored on 19/08/2019 15:20:13
Showing1 changed files
... ...
@@ -1,5 +1,6 @@
1 1
 #' @importFrom dplyr
2
-#' filter first group_by inner_join mutate n rename select summarize ungroup
2
+#' arrange filter first group_by inner_join mutate n rename select summarize
3
+#' ungroup
3 4
 #' @importFrom ggiraph geom_point_interactive
4 5
 #' @importFrom ggplot2
5 6
 #' aes_ aes_string coord_fixed element_blank geom_segment ggplot ggtitle guides
... ...
@@ -21,6 +22,7 @@
21 22
 #' @importFrom tibble column_to_rownames rownames_to_column
22 23
 #' @importFrom tidyr gather separate spread unite
23 24
 #' @importFrom tidyselect everything quo
25
+#' @importFrom tools toTitleCase
24 26
 #' @importFrom utils head tail
25 27
 #' @importFrom utils str
26 28
 #' @importFrom zeallot %<-%
... ...
@@ -249,10 +251,12 @@ globalVariables(c(
249 251
 #' the spots.
250 252
 #' @return list with the following elements:
251 253
 #' - `$assignments`: tidy assignments
254
+#' - `$means`: cluster means
252 255
 #' - `$scores`: cluster scores for each spot in each resolution
253 256
 #' - `$colors`: cluster colors
254 257
 #' - `$coordinates`: spot coordinates, either from `coordinates` or parsed from
255 258
 #' `assignments`
259
+#' - `$featureName`: name of the clustered feature (the "opposite" of `margin`)
256 260
 #' @keywords internal
257 261
 .preprocessData <- function(
258 262
     counts,
... ...
@@ -380,9 +384,11 @@ globalVariables(c(
380 384
 
381 385
     list(
382 386
         assignments = assignments %>% rename(unit = !! sym(margin)),
387
+        means = clusterMeans,
383 388
         scores = normalizedScores,
384 389
         colors = colors,
385
-        coordinates = coordinates
390
+        coordinates = coordinates,
391
+        featureName = otherMargin
386 392
     )
387 393
 }
388 394
 
... ...
@@ -463,6 +469,10 @@ globalVariables(c(
463 469
 #'
464 470
 #' @param assignments \code{\link[base]{data.frame}} with columns `"name"`,
465 471
 #' `"resolution"`, and `"cluster"`.
472
+#' @param clusterMeans \code{\link[base]{data.frame}} with columns `"name"`,
473
+#' `"resolution"`, `"cluster"`, `featureName`, and `"mean"`.
474
+#' @param featureName \code{\link[base]{character}} with the name of the
475
+#' clustered feature.
466 476
 #' @param transitionProportions how to compute the transition proportions.
467 477
 #' Possible values are:
468 478
 #' - `"From"`: based on the total number of assignments in the lower-resolution
... ...
@@ -473,13 +483,18 @@ globalVariables(c(
473 483
 #' show edge labels.
474 484
 #' @param transitionThreshold hide edges with transition proportions below this
475 485
 #' threshold.
486
+#' @param numTopFeatures \code{\link[base]{integer}} specifying the number of
487
+#' features to show in the hover tooltips.
476 488
 #' @return \code{\link[ggplot2]{ggplot}} object of the cluster tree.
477 489
 #' @keywords internal
478 490
 .clusterTree <- function(
479 491
     assignments,
492
+    clusterMeans,
493
+    featureName,
480 494
     transitionProportions = "To",
481 495
     transitionLabels = FALSE,
482
-    transitionThreshold = 0.0
496
+    transitionThreshold = 0.0,
497
+    numTopFeatures = 10
483 498
 ) {
484 499
     transitionSym <-
485 500
         if (transitionProportions == "To") "toNode"
... ...
@@ -560,7 +575,7 @@ globalVariables(c(
560 575
             by = c("to" = "name")
561 576
         )
562 577
 
563
-    labels <-
578
+    resolutionLabels <-
564 579
         vertices %>%
565 580
         select(.data$resolution, .data$x, .data$y) %>%
566 581
         filter(.data$resolution != 1) %>%
... ...
@@ -576,6 +591,48 @@ globalVariables(c(
576 591
             levels(assignments$resolution)[.data$resolution]
577 592
         ))
578 593
 
594
+    tooltips <-
595
+        clusterMeans %>%
596
+        mutate(name = as.character(.data$name)) %>%
597
+        group_by(.data$name) %>%
598
+        mutate(rank = rank(-.data$mean, ties.method = "first")) %>%
599
+        filter(.data$rank <= numTopFeatures) %>%
600
+        arrange(-.data$mean) %>%
601
+        summarize(tooltip = invoke(
602
+            paste,
603
+            sprintf(
604
+                paste0(
605
+                    "<svg width=\"20em\" height=\"1.5em\">",
606
+                        paste0(
607
+                            "<rect width=\"%f%%\" height=\"1.5em\" ",
608
+                            "style=\"fill:rgb(125,125,125)\"></rect>"
609
+                        ),
610
+                        paste0(
611
+                            "<text x=\"2%%\" y=\"50%%\" fill=\"black\"",
612
+                            "dominant-baseline=\"central\">%s</text>"
613
+                        ),
614
+                        paste0(
615
+                            "<text x=\"%f%%\" y=\"50%%\" fill=\"white\"",
616
+                            "dominant-baseline=\"central\" >%.2f</text>"
617
+                        ),
618
+                    "</svg>"
619
+                ),
620
+                70 * mean / max(mean),
621
+                !! sym(featureName),
622
+                70 * mean / max(mean) + 2,
623
+                mean
624
+            ),
625
+            sep="\n"
626
+        ))
627
+    vertices <-
628
+        vertices %>%
629
+        inner_join(tooltips, by = "name") %>%
630
+        mutate(tooltip = paste(sep = "<br />",
631
+            toTitleCase(.data$name),
632
+            sprintf("Size: %d", .data$size),
633
+            .data$tooltip
634
+        ))
635
+
579 636
     ggplot() +
580 637
         geom_segment(
581 638
             aes_string(
... ...
@@ -589,10 +646,9 @@ globalVariables(c(
589 646
         geom_point_interactive(
590 647
             aes_(
591 648
                 ~x, ~y,
592
-                data_id = ~levels(assignments$resolution)[.data$resolution],
593 649
                 color = ~name,
594 650
                 size = ~size,
595
-                tooltip = ~sprintf("%s: %d", name, size)
651
+                tooltip = ~tooltip
596 652
             ),
597 653
             data = vertices %>% filter(.data$resolution != 1)
598 654
         ) +
... ...
@@ -614,7 +670,7 @@ globalVariables(c(
614 670
         } +
615 671
         ggplot2::geom_text(
616 672
             aes_string("x", "y", label = "label"),
617
-            data = labels
673
+            data = resolutionLabels
618 674
         ) +
619 675
         labs(alpha = "Proportion", color = "Cluster") +
620 676
         scale_size(guide = "none", range = c(2, 7)) +
... ...
@@ -640,6 +696,8 @@ globalVariables(c(
640 696
 #' containing the columns `"unit"` (name of the observational unit; either a
641 697
 #' gene name or a spot name), `"resolution"`, `"cluster"`, and `"name"` (a
642 698
 #' unique identifier of the (resolution, cluster) pair).
699
+#' @param clusterMeans \code{\link[base]{data.frame}} with columns `"name"`,
700
+#' `"resolution"`, `"cluster"`, `featureName`, and `"mean"`.
643 701
 #' @param scores \code{\link[base]{data.frame}} with cluster scores for each
644 702
 #' spot in each resolution containing the columns `"spot"`, `"resolution"`,
645 703
 #' `"cluster"`, `"name"`, and `"score"`.
... ...
@@ -650,14 +708,18 @@ globalVariables(c(
650 708
 #' @param coordinates \code{\link[base]{data.frame}} with `rownames` matching
651 709
 #' the \code{\link[base]{names}} in `scores` and columns `"x"` and `"y"`
652 710
 #' specifying the plotting position of each observation.
711
+#' @param featureName \code{\link[base]{character}} with the name of the
712
+#' clustered feature.
653 713
 #' @return server function, to be passed to \code{\link[shiny]{shinyApp}}.
654 714
 #' @keywords internal
655 715
 .makeServer <- function(
656 716
     assignments,
717
+    clusterMeans,
657 718
     scores,
658 719
     colors,
659 720
     image,
660
-    coordinates
721
+    coordinates,
722
+    featureName
661 723
 ) {
662 724
     resolutions <-
663 725
         levels(assignments$resolution) %>%
... ...
@@ -680,9 +742,11 @@ globalVariables(c(
680 742
         treePlot <- reactive({
681 743
             p <- .clusterTree(
682 744
                 assignments,
745
+                clusterMeans,
683 746
                 transitionProportions = edgeProportions(),
684 747
                 transitionLabels = edgeLabels() == "Show",
685
-                transitionThreshold = edgeThreshold()
748
+                transitionThreshold = edgeThreshold(),
749
+                featureName = featureName
686 750
             ) +
687 751
                 scale_color_manual(values = colors)
688 752
         })
... ...
@@ -843,7 +907,7 @@ globalVariables(c(
843 907
                 # ^ Hide ggiraph toolbar
844 908
 
845 909
                 ".row { display: flex }",
846
-                "svg { height: 500px !important }"
910
+                "#tree svg { height: 500px !important }"
847 911
                 # ^ Set tree plot size explicitly
848 912
             )
849 913
         ))),
... ...
@@ -923,10 +987,12 @@ globalVariables(c(
923 987
         ui = .makeUI(!is.null(image)),
924 988
         server = .makeServer(
925 989
             assignments = data$assignments,
990
+            clusterMeans = data$means,
926 991
             scores = data$scores,
927 992
             colors = data$colors,
928 993
             image = image,
929
-            coordinates = data$coordinates
994
+            coordinates = data$coordinates,
995
+            featureName = data$featureName
930 996
         )
931 997
     )
932 998
 }
Browse code

Improve style consistency

Ludvig Bergenstråhle authored on 02/12/2018 13:37:29
Showing1 changed files
... ...
@@ -87,7 +87,8 @@ globalVariables(c(
87 87
 
88 88
                 ## Zero-pad overlap matrix so that all labels are represented in
89 89
                 ## both the to and from dimensions
90
-                paddedOverlaps <- overlaps %>%
90
+                paddedOverlaps <-
91
+                    overlaps %>%
91 92
                     rbind(do.call(
92 93
                         rbind,
93 94
                         rep(list(rep(0, n)), n - nrow(overlaps))
Browse code

Fix resolution sometimes not being a factor

Ludvig Bergenstråhle authored on 30/11/2018 16:46:09
Showing1 changed files
... ...
@@ -190,7 +190,8 @@ globalVariables(c(
190 190
             data.frame(
191 191
                 name = sprintf("resolution %s, cluster %s", res, xs),
192 192
                 resolution = res,
193
-                cluster = xs
193
+                cluster = xs,
194
+                stringsAsFactors = TRUE
194 195
             ) %>%
195 196
             tibble::rownames_to_column("unit")
196 197
         )) %>%
Browse code

Fix indexing lower bound

Ludvig Bergenstråhle authored on 15/11/2018 18:35:13
Showing1 changed files
... ...
@@ -417,9 +417,9 @@ globalVariables(c(
417 417
     c(ymax, xmax) %<-% { c(ymax, xmax) %>% map(~. + 3 * r) }
418 418
 
419 419
     if (!is.null(image)) {
420
-        ymin <- max(ymin, 0)
420
+        ymin <- max(ymin, 1)
421 421
         ymax <- min(ymax, nrow(image$raster))
422
-        xmin <- max(xmin, 0)
422
+        xmin <- max(xmin, 1)
423 423
         xmax <- min(xmax, ncol(image$raster))
424 424
 
425 425
         image$raster <- image$raster[ymin:ymax, xmin:xmax]
Browse code

Change default log multiplier

Ludvig Bergenstråhle authored on 29/10/2018 11:46:40
Showing1 changed files
... ...
@@ -885,7 +885,7 @@ globalVariables(c(
885 885
                         shiny::numericInput(
886 886
                             "scoreMultiplier",
887 887
                             "Score log-multiplier:",
888
-                            max = 10, min = -10, value = 0, step = 0.1
888
+                            max = 10, min = -10, value = 5, step = 0.1
889 889
                         ),
890 890
                         shiny::numericInput(
891 891
                             "spotOpacity",
Browse code

Lower default opacity if background image is used

Ludvig Bergenstråhle authored on 29/10/2018 11:49:15
Showing1 changed files
... ...
@@ -890,7 +890,10 @@ globalVariables(c(
890 890
                         shiny::numericInput(
891 891
                             "spotOpacity",
892 892
                             "Opacity:",
893
-                            max = 100, min = 1, value = 100, step = 10
893
+                            max = 100,
894
+                            min = 1,
895
+                            value = if (imageButton) 70 else 100,
896
+                            step = 10
894 897
                         ),
895 898
                         shiny::numericInput(
896 899
                             "spotSize",
Browse code

Compute relative scores

Ludvig Bergenstråhle authored on 29/10/2018 11:51:22
Showing1 changed files
... ...
@@ -370,9 +370,15 @@ globalVariables(c(
370 370
                 ungroup()
371 371
         }
372 372
 
373
+    normalizedScores <-
374
+        scores %>%
375
+        group_by(.data$resolution, .data$spot) %>%
376
+        mutate(score = .data$score / sum(.data$score)) %>%
377
+        ungroup()
378
+
373 379
     list(
374 380
         assignments = assignments %>% rename(unit = !! sym(margin)),
375
-        scores = scores,
381
+        scores = normalizedScores,
376 382
         colors = colors,
377 383
         coordinates = coordinates
378 384
     )
Browse code

Increase debounce times

Ludvig Bergenstråhle authored on 29/10/2018 11:50:58
Showing1 changed files
... ...
@@ -660,12 +660,12 @@ globalVariables(c(
660 660
         ###
661 661
         ## INPUTS
662 662
         edgeProportions <- reactive({ input$edgeProportions })
663
-        edgeThreshold   <- reactive({ input$edgeThreshold   }) %>% debounce(500)
663
+        edgeThreshold   <- reactive({ input$edgeThreshold   }) %>% debounce(1000)
664 664
         edgeLabels      <- reactive({ input$edgeLabels      })
665
-        scoreMultiplier <- reactive({ input$scoreMultiplier }) %>% debounce(500)
665
+        scoreMultiplier <- reactive({ input$scoreMultiplier }) %>% debounce(1000)
666 666
         showImage       <- reactive({ input$showImage       })
667
-        spotOpacity     <- reactive({ input$spotOpacity     }) %>% debounce(500)
668
-        spotSize        <- reactive({ input$spotSize        }) %>% debounce(500)
667
+        spotOpacity     <- reactive({ input$spotOpacity     }) %>% debounce(1000)
668
+        spotSize        <- reactive({ input$spotSize        }) %>% debounce(1000)
669 669
 
670 670
         ###
671 671
         ## CLUSTER TREE
Browse code

Log counts when computing cluster scores

Ludvig Bergenstråhle authored on 29/10/2018 11:33:21
Showing1 changed files
... ...
@@ -352,6 +352,7 @@ globalVariables(c(
352 352
         } else {
353 353
             normalizedCounts <-
354 354
                 longCounts %>%
355
+                mutate(count = log(.data$count + 1)) %>%
355 356
                 group_by(.data$spot) %>%
356 357
                 mutate(count = .data$count / sum(.data$count)) %>%
357 358
                 group_by(.data$gene) %>%
Browse code

Base gene clustering on z-normalized spatial distributions

Ludvig Bergenstråhle authored on 29/10/2018 11:31:19
Showing1 changed files
... ...
@@ -16,7 +16,7 @@
16 16
 #' @importFrom readr read_file write_file
17 17
 #' @importFrom rlang !! := .data sym
18 18
 #' @importFrom shiny debounce observeEvent reactive
19
-#' @importFrom stats dist kmeans setNames
19
+#' @importFrom stats dist kmeans setNames sd
20 20
 #' @importFrom SummarizedExperiment assay
21 21
 #' @importFrom tibble column_to_rownames rownames_to_column
22 22
 #' @importFrom tidyr gather separate spread unite
... ...
@@ -52,6 +52,18 @@ globalVariables(c(
52 52
     score / sum(score)
53 53
 }
54 54
 
55
+#' Z-score
56
+#'
57
+#' @param xs vector of observations
58
+#' @return `xs`, z-normalized. if all elements of `xs` are equal, a vector of
59
+#'     zeros will be returned instead.
60
+#' @keywords internal
61
+.zscore <- function(xs) {
62
+    std <- sd(xs)
63
+    std <- if (std == 0.0) 1 else std
64
+    (xs - mean(xs)) / std
65
+}
66
+
55 67
 
56 68
 #' Maximize overlap
57 69
 #'
... ...
@@ -280,8 +292,9 @@ globalVariables(c(
280 292
             if (margin == "spot") t(counts)
281 293
             else {
282 294
                 log(as.matrix(counts) + 1) %>%
283
-                    t() %>%
284
-                    cov()
295
+                    prop.table(margin = 2) %>%
296
+                    apply(1, .zscore) %>%
297
+                    t()
285 298
             }
286 299
         )) %>%
287 300
         setNames(resolutions) %>%
Browse code

Specify score in log space

Ludvig Bergenstråhle authored on 28/10/2018 23:15:13
Showing1 changed files
... ...
@@ -726,7 +726,7 @@ globalVariables(c(
726 726
                                     interpolate = TRUE
727 727
                                 )
728 728
                             else NULL,
729
-                        scoreMultiplier = scoreMultiplier(),
729
+                        scoreMultiplier = 2 ** scoreMultiplier(),
730 730
                         spotScale = spotSize() / 5,
731 731
                         spotOpacity = spotOpacity() / 100
732 732
                     ) +
... ...
@@ -864,8 +864,8 @@ globalVariables(c(
864 864
                         else NULL,
865 865
                         shiny::numericInput(
866 866
                             "scoreMultiplier",
867
-                            "Score multiplier:",
868
-                            max = 10, min = 0.1, value = 1, step = 0.2
867
+                            "Score log-multiplier:",
868
+                            max = 10, min = -10, value = 0, step = 0.1
869 869
                         ),
870 870
                         shiny::numericInput(
871 871
                             "spotOpacity",
Browse code

Improve gene margin clustering and scoring

Ludvig Bergenstråhle authored on 28/10/2018 22:46:02
Showing1 changed files
... ...
@@ -277,7 +277,12 @@ globalVariables(c(
277 277
         resolutions %>%
278 278
         map(~assignmentFunction(
279 279
             .,
280
-            if (margin == "spot") t(counts) else counts
280
+            if (margin == "spot") t(counts)
281
+            else {
282
+                log(as.matrix(counts) + 1) %>%
283
+                    t() %>%
284
+                    cov()
285
+            }
281 286
         )) %>%
282