In ventri2020/rraysplot: Make 2D Arrays Plots Less Aggravating

28 Graphics for communication:
- 28.7.1 Figure sizing

If you want to make sure the font size is consistent across all your figures, whenever you set out.width, you’ll also need to adjust fig.width to maintain the same ratio with your default out.width.

For example, if your default fig.width is 6 and out.width is 0.7, when you set out.width = "50%" you’ll need to set fig.width to 4.3 (6 * 0.5 / 0.7).

adjust_fig_width <- function(
    fig_width = 6, old_out_width = 70, new_out_width = 50) {
  round(fig_width * new_out_width / old_out_width, digits = 1)
}
# adjust_fig_width()                    # 4.3
# adjust_fig_width(old_out_width = 100) # 3

knitr::opts_chunk$set(
  fig.retina = TRUE,
  collapse = TRUE,
  comment = "#>",
  fig.path = "data-contact-sheets/fat40e1_768x384-",
  fig.width = 6,
  fig.asp = 0.618,
  fig.align = "center",
  out.width = "100%"
)

`%>%` <- purrr::`%>%`
`%<-%` <- zeallot::`%<-%`

options(buildtools.check = NULL)
# devtools::install_github('r-lib/ragg')
# install.packages("zeallot")
# install.packages("patchwork")

inch <- function(w, h, ppi) sqrt((w/ppi)^2 + (h/ppi)^2)
inch(5120, 2880, ppi = 218) # iMac 27"
inch(2560, 1600, ppi = 227) # MacBook Pro 13.3"

Using a Retina display, dpilove:

27-inch iMac models introduced in 2014 or later. Native resolution: 5120 x 2880 (16:9) at 218 ppi (pixels per inch). Models introduced in 2014 and 2015 support millions of colors, and models introduced in 2017 or later support one billion colors. Approx. 23 x 13 in.
13-inch MacBook Pro models introduced in late 2012 or later. Native resolution: 2560 x 1600 (16:10) at 227 ppi. Support for millions of colors. Approx 11 x 7 in.

Taking Control of Plot Scaling.

library(tidyverse, warn.conflicts = FALSE)
library(patchwork)
library(ragg)
library(zeallot)

library(rraysplot)
packageVersion("rraysplot", lib.loc = "~/Library/R/4.0/library/")

iMac, MacBook Pro width and height in cm

c(3240, 1080) / 218        # in
c(3240, 1080) / 218 * 2.54 # cm
c(2160, 720) / 227         # in
c(2160, 720) / 227 * 2.54  # cm

contact_sheet <- function(patient, image, scat, vsat) {
  p1 <- rraysplot::plot_array2d(
    image, 
    title = patient, title_size = 10)
  p2 <- rraysplot::plot2_array2d(
    image, scat,
    title = "SCAT", title_size = 9, alpha = 0.8)
  p3 <- rraysplot::plot2_array2d(
    image, vsat, 
    title = "VSAT", title_size = 9, alpha = 0.6)

  print(p1 | p2 | p3)
}

all_contact_sheets <- function(
  directory = "data-contact-sheets",
  prefix = "768x384"
) {
  load(file = "data-raw/fat40e1_768x384.rda")
  data <- fat40e1_768x384
  patients = dimnames(data$image)[[1]]

  for (patient in patients) {
    img = data$image[patient,,]
    scat = data$scat[patient,,]
    vsat <- data$vsat[patient,,]

    if (!fs::dir_exists(directory)) fs::dir_create(directory)

    jpegfile <- fs::path(
      directory, 
      stringr::str_c(prefix, "-", patient, ".jpeg")
    )
    agg_jpeg(jpegfile,
      width = 2160, height = 518, units = "px", res = 227,
      # width = 3240, height = 777, units = "px", res = 218,
      scaling = 1
    )
    contact_sheet(patient, img, scat, vsat)
    invisible(dev.off())
  }
}

contact_sheets <- function(
  data = rraysplot::fat_768x384x1,
  kind = "test",
  directory = "data-contact-sheets",
  prefix = "768x384x1"
) {
  patients = dimnames(data[[kind]]$image)[[1]]

  for (patient in patients) {
    img = data[[kind]]$image[patient,,,]
    scat = data[[kind]]$scat[patient,,,]
    vsat <- data[[kind]]$vsat[patient,,,]

    if (!fs::dir_exists(directory)) fs::dir_create(directory)

    jpegfile <- fs::path(
      directory, 
      stringr::str_c(kind, "-", prefix, "-", patient, ".jpeg")
    )
    agg_jpeg(jpegfile,
      width = 2160, height = 518, units = "px", res = 227,
      # width = 3240, height = 777, units = "px", res = 218,
      scaling = 1
    )
    contact_sheet(patient, img, scat, vsat)
    invisible(dev.off())
  }
}

patient_contact_sheet <- function(patient, set = "test") {
  img  = eval(sym(stringr::str_c("image_", set)))[patient,,,]
  scat  = eval(sym(stringr::str_c("scat_", set)))[patient,,,]
  vsat  = eval(sym(stringr::str_c("vsat_", set)))[patient,,,]

  contact_sheet(patient, img, scat, vsat)
}

get_image_mask <- function(path) {
  img <- ANTsRCore::antsImageRead(path)
  ch1 <- ANTsRCore::splitChannels(img)[[1]]
  slice <- ANTsRCore::extractSlice(ch1, slice = 1, direction = 3)
  mask <- ANTsRCore::getMask(slice, cleanup = 2)

  list(image = slice, mask = mask)
}

Print all Contact Sheets

all_contact_sheets(
  directory = "data-contact-sheets",
  prefix = "768x384"
)

Read Test and Train Tensors

c(
  c(image_train, ., scat_train, vsat_train),
  c(image_test, ., scat_test, vsat_test)
) %<-% rraysplot::fat_384x192x1

Check tensor dimensions.

dim(image_train)
dim(image_test)

dimnames(image_test)[[1]]
cat("\n")
dimnames(image_train)[[1]]

Display Broken Images

broken_test <- c("1110505-2012")
broken_train <- c("600725-2013", "806365", "858488")

broken_test_info <- images_info("../80_images") %>%
  dplyr::filter(patient %in% broken_test & kind == "MRI")
broken_test_info

broken_train_info <- images_info("../80_images") %>%
  dplyr::filter(patient %in% broken_train & kind == "MRI")
broken_train_info

im <- get_image_mask(broken_test_info$file_path[[1]])
plotBlendedImages(im$image, mask = im$mask)

im1 <- get_image_mask(broken_train_info$file_path[[1]])
p1 <- plotBlendedImages(im1$image, mask = im1$mask)
im2 <- get_image_mask(broken_train_info$file_path[[2]])
p2 <- plotBlendedImages(im2$image, mask = im2$mask)
im3 <- get_image_mask(broken_train_info$file_path[[3]])
p3 <- plotBlendedImages(im3$image, mask = im3$mask)

(p1 | p2 | p3)

NOTE: Only unbroken images tensors, i.e. with correct masks, are saved in fat80_768x384.

contact_sheets(
  data = rraysplot::fat_384x192x1,
  kind = "test",
  directory = "data-contact-sheets",
  prefix = "384x192x1"
)

contact_sheets(
  data = rraysplot::fat_192x96x1,
  kind = "test",
  directory = "data-contact-sheets",
  prefix = "192x96x1"
)

contact_sheets(
  data = rraysplot::fat_384x192x1,
  kind = "train",
  directory = "data-contact-sheets",
  prefix = "384x192x1"
)

contact_sheets(
  data = rraysplot::fat_192x96x1,
  kind = "train",
  directory = "data-contact-sheets",
  prefix = "192x96x1"
)