Skip to content

Instantly share code, notes, and snippets.

@mdsumner
Last active June 25, 2025 05:45
Show Gist options
  • Save mdsumner/d93ebe35543cbfb68f4c96bf272d8edb to your computer and use it in GitHub Desktop.
Save mdsumner/d93ebe35543cbfb68f4c96bf272d8edb to your computer and use it in GitHub Desktop.
pq <- function(x, ex = NULL) {
  env <- Sys.getenv("AWS_NO_SIGN_REQUEST")
  Sys.setenv("AWS_NO_SIGN_REQUEST" = "YES")
  on.exit(Sys.setenv("AWS_NO_SIGN_REQUEST" = env))
  if (!is.null(ex)) {
    x <- terra::crop(x, ex)
  } else {
    rr <- terra::rast(x)
    dm <- dim(rr); dm[1:2] <- c(min(dm[1], 1024), min(dm[1], 1024))
    dim(rr) <- dm
    x <- terra::project(x, rr, by_util = TRUE)
  }
  terra::plotRGB(terra::stretch(sqrt(x)), maxcell = Inf)
  invisible(x)
}
##' Make image from DEA stac link 
mkpic <- function(x) {
  stac <- gsub("/datasets/", "/items/", gsub("/products/", "/stac/collections/", x))
  js <- jsonlite::fromJSON(stac)
  env <- Sys.getenv("AWS_NO_SIGN_REQUEST")
  Sys.setenv("AWS_NO_SIGN_REQUEST" = "YES")
  on.exit(Sys.setenv("AWS_NO_SIGN_REQUEST" = env))
  #rgb <- gsub("s3://dea-public-data", "/vsicurl/https://data.dea.ga.gov.au", c(js$assets$nbart_red$href, js$assets$nbart_green$href, js$assets$nbart_blue$href))
  rgb <- gsub("s3://", "/vsis3/", c(js$assets$nbart_red$href, js$assets$nbart_green$href, js$assets$nbart_blue$href))
  vrt <- vapour::buildvrt(rgb)
  terra::rast(vrt)
}
#' Plot raster at native resolution
#'
#' Determines the current device size and plots the raster centred on its own
#' middle to plot at native resolution. 
#'
#' @param x input link to a DEA stac item
#' @param ... passed to terra::plot
#'
#' @return the input raster, cropped corresponding to the plot made
#' @export
#'
click_native <- function(x, ..., add = F, stretch = c("sqrt", "log", "lin")) {
  stretch <- match.arg(stretch)
  pq(x)
  ex <- as.vector(terra::ext(x))
  #at <- NULL
  ## take the centre
  at = terra::click(n = 1)
  if (is.null(at)) {
    at <- apply(matrix(ex, 2), 2, mean)
  }
  dv <- dev.size("px")
  scl <- terra::res(x)
  halfx <- dv[1]/2 * scl[1]
  halfy <- dv[2]/2 * scl[2]
  cropex <- c(at[1] - halfx, at[1] + halfx, at[2] - halfy, at[2] + halfy)
  x <- terra::crop(x, terra::ext(cropex), extend = TRUE)

 fun <- switch(stretch, sqrt = sqrt, log = log, lin = identity)
  if (terra::nlyr(x) >= 3) terra::plotRGB(terra::stretch(fun(x)), add = add) else plot(x, ..., add = add)
  x
}

library(terra)
input <- "https://explorer.dea.ga.gov.au/products/ga_s2bm_ard_3/datasets/d1c2ad3d-166e-4e5b-a924-d1b2af0728cd"
#input <- "https://explorer.dea.ga.gov.au/stac/collections/ga_s2bm_ard_3/items/fc88120a-bb8f-4544-8d99-e4bf87d05fd3"
#input <- "https://explorer.dea.ga.gov.au/stac/collections/ga_s2bm_ard_3/items/0da49e8e-71a2-48fa-9025-108c590b3b0e"
sentinel <- mkpic(input)
pq(sentinel)
click_native(sentinel)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment