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

bugfix: networks with R0 of 0: yield constant contributions

- fixes #16
parent ad0d3c46
Package: mapMCDA
Title: Produce an epidemiological risk map by weighting multiple risk factors
Version: 0.3.7
Version: 0.3.8
Date: 2019-04-06
Authors@R: c(
person("Andrea", "Apolloni", email = "andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal mobility algorithm"),
......
......@@ -210,8 +210,16 @@ setMethod(
sna <- attr(epiR0, "sna")
if (isTRUE(all.equal(unname(epiR0["R0"]), 0))) {
## In this case, all individual contributions are equally 0
stopifnot(all(vapply(sna$R0k, all.equal, TRUE, 0)))
relative_contributions <- rep(1/length(sna$R0k), length(sna$R0k))
} else {
relative_contributions <- sna$R0k / epiR0["R0"]
}
node_importance <- setNames(
data.frame(sna[, 1], 100 * sna$R0k / epiR0["R0"]),
data.frame(sna[, 1], 100 * relative_contributions),
c("name", "importance")
)
......
......@@ -37,6 +37,12 @@ risk_layer <- function(x, boundaries, scale_target = c(0, 100)) {
scale_source <- range(raster::values(r), na.rm = TRUE)
if (isTRUE(all.equal(diff(scale_source), 0))) {
stop("Risk factor ", substitute(x),
" has a constant value and cannot be used as it is.\n",
"Please correct or remove.")
}
## Linear function
lin_fun <- function(r) {
slope <- diff(scale_target)/diff(scale_source)
......
......@@ -57,3 +57,44 @@ test_that("Computation of the epidemic threshold", {
)
expect_identical(sum(snw[, 4]), etw$weighted[["R0"]])
})
test_that("Network rasterisation", {
r <- raster(nrow = 10, ncol = 10, xmn = 0, xmx = 10, ymn = 0, ymx = 10, vals = 1)
## A geonetwork with a single source and several destinations:
## A -> B; A -> C; A -> D
edges <- data.frame(
O = rep("A", 3),
D = LETTERS[2:4],
stringsAsFactors = FALSE
)
nodes <- data.frame(
node = LETTERS[1:4],
x = rep(c(2, 8), times = 2),
y = rep(c(2, 8), each = 2)
)
gn <- geonetwork::geonetwork(edges, nodes)
# plot(r)
# plot(gn, add = TRUE)
gnr <- rasterize(gn, r)
# plot(gnr)
## Constant value of 1/N_nodes * 100
expect_equal(diff(range(values(gnr))), 0)
expect_equal(values(gnr)[1], 100 / nrow(nodes))
## Add an outgoing link from B -> D
gn2 <- geonetwork::geonetwork(rbind(edges, c("B", "D")), nodes)
gnr2 <- rasterize(gn2, r)
# plot(gnr2)
## Now, only B accounts for 100 of the contribution to the R0
## The value at B must be 100 while the values at the other nodes 0
vals_at_B <- extract(gnr2, nodes[nodes$node == "B", -1])
vals_not_B <- extract(gnr2, nodes[nodes$node != "B", -1])
expect_equal(vals_at_B, 100)
expect_true(all(vapply(vals_not_B, all.equal, TRUE, 0)))
})
......@@ -49,6 +49,15 @@ test_that("risk map from vector: compute distances", {
})
test_that("risk map from constant raster: error", {
r <- raster(nrow = 10, ncol = 10, xmn = 0, xmx = 10, ymn = 0, ymx = 10, vals = 1)
bnd <- as(extent(r), "SpatialPolygons")
# plot(bnd)
# plot(r, add = T)
expect_error(risk_layer(r, bnd), "constant value")
})
test_that("risk map from larger raster: crop and mask to boundaries", {
## create a raster filling beyond the full extent of the boundaries
......
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