In this demo, we will examine an aorta section stained with Movat pentachrome. The [@R-tidyverse], [@R-magick], and [@R-EBImage] packages have been loaded.

First, load the image to be examined. The image is a cropped tiff of a larger slide. Since the file is actually a stack of images with images of the slide label, thumbnail, etc, I only the load the first in the stack.

img <- magick::image_read(path$img)[1]
image_info(img)
## # A tibble: 1 x 7
##   format width height colorspace matte filesize density
##   <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
## 1 TIFF     817    883 sRGB       FALSE  6398284 72x72

We can see that the image is a color TIFF sized 817x883 pixels. This is a close crop of tissue containing numerous myocytes (purple) interspersed with elastin (black), collagen (yellow), and glycosaminoglycans (GAGs, blue). In this demo, we will identify and describe the GAGs present.

img

In histological analysis, we would like to be able to categorize each individual pixel in the image according stain color, and therefore, tissue. Despite this being a small crop of a much larger image, it contains 153,422 unique colors.

To simplify the task we have constructed a reference set of colors (also known as a color lookup table, or clut), shown below.

plot_colors
Reference Colors

Reference Colors

Magick’s image_map function will take each pixel in the original image and replace it with the closest color from the clut.

img_map <- magick::image_map(img, map=img_swatch, dither=F)

When the original and mapped images are compared side-by-side, we can tell that a transformation has occurred but the vital information has been retained.

image_montage(c(img, img_map), geometry="817x883+10+10", tile='2x1',bg="black")

We can then use our reference key to create a mask containing all pixels belonging to a certain color stain.

However, we first have to transform the data into a more useable structure. The standard way to store color image data is in a stacked array with dimensions 3, 817, 883, where the first dimension refers to the red, blue, and green components of each color, respectively. If we look at the values for the pixels at position 400, 400, we find 1b, 23, 38. Together, these are the hex code for the color of the pixel at position 400, 400.

scales::show_col("#1b2338")

Fortunately, we can easily transform our mapped image into a list of hex codes with the command image_raster. We then create the mask by changing all of the desired hex codes to #FFFFFF (white) and everything else to #000000 (black), or vice versa as needed.

# create a list of blue hex codes
hex_key <- dta_swatch %>% filter(color_stain=="blue") %>% pull(hex_code) 

# store the dimensions of the original image
dim <- image_info(img_map)[, c("width", "height")]
# assemble lis tof hex codes, change all blue codes to white and everything else to black
dta <- image_raster(img_map) %>%
  mutate(thresh = ifelse(col %in% hex_key, "#FFFFFF", "#000000"))
# assemble the mask (note the need to transpose)
img_mask <- matrix(dta$thresh, nrow=dim$width, ncol=dim$height) %>%
  t()
#  the mask must be stored as a greyscale image
img_mask <- image_channel(image_read(img_mask), channel="All")
image_montage(c(img, img_map, img_mask),
              geometry="817x883+10+10", 
              tile="3x1", bg="black")

Further operations on the image are best completed with the [@R-EBImage] package.

# change to class EBImage
i <- as_EBImage(img_mask)
display(i)

Finally, the mask is segmented into individuals objects with the bwlabel function.1 Individual objects can be visualized with colorLabels.

obj <- bwlabel(i)
display(colorLabels(obj))

Now we are ready to perform calculations on the mask. EBImage has some built-in functions to do so; for brevity only a few basic shape calculations are shown.

dta_obj <- computeFeatures.shape(obj)
dta_obj <- data.frame(dta_obj)
cowplot::plot_grid(plotlist=plotlist)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

  1. Again, there are many more options available.↩︎