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

Handle epidemiological units without CRS

fixes #27
parent 988b73ea
Package: mapMCDA Package: mapMCDA
Title: Produce an epidemiological risk map by weighting multiple risk factors Title: Produce an epidemiological risk map by weighting multiple risk
Version: 0.4.2 factors
Date: 2019-04-06 Version: 0.4.3
Authors@R: c( Date: 2019-04-11
person("Andrea", "Apolloni", email = "andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal mobility algorithm"), Authors@R: c( person("Andrea", "Apolloni", email =
person("Elena", "Arsevska", email = "elena.arsevska@cirad.fr", role = c("ctb")), "andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal
person("Françoise", "Chirara", email = "francoise.chirara@cirad.fr", role = c("ctb"), comment = "Logo designer"), mobility algorithm"), person("Elena", "Arsevska", email =
person("Sylvain", "Falala", email = "sylvain.falala@cirad.fr", role = c("aut"), comment = "Shiny interface"), "elena.arsevska@cirad.fr", role = c("ctb")),
person("Jean Marc", "Feussom", email = "mfeussom@gmail.com", role = c("ctb")), person("Françoise", "Chirara", email =
person("Renaud", "Lancelot", email = "renaud.lancelot@cirad.fr", role = c("ctb")), "francoise.chirara@cirad.fr", role = c("ctb"), comment = "Logo
person("Raphaëlle", "Metras", email = "raphaelle.metras@cirad.fr", role = c("ctb")), designer"), person("Sylvain", "Falala", email =
person("Facundo", "Muñoz", email = "facundo.munoz@cirad.fr", role = c("aut", "cre"), comment = c("Package developer", ORCID = "0000-0002-5061-4241")) "sylvain.falala@cirad.fr", role = c("aut"), comment = "Shiny
) interface"), person("Jean Marc", "Feussom", email =
Description: Use a Shiny interface to help users import multiple layers of risk "mfeussom@gmail.com", role = c("ctb")), person("Renaud",
factors, scale and combine them using a Multi-Criteria Decision Analysis "Lancelot", email = "renaud.lancelot@cirad.fr", role =
approach to produce a risk map as an outcome. c("ctb")), person("Raphaëlle", "Metras", email =
"raphaelle.metras@cirad.fr", role = c("ctb")),
person("Facundo", "Muñoz", email = "facundo.munoz@cirad.fr",
role = c("aut", "cre"), comment = c("Package developer", ORCID
= "0000-0002-5061-4241")) )
Description: Use a Shiny interface to help users import multiple layers
of risk factors, scale and combine them using a Multi-Criteria
Decision Analysis approach to produce a risk map as an outcome.
Depends: R (>= 3.2) Depends: R (>= 3.2)
License: GPL-3 + file LICENSE License: GPL-3 + file LICENSE
Encoding: UTF-8 Encoding: UTF-8
LazyData: true LazyData: true
Imports: Imports: classInt, deldir, geojsonio, geojsonlint, geonetwork, igraph,
classInt, methods, maps, maptools, plyr, raster, rasterVis, RColorBrewer,
deldir, rgdal, rgeos, rhandsontable, shiny, shinydashboard, shinyFiles,
geojsonio, sp, stringr, utils
geojsonlint, Suggests: devtools, knitr, mapview, rmarkdown, roxygen2, testthat
geonetwork,
igraph,
methods,
maps,
maptools,
plyr,
raster,
rasterVis,
RColorBrewer,
rgdal,
rgeos,
rhandsontable,
shiny,
shinydashboard,
shinyFiles,
sp,
stringr,
utils
Suggests:
devtools,
knitr,
mapview,
rmarkdown,
roxygen2,
testthat
RoxygenNote: 6.1.1 RoxygenNote: 6.1.1
URL: https://Cirad-ASTRE.github.io/mapMCDA URL: https://Cirad-ASTRE.github.io/mapMCDA
BugReports: https://github.com/Cirad-ASTRE/mapMCDA/issues BugReports: https://github.com/Cirad-ASTRE/mapMCDA/issues
......
...@@ -22,6 +22,28 @@ ...@@ -22,6 +22,28 @@
#' sp::spplot(cmr$cmr_admin3[, "rv"], cuts = 3) #' sp::spplot(cmr$cmr_admin3[, "rv"], cuts = 3)
risk_unit <- function(r, eu, fun = mean) { risk_unit <- function(r, eu, fun = mean) {
rgrid <- methods::as(r, "SpatialGridDataFrame") # needed for overlay methods rgrid <- methods::as(r, "SpatialGridDataFrame") # needed for overlay methods
## Possible differences in CRS
if (!identicalCRS(r, eu)) {
## r should have some CRS defined at this point
stopifnot(!is.na(proj4string(r)))
## If the epidemiological units don't have CRS, assume geographical
## whenever possible and reproject to match r's CRS
if (is.na(proj4string(eu))) {
if (couldBeLonLat(eu)) {
proj4string(eu) <- CRS("+proj=longlat +datum=WGS84")
} else {
stop(
"Missing Coordinate Reference System (CRS) in the layer of epidemiological units.\n",
"Please load a layer with the CRS information."
)
}
}
eu <- spTransform(eu, CRS(proj4string(r)))
}
funrisk_poly <- over(eu, rgrid, fn = fun)[[1]] funrisk_poly <- over(eu, rgrid, fn = fun)[[1]]
## Small-polygon correction ## Small-polygon correction
......
...@@ -435,7 +435,7 @@ server <- function(input, output, session) { ...@@ -435,7 +435,7 @@ server <- function(input, output, session) {
if(is.null(epidUnitLayer)) return(NULL) if(is.null(epidUnitLayer)) return(NULL)
if( !is.projected(epidUnitLayer)) { if( !isTRUE(is.projected(epidUnitLayer))) {
warning("This map is not projected. This can lead to very warning("This map is not projected. This can lead to very
inaccurate computations of distances and areas, depending inaccurate computations of distances and areas, depending
on the location and size of the region of interest. on the location and size of the region of interest.
......
context("risk_unit") context("risk_unit")
## 10 x 10 raster with sequential values ## 10 x 10 raster with sequential values
r <- raster(nrow = 10, ncol = 10) r <- raster(xmn=-110, xmx=-90, ymn=40, ymx=60, nrow = 10, ncol = 10)
r[] <- seq.int(ncell(r)) r <- setValues(r, seq.int(ncell(r)))
## polygons covering the region by squares of 2x2 pixels ## polygons covering the region by squares of 2x2 pixels
r0 <- r r0 <- r
res(r0) <- 2*res(r) res(r0) <- 2*res(r)
epiunits <- as(r0, "SpatialPolygons") epiunits <- as(r0, "SpatialPolygons")
## index for the polygons (for each pixel, what block it belongs to)
block <-
do.call(
paste0,
expand.grid(x = rep(1:5, each = 2), y = rep(1:5, each = 2))
)
block <- factor(block, levels = unique(block))
test_that("risk_unit returns a vector of length n_polygons", { test_that("risk_unit returns a vector of length n_polygons", {
riskvalues <- risk_unit(r, epiunits) riskvalues <- risk_unit(r, epiunits)
...@@ -27,7 +19,16 @@ test_that("risk_unit returns a vector of length n_polygons", { ...@@ -27,7 +19,16 @@ test_that("risk_unit returns a vector of length n_polygons", {
}) })
test_that("alternative risk summaries", { test_that("alternative risk summaries", {
## index for the polygons (for each pixel, what block it belongs to)
block <-
do.call(
paste0,
expand.grid(x = rep(1:5, each = 2), y = rep(1:5, each = 2))
)
block <- factor(block, levels = unique(block))
expect_summary <- function(fun) { expect_summary <- function(fun) {
expect_identical( expect_identical(
risk_unit(r, epiunits, fun = fun), risk_unit(r, epiunits, fun = fun),
...@@ -42,3 +43,32 @@ test_that("alternative risk summaries", { ...@@ -42,3 +43,32 @@ test_that("alternative risk summaries", {
expect_summary(sum) expect_summary(sum)
}) })
test_that("Missing CRS in epidemiological units", {
eu_na <- epiunits
proj4string(eu_na) <- CRS()
## If no CRS but possibly geographical coordinates,
## assume them, and yield results with a Warning
res1 <- expect_warning(risk_unit(r, eu_na), "CRS is NA")
expect_true(!any(is.na(res1)))
## Also, reproject if necessary to match CRS of r
# proj.4 projection description
newproj <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
rt <- suppressWarnings(projectRaster(r, crs = CRS(newproj)))
res2 <- expect_warning(risk_unit(rt, eu_na), "CRS is NA")
expect_true(!any(is.na(res2)))
## However, if the CRS is missing but coordinates are projected,
## fail.
eu_pr <- epiunits
eu_pr <- spTransform(eu_pr, CRS(newproj))
proj4string(eu_pr) <- CRS()
expect_error(risk_unit(rt, eu_pr), "Missing Coordinate Reference System")
})
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