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

bugfix: prevent dropping dimensions in data.frame selection

parent c67d5ba6
Package: mapMCDA
Title: Produce an epidemiological risk map by weighting multiple risk
factors
Version: 0.4.5
Date: 2019-04-11
Version: 0.4.7
Date: 2019-04-12
Authors@R: c( person("Andrea", "Apolloni", email =
"andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal
mobility algorithm"), person("Elena", "Arsevska", email =
......
......@@ -53,7 +53,7 @@ risk_unit <- function(r, eu, fun = mean) {
## For that cases, we overlay the polygon centers with the raster.
if (any(idx <- is.na(funrisk_poly))) {
centroids <- SpatialPoints(
coords = coordinates(eu)[idx, ],
coords = coordinates(eu)[idx, , drop = FALSE],
proj4string = CRS(proj4string(eu))
)
funrisk_poly[idx] <- over(centroids, rgrid)[[1]]
......
......@@ -9,6 +9,9 @@ r0 <- r
res(r0) <- 2*res(r)
epiunits <- as(r0, "SpatialPolygons")
# plot(r)
# plot(epiunits, add = T)
test_that("risk_unit returns a vector of length n_polygons", {
riskvalues <- risk_unit(r, epiunits)
......@@ -72,3 +75,19 @@ test_that("Missing CRS in epidemiological units", {
expect_error(risk_unit(rt, eu_pr), "Missing Coordinate Reference System")
})
test_that("Polygons not covering any raster-cell center", {
epi_ext <- raster::bind(raster::shift(epiunits[1], x = -5), epiunits)
# plot(r)
# plot(epi_ext, add = TRUE)
res <- expect_error(risk_unit(r, epi_ext), NA)
# the first unit is NA (does not cover any cell center)
expect_true(is.na(res[1]))
# none of the remaining units is NA (they all cover one cell center)
expect_true(!any(is.na(res[-1])))
})
Markdown is supported
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