tests/testRaster.R

In R-ArcGIS/r-bridge: Bindings for ArcGIS

# raster tests

if (!isNamespaceLoaded("arcgisbinding"))
{
  library("arcgisbinding")
  if (class(try(arc.check_product())) == "try-error")
  {
    warning("skip testRaster.R")
    return(0)
  }
}
.arc <- asNamespace("arcgisbinding")$.arc

fgdb_path = tempfile("new_databse",fileext=".gdb")

#pixel types match
check_1 <- function()
{
  rasterDT <- c('LOG1S', 'INT1S', 'INT1U', 'INT2S', 'INT2U', 'INT4S', 'INT4U', 'FLT4S', 'FLT8S')
  pixelT   <- c( 'U1',    'S8',   'U8',     'S16' ,  'U16',   'S32' ,  'U32',   'F32',   'F64')
  for(i in seq_along(rasterDT))
  {
    px_type <- names(.arc$pixel_type2data_type)[which(.arc$pixel_type2data_type == rasterDT[i])]
    stopifnot(px_type == pixelT[i])
  }
}

# reading and compare "logo.jpg", save to different formats
check_2 <- function()
{
  if (!require("rgdal"))
    return(0)
  fn <- system.file("pictures", "logo.jpg", package="rgdal")
  r <- arc.raster(arc.open(fn))
  rx <- raster::raster(fn)
  stopifnot(dim(rx) == dim(r))
  stopifnot(any(raster::getValues(rx) == r$pixel_block()))

  r$save_as(tempfile("new_raster", fileext=".img"))
  r$save_as(tempfile("new_raster", fileext=".crf"))
  r$save_as(file.path(fgdb_path, "logo"))
}

# arc.write() support spacial pixels
check_3 <- function()
{
  if (!require("sp"))
    return(0)
  data(meuse.grid, package="sp")
  sp::coordinates(meuse.grid) <- c("x", "y")
  sp::gridded(meuse.grid) <- TRUE
  meuse.grid@proj4string=sp::CRS(arc.fromWktToP4(28992))

  #copy meuse.grid to FDGB, force pixel type to double
  arc.write(file.path(fgdb_path, "meuse_grid"), meuse.grid, pt="F64")
}
check_3.1 <- function()
{
  if (!require("sp"))
    return(0)
  #write SpatialPixels as 1 bit raster
  data(meuse.grid, package="sp")
  pts = meuse.grid[c("x", "y")]
  mask = sp::SpatialPixels(SpatialPoints(pts))
  arc.write(file.path(fgdb_path, "meuse_mask"), mask)
}

# r$write_pixels(), copy R logo to my office
check_4 <- function()
{
  if (!require("rgdal"))
    return(0)

  to_new_raster_dataset <- function(vals, px_type, nrow, ncol)
  {
    # create an empty raster dataset
    r <- arc.raster(NULL, path=file.path(fgdb_path, paste0("r_logo", px_type)),
                  dim=sz, pixel_type=px_type, sr=3310,
                  extent=c(258743.988738779,-436020.790477021,258755.37546478,-436005.376738167))

    r$write_pixel_block(vals, nrow = nrow, ncol = ncol)
    #close and compute stats
    r$commit()
  }

  x <- rgdal::GDAL.open(system.file("pictures", "logo.jpg", package="rgdal"))
  vals <- rgdal::getRasterData(x)
  sz <- dim(x)
  rgdal::GDAL.close(x)

  #write all types but 1 bit
  ret<-sapply(names(.arc$pixel_type2data_type[-1]), function(x)
  {
    d <-to_new_raster_dataset(vals, x, sz[1], sz[2]);
    v <- arc.raster(d)$pixel_block()
    sum(v)
  })

  stopifnot(ret == c("7174656","48640","7174656","7174656","7174656","7174656","7174656", "7174656"))
}

if (Sys.getenv("_R_CHECK_INTERNALS2_")[[1]] != "")
{
  check_1()
  check_2()
  check_3()
  check_3.1()
  check_4()
}