Add the bulk of code for writing the lowres image and scalefactors fo…

…r the image stitched in ImageJ. Needs more testing and documentation

NAMESPACE

@@ -3,13 +3,15 @@
 export(add_array_coords)
 export(add_overlap_info)
 export(build_spe)
+export(prep_imagej_image)
 export(read_imagej_xml)
 export(spe_to_seurat)
 export(spot_plot)
 import(Seurat)
 import(SpatialExperiment)
 import(dplyr)
 import(ggplot2)
+import(imager)
 import(spatialLIBD)
 import(tibble)
 import(xml2)
@@ -24,6 +26,7 @@ importFrom(dplyr,summarize)
 importFrom(grDevices,col2rgb)
 importFrom(readr,read_csv)
 importFrom(rjson,fromJSON)
+importFrom(rjson,toJSON)
 importFrom(rlang,arg_match)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split_i)

R/prep_imagej_image.R

@@ -0,0 +1,79 @@
+#' Create low-res image and scale factors from high-res ImageJ output image
+#'
+#' [DESCRIPTION HERE]
+#'
+#' @param sample_info A \code{tibble} with columns \code{capture_area},
+#' \code{group}, \code{imagej_image_path}, and \code{spaceranger_dir}.
+#' @param out_dir A character(1) vector giving a path to a directory to place
+#' the output image(s) and scale factors. Provided the parent exists, \code{out_dir}
+#' will be created if necessary.
+#' @param lowres_max_size An integer(1) vector: the resolution (number of
+#' pixels) of the larger dimension of the output image(s), considered to be "low
+#' resolution".
+#'
+#' @return NULL
+#'
+#' @import imager
+#' @importFrom rjson fromJSON toJSON
+#' @importFrom dplyr filter
+#' 
+#' @export
+#' @author Nicholas J. Eagles
+#'
+#' @examples
+#' ## TODO: add working examples
+#' args(prep_imagej_image)
+
+prep_imagej_image <- function(sample_info, out_dir, lowres_max_size = 1200) {
+    if (!all(file.exists(sample_info$imagej_image_path))) {
+        stop("All files in 'sample_info$imagej_image_path' must exist.")
+    }
+
+    dir.create(out_dir, recursive = TRUE, showWarnings = FALSE)
+
+    for (this_group in unique(sample_info$group)) {
+        this_sample_info = sample_info |>
+            dplyr::filter(group == this_group)
+
+        if (length(unique(this_sample_info$imagej_image_path)) > 1) {
+            stop("Expected one unique path for 'imagej_image_path' per group in 'sample_info'.")
+        }
+
+        this_image = load.image(this_sample_info$imagej_image_path[1])
+
+        sr_json <- rjson::fromJSON(
+            file = file.path(
+                this_sample_info$spaceranger_dir[1], "scalefactors_json.json"
+            )
+        )
+
+        #   This is an approximation of the true scalefactors, which are complex
+        #   to precisely compute. In reality, we'd need the dimensions of the 
+        #   smallest rectangle containing the stitched full-resolution images.
+        #   This is far simpler to find, and probably close enough for plotting
+        #   purposes
+        hi_over_low = lowres_max_size / max(dim(this_image)[seq(2)])
+        sr_json$tissue_lowres_scalef = sr_json$tissue_hires_scalef * hi_over_low
+        sr_json$tissue_hires_scalef = NULL
+
+        this_image = resize(
+            this_image,
+            as.integer(hi_over_low * dim(this_image)[1]),
+            as.integer(hi_over_low * dim(this_image)[2])
+        )
+
+        #   Save the lowres image and scalefactors JSON in a subdirectory of
+        #   'out_dir' named with the current group
+        this_out_dir = file.path(out_dir, this_group)
+        dir.create(this_out_dir, showWarnings = FALSE)
+        save.image(
+            this_image, file.path(this_out_dir, 'tissue_lowres_image.png')
+        )
+        write(
+            rjson::toJSON(sr_json),
+            file.path(this_out_dir, 'scalefactors_json.json')
+        )
+    }
+
+    return(NULL)
+}