diff --git a/R/create.R b/R/create.R index c9ebd168..8f89e23b 100644 --- a/R/create.R +++ b/R/create.R @@ -1995,31 +1995,32 @@ setMethod( } ) -#' @rdname createGiottoPolygon -#' @export -setMethod( - "createGiottoPolygon", signature("data.frame"), - function(x, - name = "cell", - calc_centroids = FALSE, - skip_eval_dfr = FALSE, - copy_dt = TRUE, - verbose = TRUE) { - createGiottoPolygonsFromDfr( - segmdfr = x, - name = name, - calc_centroids = calc_centroids, - skip_eval_dfr = skip_eval_dfr, - copy_dt = copy_dt, - verbose = verbose - ) - } -) #' @rdname createGiottoPolygon #' @param \dots additional params to pass. For character method, params pass to #' SpatRaster or SpatVector methods, depending on whether x was a filepath to #' a maskfile or a spatial file (ex: wkt, shp, GeoJSON) respectively. +#' @examples +#' # %%%%%%%%% `createGiottoPolygon()` examples %%%%%%%%% # +#' # ------- create from a mask image ------- # +#' m <- system.file("extdata/toy_mask_multi.tif", package = "GiottoClass") +#' plot(terra::rast(m), col = grDevices::hcl.colors(7)) +#' gp <- createGiottoPolygon( +#' m, +#' flip_vertical = FALSE, flip_horizontal = FALSE, +#' shift_horizontal_step = FALSE, shift_vertical_step = FALSE, +#' ID_fmt = "id_test_%03d", +#' name = "test" +#' ) +#' plot(gp, col = grDevices::hcl.colors(7)) +#' +#' # ------- create from an shp file ------- # +#' shp <- system.file("extdata/toy_poly.shp", package = "GiottoClass") +#' # vector inputs do not have params for flipping and shifting +#' gp2 <- createGiottoPolygon(shp, name = "test") +#' plot(gp2, col = grDevices::hcl.colors(7)) +#' +#' #' @export setMethod( "createGiottoPolygon", signature("character"), @@ -2028,27 +2029,60 @@ setMethod( # try success means it should be mask file # try failure means it should be vector file - try_rast <- try( + try_rast <- tryCatch( { terra::rast(x) }, - silent = TRUE + error = function(e) return(invisible(NULL)), + warning = function(w) {NULL} ) # mask workflow if (inherits(try_rast, "SpatRaster")) { - return(createGiottoPolygon(x, ...)) + return(createGiottoPolygon(try_rast, ...)) } # file workflow - return(createGiottoPolygon( - x = terra::vect(x), - ... - )) + return(createGiottoPolygon(x = terra::vect(x), ...)) } ) +#' @rdname createGiottoPolygon +#' @examples +#' # ------- create from data.frame-like ------- # +#' shp <- system.file("extdata/toy_poly.shp", package = "GiottoClass") +#' gpoly <- createGiottoPolygon(shp, name = "test") +#' plot(gpoly) +#' gpoly_dt <- data.table::as.data.table(gpoly, geom = "XY") +#' needed_cols_dt <- gpoly_dt[, .(geom, part, x, y, hole, poly_ID)] +#' force(needed_cols_dt) +#' +#' out <- createGiottoPolygon(needed_cols_dt, +#' name = "test") +#' plot(out) +#' +#' +#' @export +setMethod( + "createGiottoPolygon", signature("data.frame"), + function(x, + name = "cell", + calc_centroids = FALSE, + skip_eval_dfr = FALSE, + copy_dt = TRUE, + verbose = TRUE) { + createGiottoPolygonsFromDfr( + segmdfr = x, + name = name, + calc_centroids = calc_centroids, + skip_eval_dfr = skip_eval_dfr, + copy_dt = copy_dt, + verbose = verbose + ) + } +) + #' @rdname createGiottoPolygon #' @param maskfile path to mask file @@ -2092,6 +2126,32 @@ setMethod( #' a `sprintf()` `fmt` param input instead. (ie: `ID_fmt = "cell_%03d"` produces #' `cell_001`, `cell_002`, `cell_003`, ...) #' @return a giotto polygon object +#' @examples +#' # %%%%%%%%% `createGiottoPolygonsFromMask()` examples %%%%%%%%% # +#' mask_multi <- system.file("extdata/toy_mask_multi.tif", +#' package = "GiottoClass") +#' mask_single <- system.file("extdata/toy_mask_single.tif", +#' package = "GiottoClass") +#' plot(terra::rast(mask_multi), col = grDevices::hcl.colors(7)) +#' plot(terra::rast(mask_single)) +#' +#' gpoly1 = createGiottoPolygonsFromMask( +#' mask_multi, +#' flip_vertical = FALSE, flip_horizontal = FALSE, +#' shift_horizontal_step = FALSE, shift_vertical_step = FALSE, +#' ID_fmt = "id_test_%03d", +#' name = "multi_test" +#' ) +#' plot(gpoly1, col = grDevices::hcl.colors(7)) +#' +#' gpoly2 = createGiottoPolygonsFromMask( +#' mask_single, +#' flip_vertical = FALSE, flip_horizontal = FALSE, +#' shift_horizontal_step = FALSE, shift_vertical_step = FALSE, +#' ID_fmt = "id_test_%03d", +#' name = "single_test" +#' ) +#' plot(gpoly2, col = grDevices::hcl.colors(5)) #' @export createGiottoPolygonsFromMask <- function( maskfile, @@ -2143,6 +2203,7 @@ createGiottoPolygonsFromMask <- function( # (which usually encodes the intended polygon ID) is added to the resulting # SpatVector as the only attribute. terra_polygon <- terra::as.polygons(x = terra_rast, value = TRUE) + val_col <- names(terra_polygon) # the only col should be from the values # fill holes if (isTRUE(fill_holes)) { @@ -2157,20 +2218,19 @@ createGiottoPolygonsFromMask <- function( terra_polygon <- terra_polygon[valid_index] } - - spatVecDT <- .spatvector_to_dt(terra_polygon) - ## flip across axes ## if (isTRUE(flip_vertical)) { - # terra_polygon = terra::flip(terra_polygon, direction = 'vertical') - spatVecDT[, y := -y] + terra_polygon <- .flip_spatvect(terra_polygon) } - if (isTRUE(flip_horizontal)) { - # terra_polygon = terra::flip(terra_polygon, direction = 'horizontal') - spatVecDT[, x := -x] + terra_polygon <- .flip_spatvect(terra_polygon) } + # convert to DT format since we want to be able to compare number of geoms + # vs polys to determine correct mask method. + # TODO only test a subset of polys here? + spatVecDT <- .spatvector_to_dt(terra_polygon) + ## guess mask method ## if (mask_method == "guess") { uniq_geoms <- length(unique(spatVecDT$geom)) @@ -2184,21 +2244,36 @@ createGiottoPolygonsFromMask <- function( naming_fun <- ifelse(grepl("%", ID_fmt), sprintf, paste0) # If poly_IDs are NOT provided, then terra_polygon IDs created here will be # `character` and the finalized ID values. - # If not, the IDs are still temporary and `numeric`, pending the `poly_IDs` - # param being applied downstream. + # If poly_IDs ARE provided, the IDs are still temporary and MUST remain + # `numeric`, pending the `poly_IDs` param being applied downstream. terra_polygon <- switch(mask_method, "multiple" = { + names(terra_polygon) <- "poly_ID" if (is.null(poly_IDs)) { - spatVecDT[, geom := naming_fun(ID_fmt, geom)] + # spatVecDT[, geom := naming_fun(ID_fmt, geom)] + # spatVecDT[, (val_col) := naming_fun(ID_fmt, get(val_col))] + # g_polygon <- createGiottoPolygonsFromDfr( + # segmdfr = spatVecDT[, .(x, y, get(val_col))] + # ) + # g_polygon@spatVector + terra_polygon$poly_ID <- naming_fun(ID_fmt, terra_polygon$poly_ID) } - g_polygon <- createGiottoPolygonsFromDfr(segmdfr = spatVecDT[, .(x, y, geom)]) - g_polygon@spatVector + terra_polygon }, "single" = { + # TODO ordering may be performed based on centroids xy instead of + # converting the full polygon and then ordering on parts + # May improve the speed if (is.null(poly_IDs)) { spatVecDT[, part := naming_fun(ID_fmt, part)] } - g_polygon <- createGiottoPolygonsFromDfr(segmdfr = spatVecDT[, .(x, y, part)]) + g_polygon <- createGiottoPolygonsFromDfr( + segmdfr = spatVecDT[, .(x, y, part)] + ) + if (!is.null(poly_IDs)) { + g_polygon@spatVector$poly_ID <- as.numeric(g_polygon@spatVector$poly_ID) + } + g_polygon@spatVector } ) diff --git a/R/methods-flip.R b/R/methods-flip.R index 5da5f3f8..81684fda 100644 --- a/R/methods-flip.R +++ b/R/methods-flip.R @@ -164,7 +164,7 @@ setMethod( ) } } else { - # flip about y0 + # flip about x0 # poly dx_p <- x0 - x_min_p gpoly@spatVector <- terra::shift( @@ -190,6 +190,42 @@ setMethod( +.flip_spatvect <- function( + x, direction = "vertical", x0 = 0, y0 = 0 + ) { + checkmate::assert_class(x, "SpatVector") + if (!is.null(x0)) { + checkmate::assert_numeric(x0) + } + if (!is.null(y0)) { + checkmate::assert_numeric(y0) + } + + # 1. perform flip + e <- terra::ext(x) + x <- terra::flip(x, direction = direction) + + x <- switch(direction, + "vertical" = { + if (!is.null(y0)) { # flip about y0 if not NULL + ymin <- as.numeric(e$ymin) + dy <- y0 - ymin + terra::shift(x, dy = 2 * dy) + } + }, + "horizontal" = { + if (!is.null(x0)) { # flip about x0 if not NULL + xmin <- as.numeric(e$xmin) + dx <- x0 - xmin + terra::shift(x, dx = 2 * dx) + } + } + ) + + # 3. return + return(x) +} + diff --git a/inst/extdata/toy_mask_multi.tif b/inst/extdata/toy_mask_multi.tif new file mode 100644 index 00000000..da28db18 Binary files /dev/null and b/inst/extdata/toy_mask_multi.tif differ diff --git a/inst/extdata/toy_mask_single.tif b/inst/extdata/toy_mask_single.tif new file mode 100644 index 00000000..0efec8e8 Binary files /dev/null and b/inst/extdata/toy_mask_single.tif differ diff --git a/inst/extdata/toy_poly.cpg b/inst/extdata/toy_poly.cpg new file mode 100644 index 00000000..3ad133c0 --- /dev/null +++ b/inst/extdata/toy_poly.cpg @@ -0,0 +1 @@ +UTF-8 \ No newline at end of file diff --git a/inst/extdata/toy_poly.dbf b/inst/extdata/toy_poly.dbf new file mode 100644 index 00000000..7aa15a1a Binary files /dev/null and b/inst/extdata/toy_poly.dbf differ diff --git a/inst/extdata/toy_poly.shp b/inst/extdata/toy_poly.shp new file mode 100644 index 00000000..e41424ee Binary files /dev/null and b/inst/extdata/toy_poly.shp differ diff --git a/inst/extdata/toy_poly.shx b/inst/extdata/toy_poly.shx new file mode 100644 index 00000000..8749c44f Binary files /dev/null and b/inst/extdata/toy_poly.shx differ diff --git a/man/createGiottoPolygon.Rd b/man/createGiottoPolygon.Rd index 97f0f31e..8d038cb7 100644 --- a/man/createGiottoPolygon.Rd +++ b/man/createGiottoPolygon.Rd @@ -4,8 +4,8 @@ \alias{createGiottoPolygon} \alias{createGiottoPolygon,SpatVector-method} \alias{createGiottoPolygon,SpatRaster-method} -\alias{createGiottoPolygon,data.frame-method} \alias{createGiottoPolygon,character-method} +\alias{createGiottoPolygon,data.frame-method} \alias{createGiottoPolygonsFromMask} \alias{createGiottoPolygonsFromDfr} \alias{createGiottoPolygonsFromGeoJSON} @@ -31,6 +31,8 @@ verbose = TRUE ) +\S4method{createGiottoPolygon}{character}(x, ...) + \S4method{createGiottoPolygon}{data.frame}( x, name = "cell", @@ -40,8 +42,6 @@ verbose = TRUE ) -\S4method{createGiottoPolygon}{character}(x, ...) - createGiottoPolygonsFromMask( maskfile, mask_method = c("guess", "single", "multiple"), @@ -111,15 +111,15 @@ poly_IDs. Default = "cell_". See \emph{ID_fmt} section.} \item{remove_unvalid_polygons}{remove unvalid polygons (default: TRUE)} +\item{\dots}{additional params to pass. For character method, params pass to +SpatRaster or SpatVector methods, depending on whether x was a filepath to +a maskfile or a spatial file (ex: wkt, shp, GeoJSON) respectively.} + \item{skip_eval_dfr}{(default FALSE) skip evaluation of provided dataframe} \item{copy_dt}{(default TRUE) if segmdfr is provided as dt, this determines whether a copy is made} -\item{\dots}{additional params to pass. For character method, params pass to -SpatRaster or SpatVector methods, depending on whether x was a filepath to -a maskfile or a spatial file (ex: wkt, shp, GeoJSON) respectively.} - \item{maskfile}{path to mask file} \item{segmdfr}{data.frame-like object with polygon coordinate information (x, y, poly_ID) @@ -176,5 +176,65 @@ a \code{sprintf()} \code{fmt} param input instead. (ie: \code{ID_fmt = "cell_\%0 \code{cell_001}, \code{cell_002}, \code{cell_003}, ...) } +\examples{ +# \%\%\%\%\%\%\%\%\% `createGiottoPolygon()` examples \%\%\%\%\%\%\%\%\% # +# ------- create from a mask image ------- # +m <- system.file("extdata/toy_mask_multi.tif", package = "GiottoClass") +plot(terra::rast(m), col = grDevices::hcl.colors(7)) +gp <- createGiottoPolygon( + m, + flip_vertical = FALSE, flip_horizontal = FALSE, + shift_horizontal_step = FALSE, shift_vertical_step = FALSE, + ID_fmt = "id_test_\%03d", + name = "test" +) +plot(gp, col = grDevices::hcl.colors(7)) + +# ------- create from an shp file ------- # +shp <- system.file("extdata/toy_poly.shp", package = "GiottoClass") +# vector inputs do not have params for flipping and shifting +gp2 <- createGiottoPolygon(shp, name = "test") +plot(gp2, col = grDevices::hcl.colors(7)) + + +# ------- create from data.frame-like ------- # +shp <- system.file("extdata/toy_poly.shp", package = "GiottoClass") +gpoly <- createGiottoPolygon(shp, name = "test") +plot(gpoly) +gpoly_dt <- data.table::as.data.table(gpoly, geom = "XY") +needed_cols_dt <- gpoly_dt[, .(geom, part, x, y, hole, poly_ID)] +force(needed_cols_dt) + +out <- createGiottoPolygon(needed_cols_dt, + name = "test") +plot(out) + + +# \%\%\%\%\%\%\%\%\% `createGiottoPolygonsFromMask()` examples \%\%\%\%\%\%\%\%\% # +mask_multi <- system.file("extdata/toy_mask_multi.tif", + package = "GiottoClass") +mask_single <- system.file("extdata/toy_mask_single.tif", + package = "GiottoClass") +plot(terra::rast(mask_multi), col = grDevices::hcl.colors(7)) +plot(terra::rast(mask_single)) + +gpoly1 = createGiottoPolygonsFromMask( + mask_multi, + flip_vertical = FALSE, flip_horizontal = FALSE, + shift_horizontal_step = FALSE, shift_vertical_step = FALSE, + ID_fmt = "id_test_\%03d", + name = "multi_test" +) +plot(gpoly1, col = grDevices::hcl.colors(7)) + +gpoly2 = createGiottoPolygonsFromMask( + mask_single, + flip_vertical = FALSE, flip_horizontal = FALSE, + shift_horizontal_step = FALSE, shift_vertical_step = FALSE, + ID_fmt = "id_test_\%03d", + name = "single_test" +) +plot(gpoly2, col = grDevices::hcl.colors(5)) +} \concept{mask polygon} \concept{polygon} diff --git a/tests/testthat/test-createObject.R b/tests/testthat/test-createObject.R index f6a59433..655d936a 100644 --- a/tests/testthat/test-createObject.R +++ b/tests/testthat/test-createObject.R @@ -48,10 +48,106 @@ test_that("giottoPolygon is created from data.table", { expect_setequal(gp_IDs, spatIDs(gp)) }) -# TODO need the file uploaded to do this easily -# test_that('giottoPolygon is created from maskfile', { -# gp = createGiottoPolygonsFromMask() -# }) + +test_that('giottoPolygon is created from maskfile', { + # make a faux mask (DO NOT DELETE COMMENTED CODE HERE) + # a <- circleVertices(2) + b <- data.table::data.table(sdimx = c(5, 10, 20, 10, 25, 22, 6), + sdimy = c(5, 3, 8, 10, 3, 10, 8), + cell_ID = letters[seq(7)]) + # x <- createGiottoPolygon(polyStamp(a, b))[] + # x$idx <- rev(4:10) + # r <- terra::rast(ncol = 100, nrow = 100) + # ext(r) <- c(0, 30, 0, 13) + # mask_multi <- terra::rasterize(x, r, field = "idx") + # terra::writeRaster(mask_multi, + # filename = "inst/extdata/toy_mask_multi.tif", + # gdal = "COG", + # overwrite = TRUE) + # mask_single <- terra::rasterize(x, r) + # terra::writeRaster(mask_single, + # filename = "inst/extdata/toy_mask_single.tif", + # gdal = "COG", + # overwrite = TRUE) + # terra::writeVector(x, + # filename = "inst/extdata/toy_poly.shp", + # overwrite = TRUE) + + m <- system.file("extdata/toy_mask_multi.tif", package = "GiottoClass") + s <- system.file("extdata/toy_mask_single.tif", package = "GiottoClass") + + # expect all 7 polys + gpm = createGiottoPolygonsFromMask(m, + flip_vertical = FALSE, + flip_horizontal = FALSE, + shift_horizontal_step = FALSE, + shift_vertical_step = FALSE, + ID_fmt = "id_test_%03d", + name = "multi_test", + verbose = FALSE) + expect_equal(nrow(gpm), 7) + gpm_centroids_dt <- data.table::as.data.table(centroids(gpm), geom = "XY") + expect_identical(gpm_centroids_dt$poly_ID, sprintf("id_test_%03d", 4:10)) + # compare against reversed values from spatlocs DT since values were applied + # in reverse (from idx col) + expect_identical(round(gpm_centroids_dt$x), rev(b$sdimx)) + expect_identical(round(gpm_centroids_dt$y), rev(b$sdimy)) + + # expect 5 polys + gps = createGiottoPolygonsFromMask(s, + flip_vertical = FALSE, + flip_horizontal = FALSE, + shift_horizontal_step = FALSE, + shift_vertical_step = FALSE, + ID_fmt = "id_test_%03d", + name = "single_test", + verbose = FALSE) + expect_equal(nrow(gps), 5) + gps_centroids_dt <- data.table::as.data.table(centroids(gps), geom = "XY") + expect_identical(gps_centroids_dt$poly_ID, sprintf("id_test_%03d", seq(1:5))) + # ordering from readin for "single" is ordered first by row then col + data.table::setkeyv(b, c("sdimy", "sdimx")) # note that y ordering is still inverted + singles_x <- c(b$sdimx[6], mean(b$sdimx[c(7, 5)]), mean(b$sdimx[c(3, 4)]), b$sdimx[c(1, 2)]) + singles_y <- c(b$sdimy[6], mean(b$sdimy[c(7, 5)]), mean(b$sdimy[c(3, 4)]), b$sdimy[c(1, 2)]) + + expect_identical(round(gps_centroids_dt$x, digits = 1), singles_x) + expect_identical(round(gps_centroids_dt$y, digits = 1), singles_y) + + # try again with specified poly_ID values --------------------------------- # + + gpm2 = createGiottoPolygonsFromMask(m, + flip_vertical = FALSE, + flip_horizontal = FALSE, + shift_horizontal_step = FALSE, + shift_vertical_step = FALSE, + poly_IDs = letters[1:7], + ID_fmt = "id_test_%03d", # ignored + name = "multi_test", + verbose = FALSE) + expect_identical(gpm2$poly_ID, letters[1:7]) + gpm2_centroids_dt <- data.table::as.data.table(centroids(gpm2), geom = "XY") + data.table::setkey(b, cell_ID) + expect_identical(round(gpm2_centroids_dt$x), rev(b$sdimx)) + expect_identical(round(gpm2_centroids_dt$y), rev(b$sdimy)) + + gps2 = createGiottoPolygonsFromMask(s, + flip_vertical = FALSE, + flip_horizontal = FALSE, + shift_horizontal_step = FALSE, + shift_vertical_step = FALSE, + poly_IDs = LETTERS[1:5], + ID_fmt = "id_test_%03d", # ignored + name = "single_test", + verbose = FALSE) + expect_identical(gps2$poly_ID, LETTERS[1:5]) + gps2_centroids_dt <- data.table::as.data.table(centroids(gps2), geom = "XY") + data.table::setkeyv(b, c("sdimy", "sdimx")) # note that y ordering is still inverted + singles_x <- c(b$sdimx[6], mean(b$sdimx[c(7, 5)]), mean(b$sdimx[c(3, 4)]), b$sdimx[c(1, 2)]) + singles_y <- c(b$sdimy[6], mean(b$sdimy[c(7, 5)]), mean(b$sdimy[c(3, 4)]), b$sdimy[c(1, 2)]) + + expect_identical(round(gps2_centroids_dt$x, digits = 1), singles_x) + expect_identical(round(gps2_centroids_dt$y, digits = 1), singles_y) +})