Bug 17148: debug rasterImage orientation on Windows #142
Description
Reprex
The following code takes a 4x4 raster image, oriented with x increasing left to right and y increasing bottom to top. This is plotted in the top right. The image is then rotated by angle and then three more versions of the two rasters are created:
top-left: flipping x-axis
bottom-left: flipping x-axis and y-axis
bottom right: flipping y-axis
Functions for reprex - source these first
get_rotated_corners <- function(
xleft,
ybottom,
xright,
ytop,
x_rotate_center,
y_rotate_center,
angle_degree
) {
sgn <- sign(xright - xleft)*sign(ytop - ybottom)
angle_rad <- (angle_degree * pi / 180) * sgn
# Calculate initial corner points
corners_x <- c(xleft, xright, xright, xleft)
corners_y <- c(ybottom, ybottom, ytop, ytop)
# Calculate rotated corner points
rotated_corners_x <- numeric(4)
rotated_corners_y <- numeric(4)
for (i in 1:4) {
# Translate to origin
x_translated <- corners_x[i] - x_rotate_center
y_translated <- corners_y[i] - y_rotate_center
# Rotate
x_rotated <- x_translated * cos(angle_rad) - y_translated * sin(angle_rad)
y_rotated <- x_translated * sin(angle_rad) + y_translated * cos(angle_rad)
# Translate back
rotated_corners_x[i] <- x_rotated + x_rotate_center
rotated_corners_y[i] <- y_rotated + y_rotate_center
}
return(list(rotated_corners_x,rotated_corners_y))
}
raster4 <- function(starting_image, ending_image = starting_image,
angle = 20) {
op <- par(bg = "thistle", mar = rep(2.5, 4)); on.exit(par(op))
plot(1:10, type = "n", main = names(dev.cur()), asp = 1)
mtext(R.version.string, cex = 0.75)
abline(h = c(2, 4, 7, 9), lty = 2)
abline(v = c(2, 4, 7, 9), lty = 2)
# TOP LEFT
## Axes
### xleft to xright (allowing extra for arrow)
arrows(x0 = 4, y0 = 7, x1 = 1.25, y1 = 7, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(1.5, 6.5, labels = "x", cex = 1)
### ybottom to ytop (allowing extra for arrow)
arrows(x0 = 4, y0 = 7, x1 = 4, y1 = 9.75, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(4.5, 9.5, labels = "y", cex = 1)
## Original top left square
rasterImage(starting_image, xleft = 4, ybottom = 7, xright = 2, ytop = 9, angle = 0, interpolate = FALSE)
rect(xleft = 4, ybottom = 7, xright = 2, ytop = 9, border = "black")
## Rotated top left square
sgn <- sign(2 - 4)*sign(9 - 7) # negative if only one axes in negative direction
rasterImage(ending_image, xleft = 4, ybottom = 7, xright = 2, ytop = 9, angle = angle*sgn, interpolate = FALSE)
rotated_corners_top_left <- get_rotated_corners(
xleft = 4, ybottom = 7, xright = 2, ytop = 9, # can I swap xleft and xright here?
x_rotate_center = 4,
y_rotate_center = 7,
angle_degree = angle
)
polygon(rotated_corners_top_left[[1]], rotated_corners_top_left[[2]], border = "black")
## Rotation point of top left square
points(4, 7, col = "green", pch = 16, cex = 1)
# TOP RIGHT
## Axes
### xleft to xright (allowing extra for arrow)
arrows(x0 = 7, y0 = 7, x1 = 9.75, y1 = 7, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(9.5, 6.5, labels = "x", cex = 1)
### ybottom to ytop (allowing extra for arrow)
arrows(x0 = 7, y0 = 7, x1 = 7, y1 = 9.75, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(6.5, 9.5, labels = "y", cex = 1)
## Original top right square
rasterImage(starting_image, xleft = 7, ybottom = 7, xright = 9, ytop = 9, angle = 0, interpolate = FALSE)
rect(xleft = 7, ybottom = 7, xright = 9, ytop = 9, border = "black")
## Rotated top right square
sgn <- sign(9 - 7)*sign(9 - 7) # negative if only one axes in negative direction
rasterImage(ending_image, xleft = 7, ybottom = 7, xright = 9, ytop = 9, angle = angle*sgn, interpolate = FALSE)
rotated_corners_top_right <- get_rotated_corners(
xleft = 7, ybottom = 7, xright = 9, ytop = 9,
x_rotate_center = 7,
y_rotate_center = 7,
angle_degree = angle
)
polygon(rotated_corners_top_right[[1]], rotated_corners_top_right[[2]], border = "black")
## Rotation point of top right square
points(7, 7, col = "green", pch = 16, cex = 1)
# BOTTOM LEFT
## Axes
### xleft to xright (allowing extra for arrow)
arrows(x0 = 4, y0 = 4, x1 = 1.25, y1 = 4, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(1.5, 4.5, labels = "x", cex = 1)
### ybottom to ytop (allowing extra for arrow)
arrows(x0 = 4, y0 = 4, x1 = 4, y1 = 1.25, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(4.5, 1.5, labels = "y", cex = 1)
## Original bottom left square
rasterImage(starting_image, xleft = 4, ybottom = 4, xright = 2, ytop = 2, angle = 0, interpolate = FALSE)
rect(xleft = 4, ybottom = 4, xright = 2, ytop = 2, border = "black")
## Rotated bottom left square
sgn <- sign(2 - 4)*sign(2 - 4) # negative if only one axes in negative direction
rasterImage(ending_image, xleft = 4, ybottom = 4, xright = 2, ytop = 2, angle = angle*sgn, interpolate = FALSE)
rotated_corners_bottom_left <- get_rotated_corners(
xleft = 4, ybottom = 4, xright = 2, ytop = 2,
x_rotate_center = 4,
y_rotate_center = 4,
angle_degree = angle
)
polygon(rotated_corners_bottom_left[[1]], rotated_corners_bottom_left[[2]], border = "black")
## Rotation point of bottom left square
points(4, 4, col = "green", pch = 16, cex = 1)
# BOTTOM RIGHT
## Axes
### xleft to xright (allowing extra for arrow)
arrows(x0 = 7, y0 = 4, x1 = 9.75, y1 = 4, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(9.5, 4.5, labels = "x", cex = 1)
### ybottom to ytop (allowing extra for arrow)
arrows(x0 = 7, y0 = 4, x1 = 7, y1 = 1.25, length = 0.15, angle = 30,
code = 2, lwd = 2)
text(6.5, 1.5, labels = "y", cex = 1)
## Original bottom right square
rasterImage(starting_image, xleft = 7, ybottom = 4, xright = 9, ytop = 2, angle=0, interpolate=FALSE)
rect(7, 2, 9, 4, border = "black")
## Rotated bottom left square
sgn <- sign(9 - 7)*sign(2 - 4) # negative if only one axes in negative direction
rasterImage(ending_image, xleft = 7, ybottom = 4, xright = 9, ytop = 2, angle=angle*sgn, interpolate=FALSE)
rotated_corners_bottom_right <- get_rotated_corners(
xleft = 7, ybottom = 4, xright = 9, ytop = 2,
x_rotate_center = 7,
y_rotate_center = 4,
angle_degree = angle
)
polygon(rotated_corners_bottom_right[[1]], rotated_corners_bottom_right[[2]], border = "black")
## Rotation point of bottom left square
points(7, 4, col = "green", pch = 16, cex = 1)
invisible(list(starting_image = starting_image,
ending_image = ending_image,
angle = angle))
}f_start <- as.raster(rbind(
c(0, 0, 0, 0),
c(0, NA, NA, NA),
c(0, 0, 0, NA),
c(0, NA, NA, NA)
))
f_end <- as.raster(rbind(
c(1, 1, 1, 1),
c(1, NA, NA, NA),
c(1, 1, 1, NA),
c(1, NA, NA, NA)
))
raster4(f_start, f_end, angle = 20)Expected result
This is the expected result which you get in Positron (with the ark graphics device) on in RStudio with the Cairo or AGG device (Tools > Global Options > General > Graphics > Backend):
Result with windows device
On a windows device (open with windows() or change the backend in RStudio), you get:
There are a couple of issues here:
- The orientation (flipping) is correct, but the location and rotation is wrong.
- Although the windows device can support transparency, the rotated raster is placed in a bounding box with a thistle background (the purple colour), obscuring parts of the plot that we should be able to see.
Task
The task is to debug plotting on the Windows device, to pin down where the code is wrong and how it might be fixed.
This requires Building R-Devel on Windows and debugging C code.