Commit d212aa11 authored by Facundo Muñoz's avatar Facundo Muñoz ®️
Browse files

Bugfixes in testing. Fix warnings due to changes in {rgdal} and PROJ6.

parent 826f6019
Pipeline #43237 failed with stages
in 5 minutes and 51 seconds
Package: mapMCDA Package: mapMCDA
Title: Produce an epidemiological risk map by weighting multiple risk Title: Produce an epidemiological risk map by weighting multiple risk
factors factors
Version: 0.4.56 Version: 0.4.57
Date: 2021-10-22 Date: 2021-10-22
Authors@R: c( person("Andrea", "Apolloni", email = Authors@R: c( person("Andrea", "Apolloni", email =
"andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal "andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal
......
...@@ -32,7 +32,11 @@ risk_unit <- function(r, eu, fun = mean) { ...@@ -32,7 +32,11 @@ risk_unit <- function(r, eu, fun = mean) {
## whenever possible and reproject to match r's CRS ## whenever possible and reproject to match r's CRS
if (is.na(proj4string(eu))) { if (is.na(proj4string(eu))) {
if (couldBeLonLat(eu)) { if (couldBeLonLat(eu)) {
# set_ReplCRS_warn(FALSE) # Not working?
suppressWarnings(
## Suppress warning when ussing proj4string's replacement method
proj4string(eu) <- CRS("+proj=longlat +datum=WGS84") proj4string(eu) <- CRS("+proj=longlat +datum=WGS84")
)
} else { } else {
stop( stop(
"Missing Coordinate Reference System (CRS) in the layer of epidemiological units.\n", "Missing Coordinate Reference System (CRS) in the layer of epidemiological units.\n",
...@@ -41,7 +45,7 @@ risk_unit <- function(r, eu, fun = mean) { ...@@ -41,7 +45,7 @@ risk_unit <- function(r, eu, fun = mean) {
} }
} }
eu <- spTransform(eu, CRS(proj4string(r))) eu <- spTransform(eu, CRS(wkt(r)))
} }
funrisk_poly <- over(eu, rgrid, fn = fun)[[1]] funrisk_poly <- over(eu, rgrid, fn = fun)[[1]]
...@@ -54,7 +58,7 @@ risk_unit <- function(r, eu, fun = mean) { ...@@ -54,7 +58,7 @@ risk_unit <- function(r, eu, fun = mean) {
if (any(idx <- is.na(funrisk_poly))) { if (any(idx <- is.na(funrisk_poly))) {
centroids <- SpatialPoints( centroids <- SpatialPoints(
coords = coordinates(eu)[idx, , drop = FALSE], coords = coordinates(eu)[idx, , drop = FALSE],
proj4string = CRS(proj4string(eu)) proj4string = CRS(wkt(eu))
) )
funrisk_poly[idx] <- over(centroids, rgrid)[[1]] funrisk_poly[idx] <- over(centroids, rgrid)[[1]]
......
...@@ -31,7 +31,7 @@ voronoi <- function(x, ext, eps = 1e-09) { ...@@ -31,7 +31,7 @@ voronoi <- function(x, ext, eps = 1e-09) {
if (.hasSlot(x, "data")) { if (.hasSlot(x, "data")) {
dat <- slot(x, "data") dat <- slot(x, "data")
} }
prj <- proj4string(x) prj <- wkt(x)
sp <- TRUE sp <- TRUE
xy <- coordinates(x) xy <- coordinates(x)
dups <- duplicated(xy) dups <- duplicated(xy)
......
...@@ -57,7 +57,10 @@ align_layers <- function(x) { ...@@ -57,7 +57,10 @@ align_layers <- function(x) {
for (i in which(!projs %in% commonest_proj) ){ for (i in which(!projs %in% commonest_proj) ){
if (is.na(projs[[i]])) { if (is.na(projs[[i]])) {
proj4string(x[[i]]) <- CRS(proj4string(x[[reflayer.idx]])) suppressWarnings(
## Suppress warning when ussing proj4string's replacement method
proj4string(x[[i]]) <- CRS(wkt(x[[reflayer.idx]]))
)
} else { } else {
x[[i]] <- projectRaster(x[[i]], x[[reflayer.idx]]) x[[i]] <- projectRaster(x[[i]], x[[reflayer.idx]])
} }
......
...@@ -6,7 +6,10 @@ test_that("handle rasters without projection information", { ...@@ -6,7 +6,10 @@ test_that("handle rasters without projection information", {
x <- list(animald, animald) x <- list(animald, animald)
proj4string(x[[1]]) <- NA proj4string(x[[1]]) <- NA
expect_equal(length(unique(lapply(align_layers(x), proj4string))), 1) expect_equal(
length(unique(lapply(align_layers(x), proj4string))),
1L
)
}) })
...@@ -14,9 +17,9 @@ test_that("harmonise rasters with different projections", { ...@@ -14,9 +17,9 @@ test_that("harmonise rasters with different projections", {
## Albers Equal Area Africa 1 CRS ## Albers Equal Area Africa 1 CRS
## http://spatialreference.org/ref/sr-org/8476/ ## http://spatialreference.org/ref/sr-org/8476/
proj.srorg8476 <- "+proj=aea +lat_1=36.5 +lat_2=29.071428571429 +lat_0=32.7857142857145 +lon_0=-14.111111111111 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs" proj.srorg8476 <- "+proj=aea +lat_1=36.5 +lat_2=29.071428571429 +lat_0=32.7857142857145 +lon_0=-14.111111111111 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
adp <- suppressWarnings(projectRaster(animald, crs = CRS(proj.srorg8476))) adp <- projectRaster(animald, crs = CRS(proj.srorg8476))
aligned <- suppressWarnings(align_layers(list(animald, adp, animald))) aligned <- align_layers(list(animald, adp, animald))
expect_identical( expect_identical(
unique(vapply(aligned, proj4string, character(1))), unique(vapply(aligned, proj4string, character(1))),
proj4string(animald) proj4string(animald)
......
...@@ -39,7 +39,7 @@ test_that("risk map from vector: compute distances", { ...@@ -39,7 +39,7 @@ test_that("risk map from vector: compute distances", {
## Points ## Points
set.seed(20190405) set.seed(20190405)
pts <- spsample(cmr$cmr_admin3, 10, type = "random") pts <- suppressWarnings(spsample(cmr$cmr_admin3, 10, type = "random"))
expect_error( expect_error(
risk_layer( risk_layer(
pts, boundaries = cmr$cmr_admin3, scale_target = rev(st) pts, boundaries = cmr$cmr_admin3, scale_target = rev(st)
......
...@@ -60,7 +60,7 @@ test_that("Missing CRS in epidemiological units", { ...@@ -60,7 +60,7 @@ test_that("Missing CRS in epidemiological units", {
## Also, reproject if necessary to match CRS of r ## Also, reproject if necessary to match CRS of r
# proj.4 projection description # proj.4 projection description
newproj <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84" newproj <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +datum=WGS84"
rt <- suppressWarnings(projectRaster(r, crs = CRS(newproj))) rt <- suppressWarnings(projectRaster(r, crs = CRS(newproj)))
res2 <- expect_warning(risk_unit(rt, eu_na), "CRS is NA") res2 <- expect_warning(risk_unit(rt, eu_na), "CRS is NA")
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment