Skip to content

Commit

Permalink
Merge pull request #13 from YuhangTom/fix/x3p_rotate
Browse files Browse the repository at this point in the history 
Better x3p_rotate
  • Loading branch information
@heike
heike committed Feb 28, 2024
2 parents f1057db + e780b7b commit 38fc697
Show file tree
Hide file tree
Showing 7 changed files with 70 additions and 111 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ Suggests:
here,
magick (>= 2.0)
License: MIT + file LICENSE
RoxygenNote: 7.2.3
RoxygenNote: 7.3.1
URL: https://github.com/heike/x3ptools,
https://heike.github.io/x3ptools/
BugReports: https://github.com/heike/x3ptools/issues
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,8 @@ importFrom(graphics,image)
importFrom(graphics,par)
importFrom(graphics,plot)
importFrom(imager,as.cimg)
importFrom(imager,imrotate)
importFrom(imager,pad)
importFrom(imager,rotate_xy)
importFrom(magrittr,"%>%")
importFrom(pracma,circlefit)
importFrom(purrr,map)
Expand Down
156 changes: 59 additions & 97 deletions R/x3p_rotate.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,135 +3,97 @@
#' Rotate the surface matrix and mask of an x3p object. Also adjust meta information.
#' @param x3p x3p object
#' @param angle rotate counter-clockwise by angle in degrees.
#' @importFrom imager as.cimg pad rotate_xy
#' @importFrom imager as.cimg pad imrotate
#' @importFrom dplyr near
#' @export
#' @examples
#' \dontrun{
#' logo <- x3p_read(system.file("csafe-logo.x3p", package = "x3ptools"))
#' color_logo <- png::readPNG(system.file("csafe-color.png", package="x3ptools"))
#' color_logo <- png::readPNG(system.file("csafe-color.png", package = "x3ptools"))
#' logoplus <- x3p_add_mask(logo, as.raster(color_logo))
#' dim(logoplus$surface.matrix)
#' dim(logoplus$mask)
#' x3p_image(logoplus, multiply=50, size = c(741, 419),zoom = 0.5)
#' x3p_image(logoplus, multiply = 50, size = c(741, 419), zoom = 0.5)
#'
#' logoplus60 <- x3p_rotate(x3p = logoplus, angle = 60)
#' dim(logoplus60$surface.matrix)
#' dim(logoplus60$mask)
#' x3p_image(logoplus60, multiply=50, size = c(741, 419),zoom = 0.75)
#' x3p_image(logoplus60, multiply = 50, size = c(741, 419), zoom = 0.75)
#' }
x3p_rotate <- function(x3p, angle = 90) {
stopifnot(is.numeric(angle))

# Make sure that all angles are in [0, 360)

angle <- angle %% 360
if (near(angle, 0)) {
return(x3p)
}

### Change NAs to background
x3p_shift <- x3p$surface.matrix
# NA_val <- -(x3p$surface.matrix %>%
# c() %>%
# summary() %>%
# .[c("Min.", "Max.")] %>%
# abs() %>%
# max() %>%
# ceiling())
NA_val <- min(x3p$surface.matrix, na.rm=TRUE) - .1*diff(range(x3p$surface.matrix, na.rm=TRUE))
x3p_shift[is.na(x3p$surface.matrix)] <- NA_val

### Change to raster
# # x3p_raster <- t(x3p_shift) %>%
# # as.raster(
# # max = max(x3p$surface.matrix, na.rm=TRUE),
# # xmx = (x3p$header.info$sizeX - 1) * x3p$header.info$incrementX,
# # ymx = (x3p$header.info$sizeY - 1) * x3p$header.info$incrementY)
# x3p_raster <- t(x3p_shift) %>%
# raster(xmx = (x3p$header.info$sizeX - 1) * x3p$header.info$incrementX, ymx = (x3p$header.info$sizeY - 1) * x3p$header.info$incrementY)
}

### Change to cimg
not_zero <- 10
shift_up <- not_zero + abs(min(x3p$surface.matrix, na.rm = TRUE))
x3p_shift <- x3p$surface.matrix + shift_up
NA_val <- 0
x3p_shift[is.na(x3p$surface.matrix)] <- NA_val
x3p_cimg <- as.cimg(x3p_shift)

### Compute diagonal length
diag_len <- sqrt(nrow(x3p_cimg)^2 + ncol(x3p_cimg)^2)

### Pad the original cimg object
x3p_cimg_pad <- x3p_cimg %>%
pad(nPix = diag_len, axes = "xy", pos = -1, val = NA_val) %>%
pad(nPix = diag_len - nrow(x3p_cimg), axes = "x", pos = 1, val = NA_val) %>%
pad(nPix = diag_len - ncol(x3p_cimg), axes = "y", pos = 1, val = NA_val)

### Rotate at padding center
### interpolation maintain the original scaling
x3p_cimg_pad_rotate <- x3p_cimg_pad %>%
rotate_xy(-angle, diag_len, diag_len, interpolation = 0L, boundary_conditions = 1L)

### Change cimg object to matrix
x3p_matrix_pad_rotate <- x3p_cimg_pad_rotate %>%
x3p_cimg_rotate <- x3p_cimg %>%
imrotate(-angle, interpolation = 0L, boundary = 0L)
x3p_matrix_rotate <- x3p_cimg_rotate %>%
as.matrix()
# there should not be any values between 0 and shift_up
x3p_matrix_rotate[x3p_matrix_rotate < (shift_up / 2)] <- NA
x3p_matrix_rotate <- x3p_matrix_rotate - shift_up

if (!is.null(x3p$mask)) {
x3p_mask_shift <- x3p$mask

if (sum(is.na(x3p$mask)) != 0) {
if (sum(x3p$mask == "#000000", na.rm = TRUE) != 0) {
warning("Mask areas with color '#000000' will be converted to NA.")
}
x3p_mask_shift[is.na(x3p_mask_shift)] <- "#000000"
}

x3p_mask_cimg <- as.cimg(x3p_mask_shift)
x3p_mask_cimg_rotate <- x3p_mask_cimg %>%
imrotate(-angle, interpolation = 0L, boundary = 0L)
x3p_mask_raster_rotate <- x3p_mask_cimg_rotate %>%
as.raster() %>%
toupper()
na_mask <- t(is.na(x3p_matrix_rotate))
x3p_mask_raster_rotate[na_mask] <- NA

x3p_matrix_pad_rotate[near(x3p_matrix_pad_rotate, NA_val)] <- NA
if (sum(is.na(x3p$mask)) != 0) {
x3p_mask_raster_rotate[x3p_mask_raster_rotate == "#000000"] <- NA
}
}

### Remove extra NA space after padding
na_matrix <- x3p_matrix_pad_rotate %>%
is.na()
na_matrix <- x3p_matrix_rotate %>% is.na()
na_row <- rowSums(na_matrix) == (ncol(na_matrix))
na_col <- colSums(na_matrix) == (nrow(na_matrix))
x3p_matrix_pad_rotate <- x3p_matrix_pad_rotate[!na_row, !na_col]

### Copy x3p object
x3p_pad_rotate <- x3p
### Change details of x3p object
x3p_pad_rotate$header.info$sizeX <- nrow(x3p_matrix_pad_rotate)
x3p_pad_rotate$header.info$sizeY <- ncol(x3p_matrix_pad_rotate)
x3p_pad_rotate$matrix.info$MatrixDimension$SizeX <- list(nrow(x3p_matrix_pad_rotate))
x3p_pad_rotate$matrix.info$MatrixDimension$SizeY <- list(ncol(x3p_matrix_pad_rotate))
x3p_pad_rotate$surface.matrix <- x3p_matrix_pad_rotate

x3p_matrix_rotate <- x3p_matrix_rotate[
!na_row,
!na_col
]
if (!is.null(x3p$mask)) {
### Change to cimg
# x3p_mask_cimg <- x3p$mask %>%
# raster::as.matrix() %>%
# t() %>%
# as.raster() %>%
# as.cimg()
x3p_mask_cimg <- as.cimg(x3p$mask)

### Compute diagonal length
diag_len <- sqrt(nrow(x3p_mask_cimg)^2 + ncol(x3p_mask_cimg)^2)

### Pad the original cimg object
NA_val <- "black"
x3p_mask_cimg_pad <- x3p_mask_cimg %>%
pad(nPix = diag_len, axes = "xy", pos = -1, val = NA_val) %>%
pad(nPix = diag_len - nrow(x3p_mask_cimg), axes = "x", pos = 1, val = NA_val) %>%
pad(nPix = diag_len - ncol(x3p_mask_cimg), axes = "y", pos = 1, val = NA_val)

### Rotate at padding center
### interpolation maintain the original scaling
x3p_mask_cimg_pad_rotate <- x3p_mask_cimg_pad %>%
rotate_xy(-angle, diag_len, diag_len, interpolation = 0L, boundary_conditions = 1L)

### Change cimg object to raster
x3p_mask_raster_pad_rotate <- x3p_mask_cimg_pad_rotate %>%
as.raster()

x3p_mask_raster_pad_rotate[x3p_mask_raster_pad_rotate == "#000000"] <- NA

### Remove extra NA space after padding
x3p_mask_raster_pad_rotate <- x3p_mask_raster_pad_rotate[!na_col, !na_row] %>%
toupper()
x3p_mask_raster_rotate <- x3p_mask_raster_rotate[
!na_col,
!na_row
]
}

# x3p_add_mask(x3p_pad_rotate, x3p_mask_raster_pad_rotate)
x3p_pad_rotate$mask <- x3p_mask_raster_pad_rotate
x3p_rotate <- x3p
x3p_rotate$header.info$sizeX <- nrow(x3p_matrix_rotate)
x3p_rotate$header.info$sizeY <- ncol(x3p_matrix_rotate)
x3p_rotate$matrix.info$MatrixDimension$SizeX <- list(nrow(x3p_matrix_rotate))
x3p_rotate$matrix.info$MatrixDimension$SizeY <- list(ncol(x3p_matrix_rotate))
x3p_rotate$surface.matrix <- x3p_matrix_rotate
if (!is.null(x3p$mask)) {
x3p_rotate$mask <- x3p_mask_raster_rotate
}

return(x3p_pad_rotate)
return(x3p_rotate)
}


#' @rdname x3p_rotate
#' @export
rotate_x3p <- x3p_rotate

6 changes: 3 additions & 3 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ status](https://www.r-pkg.org/badges/version/x3ptools)](https://CRAN.R-project.o
downloads](https://cranlogs.r-pkg.org/badges/last-month/x3ptools?color=blue)](https://r-pkg.org/pkg/x3ptools)
[![Lifecycle:
stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable)
[![Last-changedate](https://img.shields.io/badge/last%20change-2024--01--29-yellowgreen.svg)](https://github.com/heike/x3ptools/commits/main)
[![Last-changedate](https://img.shields.io/badge/last%20change-2024--02--22-yellowgreen.svg)](https://github.com/heike/x3ptools/commits/main)
[![Codecov test
coverage](https://codecov.io/gh/heike/x3ptools/graph/badge.svg?token=80NyJNOg5b)](https://app.codecov.io/gh/heike/x3ptools)
[![R-CMD-check](https://github.com/heike/x3ptools/workflows/R-CMD-check/badge.svg)](https://github.com/heike/x3ptools/actions)
Expand Down Expand Up @@ -55,7 +55,7 @@ names(logo)
```

## [1] "header.info" "surface.matrix" "feature.info" "general.info"
## [5] "matrix.info"
## [5] "matrix.info" "other.info"

The four info objects specify the information for Record1 through
Record4 in the xml file. An example for an xml file is provided with the
Expand Down Expand Up @@ -106,7 +106,7 @@ names(logo)
```

## [1] "header.info" "surface.matrix" "feature.info" "general.info"
## [5] "matrix.info"
## [5] "matrix.info" "other.info"

## Usage

Expand Down
Binary file added inst/x3p_rotate.pdf
View file
Binary file not shown.
6 changes: 3 additions & 3 deletions man/x3p_rotate.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

9 changes: 3 additions & 6 deletions tests/testthat/test_rotate_x3p.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,28 +20,25 @@ test_that("x3p_rotate works as expected", {
rotate_surface_mat_90(x3ptest$surface.matrix)
)
x3ptest2 <- x3ptest %>% x3p_shade_mask()
### Replace NA in the mask with default color "#FFFFFF"
x3ptest2def <- x3ptest2
x3ptest2def$mask[is.na(x3ptest2def$mask)] <- "#FFFFFF"
x3ptest2defb <- x3p_rotate(x3ptest2def, angle = 90)
expect_equivalent(
x3ptest2defb$mask,
as.raster(t(as.matrix(x3ptest2def$mask))[rev(1:6),]) %>% toupper()
as.raster(t(as.matrix(x3ptest2def$mask))[rev(1:6), ]) %>% toupper()
)
})

test_that("transpose_x3p works as expected", {
expect_equivalent(x3ptest$surface.matrix, t(x3ptest_transpose$surface.matrix))
expect_equivalent(x3ptest$header.info$sizeX, x3ptest_transpose$header.info$sizeY)
expect_equivalent(x3ptest$header.info$sizeY, x3ptest_transpose$header.info$sizeX)

x3ptest2 <- x3ptest %>% x3p_shade_mask()
x3ptest2b <- transpose_x3p(x3ptest2)
expect_equivalent(
x3ptest2b$mask,
as.raster(t(as.matrix(x3ptest2$mask)))
)

})

test_that("y_flip_x3p works as expected", {
Expand All @@ -50,5 +47,5 @@ test_that("y_flip_x3p works as expected", {

test_that("x3p_flip_x works as expected", {
x3ptest_xflip <- x3ptest %>% x3p_flip_x()
expect_equivalent(x3ptest_xflip$surface.matrix, x3ptest$surface.matrix[rev(1:nrow(x3ptest$surface.matrix)),])
expect_equivalent(x3ptest_xflip$surface.matrix, x3ptest$surface.matrix[rev(1:nrow(x3ptest$surface.matrix)), ])
})

0 comments on commit 38fc697

Please sign in to comment.