Nothing
context("Testing single-host with discrete structure")
test_that("Error message pops up when structure.matrix or init.structure is badly formed", {
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_fct <- function(t){return(0.1)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
# transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
transition.matrix = c("A","B")
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"structure.matrix should be a matrix."
)
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0,0.8,0.1,0.3),nrow = 3, ncol = 4,dimnames=list(c("A","B","C"),c("A","B","C","D")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"structure.matrix should have the same number of rows and columns."
)
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","D")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"structure.matrix rows and columns should have the same names."
)
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.8,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"structure.matrix rows should sum up to 1."
)
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="D",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"init.structure should be a state present in structure.matrix."
)
})
test_that("Movement is coherent with single introduction, constant pMove", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_fct <- function(t){return(0.1)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(805)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
## Output
expect_output(print(test.nosoiA), "a single host with a discrete structure")
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 6)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")),3)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")$state,c("A","C","B"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.at.end = getHostData(test.nosoiA, "table.hosts") %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.at.end, current.in == "A")$N,62)
expect_equal(subset(Where.at.end, current.in == "B")$N,17)
expect_equal(subset(Where.at.end, current.in == "C")$N,43)
#Summary
test <- summary(test.nosoiA)
expect_equal(test$R0$N.inactive, 31)
expect_equal(test$dynamics[21]$t, 14)
expect_equal(test$dynamics[21]$Count, 11)
expect_equal(test$dynamics[21]$type, "H")
expect_equal(test$dynamics[21]$state, "C")
#Get host table
test.hostTable.A <- getTableHosts(test.nosoiA)
expect_equal(test.hostTable.A[35]$out.time, 14)
#Get state table
test.stateTable.A <- getTableState(test.nosoiA)
expect_equal(test.stateTable.A[52]$hosts.ID, "H-26")
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
#--------------------------------------------------------------------------------------------------------------------------------------------
test_that("Movement is coherent with single introduction, complex pMove", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_param1_fct <- function(x){rnorm(x,mean = 10,sd=2)}
p_Move_fct <- function(t,pMove.param1){plogis(t,pMove.param1,2)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(750)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=list(pMove.param1=p_Move_param1_fct),
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 6)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")),11)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")$state,c("A","C","A","C","A","B","C","B","C","A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.at.end = getHostData(test.nosoiA, "table.hosts") %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.at.end, current.in == "A")$N,83)
expect_equal(subset(Where.at.end, current.in == "B")$N,19)
expect_equal(subset(Where.at.end, current.in == "C")$N,16)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Movement is coherent with single introduction, constant but different pMove, 1 loc (C) is sink. Ce tombeau sera votre tombeau !", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_fct <- function(t,current.in){
if(current.in=="A"){return(0.1)}
if(current.in=="B"){return(0.3)}
if(current.in=="C"){return(0)}}
#
# p_Move_param1_fct <- function(x){rnorm(x,mean = 10,sd=2)}
#
# p_Move_fct <- function(t,current.in,pMove.param1){
# if(current.in=="A"){return(plogis(t,1+pMove.param1,2))}
# if(current.in=="B"){return(plogis(t,2+pMove.param1,2))}
# if(current.in=="C"){return(plogis(t,pMove.param1,2)/1000)}}
# param.pMove = list(pMove.param1=p_Move_param1_fct)
param.pMove = NA
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(750)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=10000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
diff.pMove=TRUE,
pMove=p_Move_fct,
param.pMove=param.pMove,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 6)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")),2)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")$state,c("A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.at.end = getHostData(test.nosoiA, "table.hosts") %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.at.end, current.in == "C")$N,138)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Error message pops up if different pMove poorly formatted", {
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_fct <- function(t,current.in){
if(current.in=="A"){return(0.1)}
if(current.in=="C"){return(0)}}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=10000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
diff.pMove=TRUE,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"pMove should have a realisation for each possible state. diff.pMove is TRUE."
)
})
test_that("Movement is coherent with single introduction, complex and different pMove, 1 loc (C) is sink.", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_param1_fct <- function(x){rnorm(x,mean = 10,sd=2)}
p_Move_fct <- function(t,current.in,pMove.param1){
if(current.in=="A"){return(plogis(t,1+pMove.param1,2))}
if(current.in=="B"){return(plogis(t,2+pMove.param1,2))}
if(current.in=="C"){return(plogis(t,pMove.param1,2)/1000)}}
param.pMove = list(pMove.param1=p_Move_param1_fct)
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(750)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=10000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
diff.pMove=TRUE,
pMove=p_Move_fct,
param.pMove=param.pMove,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 6)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")),2)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")$state,c("A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.at.end = getHostData(test.nosoiA, "table.hosts") %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.at.end, current.in == "C")$N,52)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Error message pops out when missing state in diff functions", {
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Move_fct <- function(t){return(0.1)}
p_Exit_fct <- function(t,current.in){
if(current.in=="A"){return(0)}
if(current.in=="C"){return(1)}}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
diff.pExit=TRUE,
pExit=p_Exit_fct,
param.pExit=NA
),
"pExit should have a realisation for each possible state. diff.pExit is TRUE."
)
p_Exit_fct <- function(x){return(0.08)}
time_contact <- function(t,current.in){
if(current.in=="A"){
return(round(rnorm(1, 3, 1), 0))}
if(current.in=="C"){
return(round(rnorm(1, 6, 1), 0))}
}
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
diff.nContact=TRUE,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
diff.pExit=NA,
pExit=p_Exit_fct,
param.pExit=NA
),
"nContact should have a realisation for each possible state. diff.nContact is TRUE."
)
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
proba <- function(t,current.in,p_max,t_incub){
if(current.in=="A"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)}
if(current.in=="C"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)}
}
expect_error(
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
diff.pTrans=TRUE,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
),
"pTrans should have a realisation for each possible state. diff.pTrans is TRUE."
)
})
test_that("Movement is coherent with single introduction, constant pMove, diff pExit", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Move_fct <- function(t){return(0.1)}
p_Exit_fct <- function(t,current.in){
if(current.in=="A"){return(0)}
if(current.in=="B"){return(0.5)}
if(current.in=="C"){return(1)}}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(805)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
diff.pExit=TRUE,
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)], directed = F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 7)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")),2)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")$state,c("A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.when.exit = subset(getHostData(test.nosoiA, "table.hosts"),active==0) %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.when.exit, current.in == "A")$N,integer(0))
expect_equal(subset(Where.when.exit, current.in == "B")$N,44)
expect_equal(subset(Where.when.exit, current.in == "C")$N,34)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Movement is coherent with single introduction, constant pMove, diff pTrans ", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Move_fct <- function(t){return(0.1)}
p_Exit_fct <- function(t){return(0.08)}
proba <- function(t,current.in,p_max,t_incub){
if(current.in=="A"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)}
if(current.in=="B"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=0}
return(p)}
if(current.in=="C"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)}
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(805)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
diff.pTrans = TRUE,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 7)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")),2)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")$state,c("A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.when.infected = subset(getHostData(test.nosoiA, "table.hosts"),active==0) %>% group_by(inf.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.when.infected, inf.in == "B")$N,integer(0))
expect_equal(subset(Where.when.infected, inf.in == "A")$N,56)
expect_equal(subset(Where.when.infected, inf.in == "C")$N,17)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Movement is coherent with single introduction, constant pMove, diff nContact ", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Move_fct <- function(t){return(0.1)}
p_Exit_fct <- function(t){return(0.08)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact <- function(t,current.in){
if(current.in=="A"){
return(round(rnorm(1, 3, 1), 0))}
if(current.in=="B"){return(0)}
if(current.in=="C"){
return(round(rnorm(1, 6, 1), 0))}
}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(805)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
diff.nContact=TRUE,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 8)
expect_equal(nrow(getHostData(test.nosoiA, "table.hosts")),612)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")),2)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-3")$state,c("A","C"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.when.infected = subset(getHostData(test.nosoiA, "table.hosts"),active==0) %>% group_by(inf.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.when.infected, inf.in == "B")$N,integer(0))
expect_equal(subset(Where.when.infected, inf.in == "A")$N,27)
expect_equal(subset(Where.when.infected, inf.in == "C")$N,67)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Movement is coherent with single introduction, all parameters are diff", {
skip_if_not_installed("igraph")
library(igraph)
p_Move_fct <- function(t,current.in){
if(current.in=="A"){return(0.1)}
if(current.in=="B"){return(0)}
if(current.in=="C"){return(0.2)}
if(current.in=="D"){return(0.3)}
}
p_Exit_fct <- function(t,current.in){
if(current.in=="A"){return(0.1)}
if(current.in=="B"){return(0.1)}
if(current.in=="C"){return(0)}
if(current.in=="D"){return(1)}
}
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
proba <- function(t,current.in,p_max,t_incub){
if(current.in=="A"){
if(t <= t_incub-3){p=0}
if(t >= t_incub){p=p_max}
return(p)}
if(current.in=="B"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=0}
return(p)}
if(current.in=="C"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=1}
return(p)}
if(current.in=="D"){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)}
}
time_contact <- function(t,current.in){
if(current.in=="A"){
return(0)}
if(current.in=="B"){return(0)}
if(current.in=="C"){
return(round(rnorm(1, 2, 1), 0))}
if(current.in=="D"){
return(round(rnorm(1, 3, 1), 0))}
}
transition.matrix = matrix(c(0,0.1,0.6,0.3,0.1,0,0.1,0.3,0.6,0.5,0,0.4,0.3,0.4,0.3,0),nrow = 4, ncol = 4,dimnames=list(c("A","B","C","D"),c("A","B","C","D")))
# transition.matrix = matrix(c(0,2,3,4,5,0,7,8,9,10,0,12,13,14,15,0),nrow = 4, ncol = 4,dimnames=list(c("A","B","C","D"),c("A","B","C","D")))
set.seed(186)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=40,
max.infected=1000,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
diff.pMove=TRUE,
pMove=p_Move_fct,
param.pMove=NA,
diff.nContact=TRUE,
nContact=time_contact,
param.nContact=NA,
diff.pTrans = TRUE,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
diff.pExit=TRUE,
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 12)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")),3)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")$state,c("A","C","A"))
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.when.infected = getHostData(test.nosoiA, "table.hosts") %>% group_by(inf.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.when.infected, inf.in == "B")$N,integer(0))
expect_equal(subset(Where.when.infected, inf.in == "A")$N,1)
expect_equal(subset(Where.when.infected, inf.in == "C")$N,968)
Where.when.died = subset(getHostData(test.nosoiA, "table.hosts"),active==0) %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.when.died, current.in == "C")$N,integer(0))
expect_equal(subset(Where.when.died, current.in == "D")$N,207)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Epidemic dying out", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Exit_fct <- function(t){return(0.08)}
p_Move_fct <- function(t){return(0.1)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact = function(t){round(rnorm(1, 3, 1), 0)}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(10)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=20,
max.infected=100,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-1")),1)
expect_equal(test.nosoiA$total.time,4)
skip_if_not_installed("dplyr")
skip_if_not_installed("magrittr")
library(dplyr)
library(magrittr)
Where.at.end = getHostData(test.nosoiA, "table.hosts") %>% group_by(current.in) %>% summarise(N=length(hosts.ID))
expect_equal(subset(Where.at.end, current.in == "A")$N,1)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
test_that("Movement is coherent with single introduction, no pMove, no die, diff nContact with hostCount needed", {
skip_if_not_installed("igraph")
library(igraph)
t_incub_fct <- function(x){rnorm(x,mean = 5,sd=1)}
p_max_fct <- function(x){rbeta(x,shape1 = 5,shape2=2)}
p_Move_fct <- function(t){return(0.1)}
p_Exit_fct <- function(t){return(0.05)}
proba <- function(t,p_max,t_incub){
if(t <= t_incub){p=0}
if(t >= t_incub){p=p_max}
return(p)
}
time_contact <- function(t, current.in, host.count){
temp.val = 30 - host.count
if(temp.val <= 0) {
return(0)
}
if(temp.val >= 0) {
if(current.in=="A"){
return(round((temp.val/30)*rnorm(1, 3, 1), 0))}
if(current.in=="B"){return(0)}
if(current.in=="C"){
return(round((temp.val/30)*rnorm(1, 6, 1), 0))}
}
}
transition.matrix = matrix(c(0,0.2,0.4,0.5,0,0.6,0.5,0.8,0),nrow = 3, ncol = 3,dimnames=list(c("A","B","C"),c("A","B","C")))
set.seed(1050)
test.nosoiA <- nosoiSim(type="single", popStructure="discrete",
length=100,
max.infected=200,
init.individuals=1,
init.structure="A",
structure.matrix=transition.matrix,
pMove=p_Move_fct,
param.pMove=NA,
diff.nContact=TRUE,
hostCount.nContact=TRUE,
nContact=time_contact,
param.nContact=NA,
pTrans = proba,
param.pTrans = list(p_max=p_max_fct,
t_incub=t_incub_fct),
pExit=p_Exit_fct,
param.pExit=NA
)
#Structure
g <- graph.data.frame(getHostData(test.nosoiA, "table.hosts")[,c(1,2)],directed=F)
expect_equal(transitivity(g, type="global"), 0)
expect_equal(clusters(g, "weak")$no, 1)
expect_equal(diameter(g, directed=F, weights=NA), 10)
expect_equal(nrow(getHostData(test.nosoiA, "table.hosts")),204)
#Movement
expect_equal(nrow(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-2")),5)
expect_equal(subset(getHostData(test.nosoiA, "table.state"), hosts.ID == "H-2")$state,c("A","C","A","C","B"))
#Number of host at each loc at each time
out = getDynamic(test.nosoiA) # ggplot(out, aes(x=t,y=Count,color=state)) + geom_line() + geom_hline(yintercept=30)
expect_equal(subset(out,state=="C" & t==26)$Count,28)
expect_equal(subset(out,state=="B" & t==26)$Count,15)
expect_equal(subset(out,state=="A" & t==25)$Count,30)
skip_if_not_installed("dplyr")
dynOld <- getDynamicOld(test.nosoiA)
dynNew <- getDynamic(test.nosoiA)
expect_equal(dynOld, dynNew)
r_0 <- getR0(test.nosoiA)
expect_equal(r_0$N.inactive,
ifelse(length(r_0$R0.dist) == 1 && is.na(r_0$R0.dist), 0, length(r_0$R0.dist)))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.