Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
UMR-ASTRE
mapMCDA
Commits
1290fa47
Commit
1290fa47
authored
Jan 18, 2019
by
Facundo Muñoz
®️
Browse files
compute epidemic_threshold() on a graph
parent
1d3d69ed
Changes
4
Hide whitespace changes
Inline
Side-by-side
NAMESPACE
View file @
1290fa47
...
...
@@ -23,4 +23,12 @@ import(methods)
import(raster)
import(rgdal)
import(sp)
importFrom(igraph,"edge.attributes<-")
importFrom(igraph,as_data_frame)
importFrom(igraph,decompose.graph)
importFrom(igraph,degree)
importFrom(igraph,edge.attributes)
importFrom(igraph,edge_attr_names)
importFrom(igraph,gorder)
importFrom(igraph,graph_from_data_frame)
importFrom(igraph,is.weighted)
R/network.R
View file @
1290fa47
...
...
@@ -23,7 +23,8 @@
#' @param x character. Path of csv file
#'
#' @return object of class \code{igraph}
#' @importFrom igraph graph_from_data_frame
#' @importFrom igraph graph_from_data_frame edge_attr_names
#' edge.attributes edge.attributes<-
#' @export
#'
#' @examples
...
...
@@ -121,3 +122,150 @@ must be respected:",
return
(
ans
)
}
#' Compute the Epidemic Threshold of a graph
#'
#' Weighted and unweighted Epidemic Threshold \eqn{q} of a graph.
#'
#' The Epidemic Threshold \eqn{q} quantifies the minimal expeced transmission
#' coefficient necessary for diffusing an epidemy in a network.
#' It is computed as the inverse of the \emph{Potential for transmission} of
#' the network: a measure of the expected
#' number of nodes affected by an infectious node, which is a generalisation
#' of the Basic Reproduction Number \eqn{R_0}{R₀} of an epidemy to
#' the context of a network. It thus quantifies the potential for
#' transmission of an infection throughout the contact network.
#' It is computed in terms of the incoming-outgoing rates from
#' the network's nodes:
#' \deqn{R_0 = \beta \frac{\hat{k_\text{in} k_\text{out}}}{\hat{k_\text{in}}},}{R₀ = \beta〈k_in*k_out〉/〈k_in〉,}
#' where \eqn{\beta} is the transmission coefficient among animals,
#' \eqn{k_\text{in/out}}{k_in/out} are the in/out-degrees of a node and the
#' \eqn{\hat{\cdot}}{〈·〉} symbol represents the average value across all nodes
#' in the graph.
#'
#' The unweighted value computed above is most appropriate for a highly
#' infectious epidemy with high animal-prevalence on nodes, as it assumes that
#' any contact is potentially infectious.
#'
#' In the weighted formulation, \eqn{k_\text{in/out}}{k_in/out} are
#' the weight values for the incoming/outgoing edges in each node.
#' It is more appropriate for low-prevalence diseases, where the transmission
#' probability is assumed proportional to the number of contacts.
#' Compute the Epidemic Threshold of a graph
#'
#' Weighted and unweighted Epidemic Threshold \eqn{q} of a graph.
#'
#' The Epidemic Threshold \eqn{q} quantifies the minimal expeced
#' transmission coefficient necessary for diffusing an epidemy in a
#' network. It is computed as the inverse of the \emph{Potential for
#' transmission} of the network: a measure of the expected number of
#' nodes affected by an infectious node, which is a generalisation of
#' the Basic Reproduction Number \eqn{R_0}{R₀} of an epidemy to the
#' context of a network. It thus quantifies the potential for
#' transmission of an infection throughout the contact network. It is
#' computed in terms of the incoming-outgoing rates from the network's
#' nodes: \deqn{R_0 = \beta \frac{\hat{k_\text{in}
#' k_\text{out}}}{\hat{k_\text{in}}},}{R₀ = \beta〈k_in*k_out〉/〈k_in〉,}
#' where \eqn{\beta} is the transmission coefficient among animals,
#' \eqn{k_\text{in/out}}{k_in/out} are the in/out-degrees of a node
#' and the \eqn{\hat{\cdot}}{〈·〉} symbol represents the average value
#' across all nodes in the graph.
#'
#' The unweighted value computed above is most appropriate for a
#' highly infectious epidemy with high animal-prevalence on nodes, as
#' it assumes that any contact is potentially infectious.
#'
#' In the weighted formulation, \eqn{k_\text{in/out}}{k_in/out} are
#' the weight values for the incoming/outgoing edges in each node. It
#' is more appropriate for low-prevalence diseases, where the
#' transmission probability is assumed proportional to the number of
#' contacts.
#'
#' The default value of 1 for the probability of transmission
#' \code{beta} implies that every infectious contact leads to
#' transmission.
#'
#' @param x an \code{igraph} object
#' @param beta numeric, between 0 and 1. Probability of transmission.
#'
#' @return a list the weighted and unweighted Potential for
#' Transmission \eqn{R_0}{R₀} and its inverse, the Epidemic
#' Threshold \eqn{q}. As an attribute named "sna", a data.frame with
#' the in/out-degrees of each node and their individual contribution
#' to R0.
#'
#' If the input graph is unweighted, the weighted component is NULL.
#'
#' @importFrom igraph decompose.graph degree gorder is.weighted
#' as_data_frame
#'
#' @references
#' Volkova VV, Howey R, Savill NJ, Woolhouse MEJ (2010) Sheep
#' Movement Networks and the Transmission of Infectious Diseases.
#' PLoS ONE 5(6): e11185.
#' https://doi.org/10.1371/journal.pone.0011185
#' @examples
#' g <- igraph::graph_from_literal(A --+ B --+C, A --+C, B --+D)
#' epidemic_threshold(g)
#'
#' ## weighted graph
#' igraph::E(g)$weight <- c(10, 1, 2, 5)
#' epidemic_threshold(g)
epidemic_threshold
<-
function
(
x
,
beta
=
1
)
{
UseMethod
(
"epidemic_threshold"
)
}
epidemic_threshold.igraph
<-
function
(
x
,
beta
=
1
)
{
sc
<-
decompose.graph
(
x
)
n_v
<-
lapply
(
sc
,
gorder
)
## work only with the largest network
## (in terms of number of nodes)
largest_x
<-
sc
[[
which.max
(
n_v
)]]
sna
<-
data.frame
(
indeg
=
degree
(
largest_x
,
mode
=
"in"
),
outdeg
=
degree
(
largest_x
,
mode
=
"out"
)
)
sna
<-
cbind
(
node
=
rownames
(
sna
),
sna
)
rownames
(
sna
)
<-
NULL
sna
[
is.na
(
sna
)]
<-
0
R0_contrib
<-
epidemic_threshold
(
sna
[,
c
(
"indeg"
,
"outdeg"
)])
epidata
<-
setNames
(
sum
(
R0_contrib
)
^
c
(
1
,
-1
),
c
(
"R0"
,
"q"
))
attr
(
epidata
,
"sna"
)
<-
cbind
(
sna
,
R0k
=
R0_contrib
)
epidataw
<-
NULL
if
(
is.weighted
(
largest_x
))
{
lxdf
<-
as_data_frame
(
largest_x
)
in_w
<-
setNames
(
aggregate
(
lxdf
$
weight
,
by
=
list
(
lxdf
$
to
),
sum
),
c
(
"node"
,
"in_w"
)
)
out_w
<-
setNames
(
aggregate
(
lxdf
$
weight
,
by
=
list
(
lxdf
$
from
),
sum
),
c
(
"node"
,
"out_w"
)
)
snaw
<-
merge
(
in_w
,
out_w
,
by
=
"node"
,
all
=
TRUE
)
snaw
[
is.na
(
snaw
)]
<-
0
R0w_contrib
<-
epidemic_threshold
(
snaw
[,
c
(
"in_w"
,
"out_w"
)])
epidataw
<-
setNames
(
sum
(
R0w_contrib
)
^
c
(
1
,
-1
),
c
(
"R0"
,
"q"
))
attr
(
epidataw
,
"sna"
)
<-
cbind
(
snaw
,
R0k_w
=
R0w_contrib
)
}
return
(
list
(
unweighted
=
epidata
,
weighted
=
epidataw
))
}
epidemic_threshold.data.frame
<-
function
(
x
,
beta
)
{
stopifnot
(
ncol
(
x
)
==
2
)
## Individual contributions to R0
return
(
x
[,
1
]
*
x
[,
2
]
/
sum
(
x
[,
1
])
)
}
man/epidemic_threshold.Rd
0 → 100644
View file @
1290fa47
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/network.R
\name{epidemic_threshold}
\alias{epidemic_threshold}
\title{Compute the Epidemic Threshold of a graph}
\usage{
epidemic_threshold(x, beta = 1)
}
\arguments{
\item{x}{an \code{igraph} object}
\item{beta}{numeric, between 0 and 1. Probability of transmission.}
}
\value{
a list the weighted and unweighted Potential for
Transmission \eqn{R_0}{R₀} and its inverse, the Epidemic
Threshold \eqn{q}. As an attribute named "sna", a data.frame with
the in/out-degrees of each node and their individual contribution
to R0.
If the input graph is unweighted, the weighted component is NULL.
}
\description{
Weighted and unweighted Epidemic Threshold \eqn{q} of a graph.
}
\details{
The Epidemic Threshold \eqn{q} quantifies the minimal expeced
transmission coefficient necessary for diffusing an epidemy in a
network. It is computed as the inverse of the \emph{Potential for
transmission} of the network: a measure of the expected number of
nodes affected by an infectious node, which is a generalisation of
the Basic Reproduction Number \eqn{R_0}{R₀} of an epidemy to the
context of a network. It thus quantifies the potential for
transmission of an infection throughout the contact network. It is
computed in terms of the incoming-outgoing rates from the network's
nodes: \deqn{R_0 = \beta \frac{\hat{k_\text{in}
k_\text{out}}}{\hat{k_\text{in}}},}{R₀ = \beta〈k_in*k_out〉/〈k_in〉,}
where \eqn{\beta} is the transmission coefficient among animals,
\eqn{k_\text{in/out}}{k_in/out} are the in/out-degrees of a node
and the \eqn{\hat{\cdot}}{〈·〉} symbol represents the average value
across all nodes in the graph.
The unweighted value computed above is most appropriate for a
highly infectious epidemy with high animal-prevalence on nodes, as
it assumes that any contact is potentially infectious.
In the weighted formulation, \eqn{k_\text{in/out}}{k_in/out} are
the weight values for the incoming/outgoing edges in each node. It
is more appropriate for low-prevalence diseases, where the
transmission probability is assumed proportional to the number of
contacts.
The default value of 1 for the probability of transmission
\code{beta} implies that every infectious contact leads to
transmission.
}
\examples{
g <- igraph::graph_from_literal(A --+ B --+C, A --+C, B --+D)
epidemic_threshold(g)
## weighted graph
igraph::E(g)$weight <- c(10, 1, 2, 5)
epidemic_threshold(g)
}
\references{
Volkova VV, Howey R, Savill NJ, Woolhouse MEJ (2010) Sheep
Movement Networks and the Transmission of Infectious Diseases.
PLoS ONE 5(6): e11185.
https://doi.org/10.1371/journal.pone.0011185
}
tests/testthat/test-network.R
View file @
1290fa47
...
...
@@ -13,3 +13,47 @@ context("Network data")
## lat_dest numeric (decimal degrees, WGS84)
## volume Optional. directed flux in some consistent unit.
test_that
(
"Computation of the epidemic threshold"
,
{
## Unweighted graph with two nodes
g
<-
igraph
::
graph_from_literal
(
A
--+
B
--+
C
)
etg
<-
epidemic_threshold
(
g
)
sna
<-
attr
(
etg
$
unweighted
,
"sna"
)
expect_true
(
is.null
(
etg
$
weighted
))
expect_equal
(
etg
$
unweighted
,
c
(
R0
=
0.5
,
q
=
2
),
check.attributes
=
FALSE
)
expect_is
(
sna
,
"data.frame"
)
expect_identical
(
dim
(
sna
),
c
(
length
(
igraph
::
V
(
g
)),
4L
))
## Weighted graph
igraph
::
E
(
g
)
$
weight
<-
c
(
10
)
etw
<-
epidemic_threshold
(
g
)
snw
<-
attr
(
etw
$
weighted
,
"sna"
)
expect_true
(
!
is.null
(
etw
$
weighted
))
expect_equal
(
etw
$
weighted
,
c
(
R0
=
5
,
q
=
.2
),
check.attributes
=
FALSE
)
expect_is
(
snw
,
"data.frame"
)
expect_identical
(
dim
(
snw
),
c
(
length
(
igraph
::
V
(
g
)),
4L
))
## data.frame (2-col with in/out degrees)
expect_identical
(
epidemic_threshold
(
sna
[,
2
:
3
]),
sna
[,
4
]
)
expect_identical
(
sum
(
sna
[,
4
]),
etg
$
unweighted
[[
"R0"
]])
expect_identical
(
epidemic_threshold
(
snw
[,
2
:
3
]),
snw
[,
4
]
)
expect_identical
(
sum
(
snw
[,
4
]),
etw
$
weighted
[[
"R0"
]])
})
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment