Merge pull request #24 from BodenmillerGroup/custom_scale

Pixel resolution
BodenmillerGroup · Jan 5, 2024 · 5ec2863 · 5ec2863
2 parents 0096758 + 1410c06
commit 5ec2863
Show file tree

Hide file tree

Showing 6 changed files with 114 additions and 26 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: cytoviewer
-Version: 1.3.1
+Version: 1.3.2
 Title: An interactive multi-channel image viewer for R
 Description: 
     This R package supports interactive visualization of multi-channel images 

diff --git a/NEWS b/NEWS
@@ -42,3 +42,6 @@ Changes in version 1.1.3 (2023-10-19):
 
 Changes in version 1.3.1 (2024-01-04): 
 + updated README and added citation file
+
+Changes in version 1.3.2 (2024-01-05): 
++ added pixel resolution option
diff --git a/R/interface_cytoviewer.R b/R/interface_cytoviewer.R
@@ -226,6 +226,7 @@
                  menuItem("Basic controls", 
                           menuItem("Image appearance",
                           uiOutput("scalebar_controls"),
+                          uiOutput("resolution_controls"),
                           checkboxInput(inputId = "show_legend","Show Legend", 
                                         value = FALSE),
                           checkboxInput(inputId = "show_title","Show Title", 

diff --git a/R/outputs_cytoviewer.R b/R/outputs_cytoviewer.R
@@ -13,9 +13,12 @@
   .create_interactive_observer(image, mask, input, session)
 
   output$scalebar_controls <- renderUI({})
+  output$resolution_controls <- renderUI({})
   outputOptions(output, "scalebar_controls", suspendWhenHidden = FALSE)
+  outputOptions(output, "resolution_controls", suspendWhenHidden = FALSE)
   output$scalebar_controls <- .add_scalebar(input, object, mask,image, 
                                             img_id, cell_id)
+  output$resolution_controls <- .add_resolution(input)
 
   ## Session info 
   cur_sessionInfo <- sessionInfo()

diff --git a/R/utils_cytoviewer.R b/R/utils_cytoviewer.R
@@ -103,8 +103,9 @@
         # return updated img_id 
         updated_sample <- img_IDs[updated_index]
 
-        updateSelectInput(session, inputId = "sample",
+        updateSelectizeInput(session, inputId = "sample",
                         choices = unique(img_IDs),
+                        server = TRUE,
                         selected = updated_sample)
 
         }, ignoreInit = TRUE)    
@@ -118,8 +119,9 @@
         # return updated img_id
         updated_sample <- img_IDs[updated_index]
 
-        updateSelectInput(session, inputId = "sample",
+        updateSelectizeInput(session, inputId = "sample",
                         choices = unique(img_IDs),
+                        server = TRUE,
                         selected = updated_sample)
 
     }, ignoreInit = TRUE)    
@@ -133,6 +135,7 @@
   # Store image IDs
     updateSelectizeInput(session, inputId = "sample",
                         choices = unique(img_IDs),
+                        server = TRUE,
                         selected = unique(img_IDs)[1])
 
   # Store marker names 
@@ -324,7 +327,8 @@
     cur_color <- cur_color[names(cur_color) != ""]
 
     cur_basic_outline <- input$basic_color_outline
-    cur_scale <- input$scalebar
+    cur_scale <- .get_scalebar(input)
+    cur_resolution <- .get_resolution(input)
     cur_thick <- input$thick
     cur_interpolate <- input$interpolate
 
@@ -350,7 +354,7 @@
                    legend = cur_legend,
                    image_title = cur_imagetitle,
                    thick = cur_thick,
-                   scale_bar = list(length = cur_scale),
+                   scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                    interpolate = cur_interpolate,
                    ...)
 
@@ -407,7 +411,7 @@
                    legend = cur_legend,
                    image_title = cur_imagetitle,
                    thick = cur_thick,
-                   scale_bar = list(length = cur_scale),
+                   scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                    interpolate = cur_interpolate,
                    ...)
 
@@ -419,7 +423,7 @@
                  bcg = cur_bcg,
                  legend = cur_legend,
                  image_title = cur_imagetitle,
-                 scale_bar = list(length = cur_scale),
+                 scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                  interpolate = cur_interpolate,
                  ...)   
     }
@@ -474,7 +478,8 @@
     cur_bcg <- cur_bcg[names(cur_bcg) != ""]
 
     cur_basic_outline <- input$basic_color_outline
-    cur_scale <- input$scalebar
+    cur_scale <- .get_scalebar(input)
+    cur_resolution <- .get_resolution(input)
     cur_thick <- input$thick
     cur_interpolate <- input$interpolate
 
@@ -500,7 +505,7 @@
                  legend = cur_legend,
                  image_title = cur_imagetitle,
                  thick = cur_thick,
-                 scale_bar = list(length = cur_scale),
+                 scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                  interpolate = cur_interpolate,
                  return_plot = TRUE,
                  ...)
@@ -552,7 +557,7 @@
                  legend = cur_legend,
                  image_title = cur_imagetitle,
                  thick = cur_thick,
-                 scale_bar = list(length = cur_scale),
+                 scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                  interpolate = cur_interpolate,
                  return_plot = TRUE,
                  ...)
@@ -565,7 +570,7 @@
                  bcg = cur_bcg,
                  legend = cur_legend,
                  image_title = cur_imagetitle,
-                 scale_bar = list(length = cur_scale),
+                 scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
                  interpolate = cur_interpolate,
                  return_plot = TRUE,
                  ...)   
@@ -963,7 +968,8 @@
 
   req(img_id)
 
-  cur_scale <- input$scalebar
+  cur_scale <- .get_scalebar(input)
+  cur_resolution <- .get_resolution(input)
   cur_legend <- .show_legend(input)
   cur_imagetitle <- .show_title(input)
   cur_missingcolor <- input$missing_colorby
@@ -1047,7 +1053,7 @@
             missing_colour = cur_missingcolor, 
             legend = cur_legend,
             image_title = cur_imagetitle,
-            scale_bar = list(length = cur_scale),
+            scale_bar = list(length = cur_scale, label = cur_scale*cur_resolution),
             ...)
 
 }
@@ -1093,7 +1099,40 @@
       cur_value <- round(dim(mask[[1]])[1]/4, digits=-1)
       }
 
-    numericInput(inputId = "scalebar", label = "Scale bar length", 
+    numericInput(inputId = "scalebar", label = "Scale bar length [Pixels]", 
                  value = cur_value, min = 0, max = 1000, step = 5)
   })
 }
+
+.get_scalebar <- function(input){
+  cur_scale <- input$scalebar
+
+  validate(
+    need(!is.na(cur_scale) && cur_scale > 0, "NOTE: Please specify a [Scale bar length [Pixels]] value."),
+  )
+
+  return(cur_scale)
+}
+
+# Add resolution tab
+.add_resolution <- function(input){
+  renderUI({
+    numericInput(inputId = "resolution", label = "Pixel resolution [um]", 
+                 value = 1, min = 0, max = 100, step = 1)
+  })
+}
+
+.get_resolution <- function(input){
+  cur_resolution <- input$resolution
+
+  validate(
+    need(!is.na(cur_resolution) && cur_resolution > 0, "NOTE: Please specify a [Pixel resolution [um]] value."),
+    )
+
+  return(cur_resolution)
+}
+
+
+
+
+
diff --git a/tests/testthat/test_cytoviewer_reactive.R b/tests/testthat/test_cytoviewer_reactive.R
@@ -14,7 +14,7 @@ test_that("cytoviewer: input testing works", {
                       contrast1 = 1, contrast2 = 1, contrast3 = 1, contrast4 = 1, contrast5 = 1,
                       brightness1 = 1, brightness2 = 1, brightness3 = 1, brightness4 = 1, brightness5 = 1,
                       gamma1 = 1, gamma2 = 1, gamma3 = 1, gamma4 = 1, gamma5 = 1,
-                      color1 = "#FF00FF", color2 = "#00FFFF", color3 = "#FFFF00", color4 = "#FF0000", color5 = "#00FF00")
+                      color1 = "#FF00FF", color2 = "#00FFFF", color3 = "#FFFF00", color4 = "#FF0000", color5 = "#00FF00", resolution = 1)
 
     expect_equal(input$sample, "E34_imc")
     expect_equal(input$marker1, "H3")
@@ -70,7 +70,8 @@ test_that("cytoviewer: plot input testing works", {
                       thick = FALSE, 
                       interpolate = TRUE,
                       outline = FALSE, 
-                      outline_by = NULL
+                      outline_by = NULL, 
+                      resolution = 1
 )
 
     image <- pancreasImages[1]
@@ -141,7 +142,8 @@ test_that("cytoviewer: plot input 2 testing works", {
                       thick = FALSE, 
                       interpolate = TRUE,
                       outline = TRUE, 
-                      outline_by = ""
+                      outline_by = "", 
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -182,7 +184,8 @@ test_that("cytoviewer: plot input 3 testing works", {
                       interpolate = TRUE,
                       outline = TRUE, 
                       outline_by = "CellType",
-                      select_outline = "celltype_C"
+                      select_outline = "celltype_C",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -224,7 +227,8 @@ test_that("cytoviewer: plot input 4 testing works", {
                       interpolate = TRUE,
                       outline = TRUE, 
                       outline_by = "Area",
-                      numeric_color_outline = "viridis"
+                      numeric_color_outline = "viridis",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -264,7 +268,8 @@ test_that("cytoviewer: plot input 5 testing works", {
                       thick = FALSE, 
                       interpolate = TRUE,
                       outline = TRUE,
-                      outline_by = ""
+                      outline_by = "",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -300,7 +305,8 @@ test_that("cytoviewer: plot input 6 testing works", {
                       color_by = "CellType",
                       color_by_selection = "celltype_C",
                       color_by1 = "blue",
-                      missing_colorby = "white"
+                      missing_colorby = "white",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -336,7 +342,8 @@ test_that("cytoviewer: plot input 7 testing works", {
                       color_by = "Pattern",
                       color_by_selection = "1",
                       color_by1 = "blue",
-                      missing_colorby = "white"
+                      missing_colorby = "white",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -371,7 +378,8 @@ test_that("cytoviewer: plot input 8 testing works", {
                       plotcells = TRUE, 
                       color_by = "Area",
                       color_by_selection = "Area",
-                      numeric_colorby = "viridis"
+                      numeric_colorby = "viridis",
+                      resolution = 1
     )
     image <- NULL
     mask <- pancreasMasks[1]
@@ -403,7 +411,8 @@ test_that("cytoviewer: plot input 9 testing works", {
                       scalebar = 20,
                       interpolate = TRUE,
                       plotcells = TRUE,
-                      color_by = ""
+                      color_by = "",
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -434,7 +443,8 @@ test_that("cytoviewer: plot input 10 testing works", {
                       scalebar = 20,
                       interpolate = TRUE,
                       plotcells = TRUE,
-                      color_by = ""
+                      color_by = "",
+                      resolution = 1
     )
 
     image <- NULL
@@ -472,7 +482,8 @@ test_that("cytoviewer: plot input 11 testing works", {
                       thick = FALSE, 
                       interpolate = TRUE,
                       outline = FALSE, 
-                      outline_by = NULL
+                      outline_by = NULL,
+                      resolution = 1
     )
 
     image <- pancreasImages[1]
@@ -489,3 +500,34 @@ test_that("cytoviewer: plot input 11 testing works", {
   })
 
 })  
+
+test_that("cytoviewer: plot input 12 testing works", {
+
+  # Load datasets 
+  library(cytomapper)
+  data("pancreasMasks")
+  data("pancreasSCE")
+
+  testServer(app = cytoviewer(mask = pancreasMasks, object = pancreasSCE, img_id = "ImageNb", cell_id = "CellNb"), {
+
+    session$setInputs(sample = "E34_mask", 
+                      show_legend = FALSE, 
+                      show_title = FALSE,
+                      gaussian_blur = FALSE, 
+                      scalebar = 20,
+                      interpolate = TRUE,
+                      plotcells = TRUE,
+                      color_by = "",
+                      resolution = 1
+    )
+
+    image <- NULL
+    mask <- pancreasMasks[1]
+    object <- NULL
+    img_id <- "ImageNb"
+
+    # Plot cells output (Masks but no images and object)
+    expect_silent(.create_cells(input, object, mask, image, img_id, cell_id))
+
+  })
+})