From 77571d48c5acab1e9489407c55275f9da717953c Mon Sep 17 00:00:00 2001 From: "Win Cowger, PhD" Date: Mon, 20 May 2024 16:16:17 -0700 Subject: [PATCH] add map merging. --- NAMESPACE | 4 ++ R/manage_spec.R | 85 ++++++++++++++++++++++++++++++- man/manage_spec.Rd | 17 ++++++- tests/testthat/test-manage_spec.R | 14 +++++ 4 files changed, 117 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 50845d6a..b0f47033 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,9 @@ S3method(manage_na,OpenSpecy) S3method(manage_na,default) S3method(match_spec,OpenSpecy) S3method(match_spec,default) +S3method(merge_map,OpenSpecy) +S3method(merge_map,default) +S3method(merge_map,list) S3method(os_similarity,OpenSpecy) S3method(os_similarity,default) S3method(plot,OpenSpecy) @@ -103,6 +106,7 @@ export(manage_na) export(match_spec) export(max_cor_named) export(mean_replace) +export(merge_map) export(os_similarity) export(plotly_spec) export(process_spec) diff --git a/R/manage_spec.R b/R/manage_spec.R index 6485f021..6f5fb4ce 100644 --- a/R/manage_spec.R +++ b/R/manage_spec.R @@ -4,8 +4,8 @@ #' @description #' \code{c_spec()} concatenates \code{OpenSpecy} objects. #' \code{sample_spec()} samples spectra from an \code{OpenSpecy} object. -#' -#' @param x a list of \code{OpenSpecy} objects. +#' \code{merge_map()} merge two \code{OpenSpecy} objects from spectral maps. +#' @param x a list of \code{OpenSpecy} objects or of file paths. #' @param range a numeric providing your own wavenumber ranges or character #' argument called \code{"common"} to let \code{c_spec()} find the common #' wavenumber range of the supplied spectra. \code{NULL} will interpret the @@ -14,6 +14,7 @@ #' wavenumbers to be. #' @param size the number of spectra to sample. #' @param prob probabilities to use for the sampling. +#' @param origins a list with 2 value vectors of x y coordinates for the offsets of each image. #' @param \ldots further arguments passed to submethods. #' #' @return @@ -64,6 +65,10 @@ c_spec.OpenSpecy <- function(x, ...) { #' #' @export c_spec.list <- function(x, range = NULL, res = 5, ...) { + if(!is_OpenSpecy(x[[1]])){ + x <- lapply(x, read_any) + } + if(!all(vapply(x, function(y) {inherits(y, "OpenSpecy")}, FUN.VALUE = T))) stop("object 'x' needs to be a list of 'OpenSpecy' objects", call. = F) @@ -126,3 +131,79 @@ sample_spec.OpenSpecy <- function(x, size = 1, prob = NULL, ...) { filter_spec(x, cols) } + + +#' @rdname manage_spec +#' +#' @export +merge_map <- function(x, ...) { + UseMethod("merge_map") +} + +#' @rdname manage_spec +#' +#' @export +merge_map.default <- function(x, ...) { + stop("object 'x' needs to be a list of 'OpenSpecy' objects or file paths") +} + +#' @rdname manage_spec +#' +#' @export +merge_map.OpenSpecy <- function(x, ...) { + stop("object 'x' needs to be a list of 'OpenSpecy' objects or file paths") +} + +#' @rdname manage_spec +#' +#' @export +merge_map.list <- function(x, origins = NULL, ...) { + + if(!is_OpenSpecy(x[[1]])){ + map <- lapply(x, read_any) + } + + else{ + map <- x + } + + if(is.null(origins)){ + origin = lapply(map, function(x) unique(x$metadata$description)) + originx = vapply(origin, function(x) gsub(",.*", "", gsub(".*X=", "", x)) |> as.numeric(), FUN.VALUE = numeric(1)) + originy = vapply(origin, function(x) gsub(".*Y=", "", x) |> as.numeric(), FUN.VALUE = numeric(1)) + xoffset = as.integer((originx-min(originx))/(as.numeric(gsub("(\\{)|(\\})|(,.*)", "",x$metdata["pixel size"]))*10^5)) + yoffset = as.integer((originy-min(originy))/(as.numeric(gsub("(\\{)|(\\})|(,.*)", "",x$metdata["pixel size"]))*10^5)) + } + + else{ + if(!is.list(origins)) stop("origins must be a list of 2 value x y vectors or NULL if trying to automate") + xoffset = vapply(origins, function(x) x[1], FUN.VALUE = numeric(1)) + yoffset = vapply(origins, function(x) x[2], FUN.VALUE = numeric(1)) + } + + if(!is.numeric(xoffset)) stop("Origin extraction failed, the hdr file must have description metadata or you must provide numeric values in your list.") + + for(x in 1:length(map)){ + map[[x]]$metadata$x <- map[[x]]$metadata$x + xoffset[x] + map[[x]]$metadata$y <- map[[x]]$metadata$y + yoffset[x] + } + + unlisted <- unlist(unname(map), recursive = F) + + list <- tapply(unlisted, names(unlisted), unname) + + map <- as_OpenSpecy(x = list$wavenumber[[1]], + spectra = as.data.table(list$spectra), + metadata = rbindlist(list$metadata, fill = T)) + + ts <- transpose(map$spectra) + ts$id <- paste(map$metadata$x, map$metadata$y, sep = ",") + map$metadata$sample_name <- paste(map$metadata$x, map$metadata$y, sep = ",") + map$spectra <- ts[, lapply(.SD, median, na.rm = T), by = "id"] |> + transpose(make.names = "id") + map$metadata <- map$metadata |> + unique(by = c("sample_name", "x", "y")) + map +} + + diff --git a/man/manage_spec.Rd b/man/manage_spec.Rd index 063fe063..9da5d768 100644 --- a/man/manage_spec.Rd +++ b/man/manage_spec.Rd @@ -8,6 +8,10 @@ \alias{sample_spec} \alias{sample_spec.default} \alias{sample_spec.OpenSpecy} +\alias{merge_map} +\alias{merge_map.default} +\alias{merge_map.OpenSpecy} +\alias{merge_map.list} \title{Manage spectral objects} \usage{ c_spec(x, ...) @@ -23,9 +27,17 @@ sample_spec(x, ...) \method{sample_spec}{default}(x, ...) \method{sample_spec}{OpenSpecy}(x, size = 1, prob = NULL, ...) + +merge_map(x, ...) + +\method{merge_map}{default}(x, ...) + +\method{merge_map}{OpenSpecy}(x, ...) + +\method{merge_map}{list}(x, origins = NULL, ...) } \arguments{ -\item{x}{a list of \code{OpenSpecy} objects.} +\item{x}{a list of \code{OpenSpecy} objects or of file paths.} \item{range}{a numeric providing your own wavenumber ranges or character argument called \code{"common"} to let \code{c_spec()} find the common @@ -39,6 +51,8 @@ wavenumbers to be.} \item{prob}{probabilities to use for the sampling.} +\item{origins}{a list with 2 value vectors of x y coordinates for the offsets of each image.} + \item{\ldots}{further arguments passed to submethods.} } \value{ @@ -47,6 +61,7 @@ wavenumbers to be.} \description{ \code{c_spec()} concatenates \code{OpenSpecy} objects. \code{sample_spec()} samples spectra from an \code{OpenSpecy} object. +\code{merge_map()} merge two \code{OpenSpecy} objects from spectral maps. } \examples{ # Concatenating spectra diff --git a/tests/testthat/test-manage_spec.R b/tests/testthat/test-manage_spec.R index 93f24a4d..ad56248e 100644 --- a/tests/testthat/test-manage_spec.R +++ b/tests/testthat/test-manage_spec.R @@ -54,3 +54,17 @@ test_that("sample_spec() returns a subset of the spectra", { expect_equal(ncol(sampled$spectra), 5) }) + +test_that("merge_map()", { + tiny_map <- read_any(read_extdata("CA_tiny_map.zip")) + two <- list(tiny_map, tiny_map) + origins <- list(c(0,0), c(16,0)) + merged <- merge_map(two, origins = origins) + expect_true(check_OpenSpecy(merged)) + two_alt <- list(read_extdata("CA_tiny_map.zip"), read_extdata("CA_tiny_map.zip")) + merged2 <- merge_map(two_alt, origins = origins) + expect_true(check_OpenSpecy(merged2)) + expect_identical(merged$spectra, merged2$spectra) + expect_true(ncol(merged2$spectra) == ncol(tiny_map$spectra) * 2) +}) +