Spatial map viewer supports selecting the desired view when the expor…

…ted composite files contain multiple views.

NEWS.md

@@ -6,6 +6,10 @@ Analysis addin:
 - Allow selecting (and reporting on) multiple score summary files #49
 - Tabs with H-Score results include the scored marker name 
   (in support of #49)
+
+Spatial map viewer:
+- Add support for selecting the desired view when the exported
+  composite files contain multiple views.
 
 Consolidate and summarize addin:
 - Add a dummy `Phenotype` column if none is present #48

R/spatial_maps.R

@@ -11,6 +11,7 @@ utils::globalVariables(
 #'
 #' @param csd Cell seg data with distance columns
 #' @param field_name Sample Name or Annotation ID to map
+#' @param view_number Image index within the composite data
 #' @param export_path Path to a directory containing composite and component
 #'   image files from inForm
 #' @param phenos Named list of phenotype definitions. Must have length 2.
@@ -27,7 +28,7 @@ utils::globalVariables(
 #' }
 #' @export
 nearest_neighbor_map =
-  function(csd, field_name, export_path,
+  function(csd, field_name, view_number, export_path,
            phenos, color1, color2,
            show_as=c('from_to', 'to_from', 'mutual', 'none'),
            dot_size=3, add_logo=TRUE) {
@@ -70,7 +71,7 @@ nearest_neighbor_map =
     dplyr::filter(phenoptr::select_rows(field_data, pheno2))
 
   # Start making the plot
-  background = read_background(field_name, export_path)
+  background = read_background(field_name, view_number, export_path)
 
   # Make a base plot
   xlim=c(field_info$location[1],
@@ -305,7 +306,7 @@ id_column_name = function(pheno_names) {
 }
 
 # Try to read a composite image for a field as a nativeRaster
-read_background = function(field, export_path) {
+read_background = function(field, view_number, export_path) {
   # Field can be an Annotation ID or Sample Name
   # If it is a sample name, remove the .im3 suffix
   field_base = stringr::str_remove(field, '\\.im3')
@@ -315,16 +316,24 @@ read_background = function(field, export_path) {
     '_composite_image.tif',
     '_composite_image.jpg'
   )
+  browser()
   for (ending in image_endings) {
-    background_path = file.path(export_path, paste0(field_base, ending))
-    if (file.exists(background_path)) break
+    background_path =
+      list.files(export_path, full.names=TRUE, recursive=TRUE,
+                 pattern=paste0('\\Q', field_base, ending, '\\E'))[1]
+    if (!is.na(background_path) && file.exists(background_path)) break
   }
 
   # Read the image as a nativeRaster
   if (file.exists(background_path)) {
     if (grepl('jpg$', background_path))
       background = jpeg::readJPEG(background_path, native=TRUE)
-    else background = tiff::readTIFF(background_path, native=TRUE)
+    else {
+      # Read all and subset to avoid "Warning: stack imbalance"
+      # https://github.com/s-u/tiff/issues/10
+      background =
+        tiff::readTIFF(background_path, native=TRUE, all=TRUE)[[view_number]]
+    }
   } else {
     background = NULL
   }

inst/spatial_map_viewer_app/global.R

@@ -18,6 +18,20 @@ available_phenotypes = phenoptr::unique_phenotypes(csd) %>%
 
 available_fields = sort(unique(csd[[phenoptr::field_column(csd)]]))
 
+# Open one composite to figure out the available views
+composite_path = list.files(.export_path, pattern='composite_image\\.',
+                            full.names=TRUE, recursive=TRUE)[1]
+if (is.na(composite_path))
+  stop('No composite images found in ', .export_path)
+
+if (endsWith(composite_path, 'jpg')) {
+  available_views=c(Standard=1)
+} else {
+  info = phenoptr::read_composite_info(composite_path)
+  available_views = seq_along(info) %>%
+    setNames(purrr::map_chr(info, 'composite_name'))
+}
+
 # Create a temp dir to save image files in
 temp_dir = file.path(tempdir(), 'image')
 dir.create(temp_dir, showWarnings=FALSE)

inst/spatial_map_viewer_app/server.R

@@ -59,7 +59,9 @@ server = function(input, output, session) {
     shiny::isolate(update_from_to(pheno1, pheno2, input$show_as))
 
     phenos = phenoptrReports:::parse_phenotypes_with_na(pheno1, pheno2)
-    phenoptrReports::nearest_neighbor_map(csd, input$field, .export_path,
+    phenoptrReports::nearest_neighbor_map(csd, input$field,
+                                          as.numeric(input$view),
+                                          .export_path,
                                           phenos,
                                           phenotype_output()$color,
                                           phenotype2_output()$color,
@@ -283,7 +285,9 @@ server = function(input, output, session) {
                                             phenos, color1, color2,
                                             discard_dups=TRUE)
       } else {
-        phenoptrReports::nearest_neighbor_map(csd, field, .export_path,
+        phenoptrReports::nearest_neighbor_map(csd, field,
+                                              as.numeric(input$view),
+                                              .export_path,
                                               phenos, color1, color2,
                                               show_as, dot_size, add_logo)
       }

inst/spatial_map_viewer_app/ui.R

@@ -84,9 +84,12 @@ ui <- shinydashboard::dashboardPage(
       shiny::column(2, shiny::actionButton('previous', 'Previous',
                                            class='prev-next')),
       shiny::column(5, shiny::selectInput('field', 'Field:',
+                                          width='400px',
                                            choices=available_fields)),
       shiny::column(2, shiny::actionButton('nxt', 'Next',
-                                           class='prev-next'))
+                                           class='prev-next')),
+      shiny::column(3, shiny::selectInput('view', 'View',
+                                          choices=available_views))
     ),
     shiny::conditionalPanel(condition='input.show_as !="touching"',
       shiny::plotOutput('plot', height='800px')

tests/testthat/test_spatial_maps.R

@@ -11,27 +11,27 @@ test_that("nearest_neighbor_map works", {
   field_name = "Melanoma_2_Scan1_[11940,51021]"
   phenos = phenoptr::parse_phenotypes('CD8+', 'Tumor+')
 
-  nn = nearest_neighbor_map(csd, field_name, export_path, phenos,
+  nn = nearest_neighbor_map(csd, field_name, 1, export_path, phenos,
                            'red', 'blue', 'from_to')
   vdiffr::expect_doppelganger('from_to plot matches', nn$plot)
   expect_equal(nrow(nn$data), 225)
 
-  nn = nearest_neighbor_map(csd, field_name, export_path, phenos,
+  nn = nearest_neighbor_map(csd, field_name, 1, export_path, phenos,
                            'red', 'blue', 'from_to', dot_size=1, add_logo=FALSE)
   vdiffr::expect_doppelganger('from_to dot-1 no logo plot matches', nn$plot)
   expect_equal(dim(nn$data), c(225, 13))
 
-  nn = nearest_neighbor_map(csd, field_name, export_path, phenos,
+  nn = nearest_neighbor_map(csd, field_name, 1, export_path, phenos,
                            'red', 'blue', 'to_from')
   vdiffr::expect_doppelganger('to_from plot matches', nn$plot)
   expect_equal(dim(nn$data), c(347, 13))
 
-  nn = nearest_neighbor_map(csd, field_name, export_path, phenos,
+  nn = nearest_neighbor_map(csd, field_name, 1, export_path, phenos,
                            'red', 'blue', 'mutual')
   vdiffr::expect_doppelganger('mutual plot matches', nn$plot)
   expect_equal(dim(nn$data), c(86, 13))
 
-  nn = nearest_neighbor_map(csd, field_name, export_path, phenos,
+  nn = nearest_neighbor_map(csd, field_name, 1, export_path, phenos,
                            'red', 'blue', 'none')
   vdiffr::expect_doppelganger('none plot matches', nn$plot)
   expect_equal(nn$data, NULL)