Permalink
Browse files

Merge 66ab83c into a106338

  • Loading branch information...
ianmseddy committed Dec 3, 2018
2 parents a106338 + 66ab83c commit e718d989a269921f511234dcebcd5b609a307088
Showing with 47 additions and 38 deletions.
  1. +34 −34 R/postProcess.R
  2. +13 −4 tests/testthat/test-prepInputs.R
@@ -464,13 +464,13 @@ projectInputs.Raster <- function(x, targetCRS = NULL, rasterToMatch = NULL, ...)
doProjection <- TRUE
}
if (doProjection) {
if (!canProcessInMemory(x, 4)) {
message(" large raster: reprojecting after writing to temp drive...")
#rasters need to go to same file so it can be unlinked at end without losing other temp files
tmpRasPath <- checkPath(file.path(raster::tmpDir(), "bigRasters"), create = TRUE)
tempSrcRaster <- file.path(tmpRasPath, "bigRasInput.tif")
tempDstRaster <- file.path(tmpRasPath, paste0(x@data@names,"_reproj.tif")) #fails if x = stack
if (doProjection) {
if (!canProcessInMemory(x, 4)) {
message(" large raster: reprojecting after writing to temp drive...")
#rasters need to go to same file so it can be unlinked at end without losing other temp files
tmpRasPath <- checkPath(file.path(raster::tmpDir(), "bigRasters"), create = TRUE)
tempSrcRaster <- file.path(tmpRasPath, "bigRasInput.tif")
tempDstRaster <- file.path(tmpRasPath, paste0(x@data@names,"a_reproj.tif")) #fails if x = stack
if (!is.null(rasterToMatch)) {
tr <- res(rasterToMatch)
@@ -511,25 +511,26 @@ projectInputs.Raster <- function(x, targetCRS = NULL, rasterToMatch = NULL, ...)
extent(rasterToMatch)@ymax, " "))
}
dType <- assessDataType(raster(tempSrcRaster), type = "GDAL")
system(
paste0(paste0(getOption("gdalUtils_gdalPath")[[1]]$path, "gdalwarp", exe, " "),
"-s_srs \"", as.character(raster::crs(raster::raster(tempSrcRaster))), "\"",
" -t_srs \"", as.character(targetCRS), "\"",
" -multi ",
"-ot ", dType,
teRas,
"-r ", dots$method,
" -overwrite ",
"-tr ", paste(tr, collapse = " "), " ",
"\"", tempSrcRaster, "\"", " ",
"\"", tempDstRaster, "\""),
wait = TRUE)
##
x <- raster(tempDstRaster)
#file exists in temp drive. Can copy to filename2
} else {
origDataType <- dataType(x)
dType <- assessDataType(raster(tempSrcRaster), type = "GDAL")
system(
paste0(paste0(getOption("gdalUtils_gdalPath")[[1]]$path, "gdalwarp", exe, " "),
"-s_srs \"", as.character(raster::crs(raster::raster(tempSrcRaster))), "\"",
" -t_srs \"", as.character(targetCRS), "\"",
" -multi ",
"-ot ", dType,
teRas,
"-r ", dots$method,
" -overwrite ",
"-tr ", paste(tr, collapse = " "), " ",
"\"", tempSrcRaster, "\"", " ",
"\"", tempDstRaster, "\""),
wait = TRUE)
##
x <- raster(tempDstRaster)
crs(x) <- targetCRS #sometimes the crs is correct but the character string is not identical
#file exists in temp drive. Can copy to filename2
} else {
origDataType <- dataType(x)
# Capture problems that projectRaster has with objects of class integers,
# which is different than if they are integers (i.e., a numeric class object)
@@ -540,22 +541,21 @@ projectInputs.Raster <- function(x, targetCRS = NULL, rasterToMatch = NULL, ...)
isInteger <- if (is.integer(x[])) TRUE else FALSE
if (isInteger) {
needWarning <- FALSE
if (is.null(dots$method)) {
needWarning <- TRUE
} else {
if (dots$method != "ngb")
needWarning <- TRUE
}
if (needWarning)
if (!is.null(dots$method)) {
if (dots$method != "ngb") {
warning("This raster layer has integer values; it will be reprojected to float. ",
"Did you want to pass 'method = \"ngb\"'?")
}
}
}
if (is.null(dots$method)) {
# not foolproof method of determining reclass method:
dots$method <- assessDataType(x, type = "projectRaster")
}
message(paste0("reprojecting using ", dots$method, "..."))
if (is.null(rasterToMatch)) {
Args <- append(dots, list(from = x, crs = targetCRS))
warn <- capture_warnings(x <- do.call(projectRaster, args = Args))
@@ -1245,6 +1245,9 @@ test_that("lightweight tests for code coverage", {
expect_is(a, "RasterLayer")
expect_true(identical(crs(a), crs(ras3)))
#warns if bilinear is passed for reprojecting integer
expect_warning(projectInputs(ras2, rasterToMatch = ras3, method = "bilinear"))
#Works with no rasterToMatch
a <- projectInputs(ras2, targetCRS = crs(ras3), method = "ngb")
expect_true(identical(crs(a), crs(ras3)))
@@ -1516,27 +1519,33 @@ test_that("System call gdal works", {
})
test_that("System call gdal will make the rasters match for rasterStack", {
skip_on_cran()
testInitOut <- testInit("raster")
on.exit({
testOnExit(testInitOut)
}, add = TRUE)
ras <- raster(extent(0, 4, 0, 4), res = 2, vals = 1:4)
crs(ras) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
ras <- raster::projectRaster(from = ras, crs = "+proj=lcc +lat_1=49 +lat_2=77 +lat_0=49 +lon_0=-95 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0")
ras <- writeRaster(ras, filename = tempfile(), format = "GTiff")
#next line generates intermittent error: In .Internal(gc(verbose, reset, full)) :
#closing unused connection 3 (C:/Temp/RtmpU5EOTS/raster/r_tmp_2018-12-03_143339_14468_30160.gri)
ras1 <- suppressWarnings(raster::projectRaster(from = ras, crs = "+proj=lcc +lat_1=49 +lat_2=77 +lat_0=49 +lon_0=-95 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0", method = "ngb"))
ras1 <- writeRaster(ras, filename = tempfile(), format = "GTiff")
ras2 <- raster(extent(0,8,0,8), res = 1, vals = 1:64)
crs(ras2) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
raster::rasterOptions(todisk = TRUE) #to trigger GDAL
test1 <- prepInputs(targetFile = ras@file@name, destinationPath = tempdir(),
test1 <- prepInputs(targetFile = ras1@file@name, destinationPath = tempdir(),
rasterToMatch = ras2, useCache = FALSE, method = 'ngb')
expect_true(file.exists(test1@file@name)) #exists on disk after gdalwarp
expect_true(dataType(test1) == "FLT4S")
expect_true(dataType(test1) == "INT1U")
expect_identical(raster::res(ras2), raster::res(test1))
expect_identical(raster::extent(ras2), raster::extent(test1))
expect_identical(raster::crs(ras2), raster::crs(test1))

0 comments on commit e718d98

Please sign in to comment.