diff --git a/NEWS.md b/NEWS.md index 8401d34223..acf9d7390f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,8 @@ * `ggplotly()` now supports the `{ggalluvial}` package. (#2061, thanks @moutikabdessabour) * `highlight()` now supports `on="plotly_selecting"`, enabling client-side linked brushing via mouse click+drag (no mouse-up event required, as with `on="plotly_selected"`). (#1280) +* `raster2uri()` supports nativeRaster objects. This enables nativeRaster support for + the `annotation_raster()` geom (#2174, @zeehio). ## Bug fixes diff --git a/R/helpers.R b/R/helpers.R index 87e1421a20..c5d97d5070 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -219,14 +219,19 @@ plotly_empty <- function(...) { raster2uri <- function(r, ...) { try_library("png", "raster2uri") # should be 4 x n matrix - r <- grDevices::as.raster(r, ...) - rgbs <- col2rgb(c(r), alpha = T) / 255 - nr <- dim(r)[1] - nc <- dim(r)[2] - reds <- matrix(rgbs[1, ], nrow = nr, ncol = nc, byrow = TRUE) - greens <- matrix(rgbs[2, ], nrow = nr, ncol = nc, byrow = TRUE) - blues <- matrix(rgbs[3, ], nrow = nr, ncol = nc, byrow = TRUE) - alphas <- matrix(rgbs[4, ], nrow = nr, ncol = nc, byrow = TRUE) - png <- array(c(reds, greens, blues, alphas), dim = c(dim(r), 4)) + if (inherits(r, "nativeRaster")) { + # png::writePNG directly supports nativeRaster objects + png <- r + } else { + r <- grDevices::as.raster(r, ...) + rgbs <- col2rgb(c(r), alpha = T) / 255 + nr <- dim(r)[1] + nc <- dim(r)[2] + reds <- matrix(rgbs[1, ], nrow = nr, ncol = nc, byrow = TRUE) + greens <- matrix(rgbs[2, ], nrow = nr, ncol = nc, byrow = TRUE) + blues <- matrix(rgbs[3, ], nrow = nr, ncol = nc, byrow = TRUE) + alphas <- matrix(rgbs[4, ], nrow = nr, ncol = nc, byrow = TRUE) + png <- array(c(reds, greens, blues, alphas), dim = c(dim(r), 4)) + } base64enc::dataURI(png::writePNG(png), mime = "image/png") } diff --git a/tests/testthat/test-plotly-subplot.R b/tests/testthat/test-plotly-subplot.R index e91b733cfe..bd33f65a5e 100644 --- a/tests/testthat/test-plotly-subplot.R +++ b/tests/testthat/test-plotly-subplot.R @@ -274,6 +274,21 @@ test_that("shape paper repositioning", { expect_equal(y1, c(30, 0.75)) }) +test_that("raster2uri supports nativeRaster objects", { + skip_if_not_installed("png") + + r <- as.raster(matrix(c("black", "red", "green", "blue"), ncol = 4L)) + nr <- structure( + c(-16777216L, -16776961L, -16711936L, -65536L), + dim = c(1L, 4L), + class = "nativeRaster", + channels = 4L + ) + uri_r <- raster2uri(r) + uri_nr <- raster2uri(nr) + expect_equal(uri_r, uri_nr) +}) + test_that("image paper repositioning", { skip_if_not_installed("png")