Simulate_contact_control_LER_farm: Simulation of the epidemic control process considering a...
In holaanna/contactsimulator: Contact model simulator

Description Usage Arguments Details References See Also Examples

View source: R/simulation_control_gavin_obs.R

Epidemic simulation using the contact type model with the Australian control strategies.

Simulate_contact_control_LER_farm(f_rast = NULL, b_rast = NULL,
  farm_pos_cat = NULL, vis_int_per_cat = NULL, param, grid_lines,
  pop_grid, grid_size = 500, age_level = c(1, 1), age_dist = c(1, 0),
  m_start = 1, t_b = 1e+05, t_max = 1000, t_intervention = 1e+05,
  t_obs = seq(0, 1000, 100), EI_model = 1, kern_model = 4,
  rad = 1000, sweep_prop = c(0.5, 0.5), back_p = c(0.7, 0.5),
  rate_det = c(0.3, 1), int_det = c(30, 90, 180), nb_in_b = 1,
  nb = 3, leav = c(3, 6), ini = NULL, det_rat = 0)

`f_rast`	Population density of the grid a farm plant resides. This is filled from bottom to top, then left to right.
`b_rast`	Population density of the grid a backyard plant resides. This is filled from bottom to top, then left to right.
`farm_pos_cat`	A data frame of the intial conditon: ro The row at which the cell containing a farm lies in co The column at which the cell containing a farm lies in cat The category that the cell/farm belongs to vis_int Revisit interval tim_lst_pos Time of last positive nb_round Number of round of revisit sweep Decide whether to carry out the sweep over the farm: 0->no and 1->yes
`vis_int_per_cat`	A data frame of the visiting intervale for the alternative strategy: cat The category that the cell/farm belongs to vis_int Revisit interval
`param`	Indicating a data frame containing a vector of parameters including: epsion The primary infection rate. See `func_time_beta` beta_0 Baseline or average transmission rate. See `func_time_beta` beta_1 Amplitude of the seasonality. See `func_time_beta` alpha1,alpha2 The dispersal kernel parameters. mu_lat,var_lat mean and variance of the latent period. See `E_to_I` for details. t0 Time at which the primary source became active . omega Period of the forcing. See `func_time_beta` gama The mean proportion of short range dispersal events. .
`pop_grid`	Population density of the grid a case resides. This is filled from bottom to top, then left to right.
`grid_size`	Grid resolution //@inheritParams circle_line_intersections
`age_level`	Vectors of age level and the propportion of each age group respectively. See details.
`age_dist`	Vectors of age level and the propportion of each age group respectively. See details.
`m_start`	The size of initial cases. Default is 1.
`t_b`	Time representing the end of the baseline programme or the start of the alternative programme
`t_max`	Final observation time.
`t_intervention`	Start of the intervention if any.
`t_obs`	The sequence of time at which the observations are made
`EI_model`	Take integer values to specify the type of model used for the latent period. See `E_to_I`
`kern_model`	Take integer values to specify the type of dispersal kernel used. See `Samp_dis`
`rad`	Sweep radius
`sweep_prop`	A two element vector represention the proportion of plantation to consider for the sweep
`back_p`	A two element vector represention thes Backyard assessment proportion within sweep radius:
`rate_det`	Detection rate. 1st element Detection rate for the grower 2nd element Detection rate for the expert
`int_det`	Three elements vector representing the revisit intervals:
`nb_in_b`	The number of initial plants infected in category B farms
`nb`	The scaling factor of backyards
`leav`	The number of leaves to consider as a measurement for removal: 3 for expert to have a 100 detection
`ini`	A data frame of the intial state: row The row at which the cell containing the host lies in col The column at which the cell containing the host lies in typ The type of the host (e.g. backyard 1 /plantation 0 hosts) x x-coordinate y y-coordinate t_e exposure time t_i infection time
`det_rat`	The type of detection rate: 0 for constant and 1 for time varying

Simulate_contact_control_LER_farm provide the simulation of the epidemic process with the Australian BBTV management plan uisnt the obserbation times.

\insertRef

KR08contactsimulator \insertRefMee11contactsimulator

Simulate_contact_control

## Not run: 
library(raster)
library(tidyverse)
library(parallel)
library(pracma)
library(contactsimulator)
  size=500
f<- system.file("external/rast_newr_NSW.tif", package="contactsimulator")
f<- system.file(paste0("external/rast_NSW_",size,".tif"), package="contactsimulator")
f <-paste0("/media/sf_D_DRIVE/BBTV_PROJECT/Montville/rast_mont_SEQ",".tif")
rast<- raster(f)
names(rast)<- "layer"
size<- raster::res(rast)[1]
n_row_grid=nrow_grid=raster::nrow(rast)
n_col_grid=ncol_grid=raster::ncol(rast)
grid_size=raster::res(rast)[1]     # Resolution

n_line=(nrow_grid+1) + (ncol_grid +1)  # Number of grid  lines

x_min=raster::xmin(rast)  # min max of the bounding box
x_max=raster::xmax(rast)

y_min=raster::ymin(rast)
y_max=raster::ymax(rast)

pop_per_grid=round(raster::values(rast)*size^2)
pop_per_grid[is.na(pop_per_grid)]=0
mat=matrix(pop_per_grid,nrow = nrow_grid, byrow = TRUE)
pop_grid=flipdim(mat)     # population per grid

# Structure of the grid
x=seq(x_min,x_max,grid_size)
y=seq(y_min,y_max,grid_size)

grid_lines=array(0,c(n_line,6))
for(i in 1:n_line){
  if(i<=(nrow_grid +1)){
    grid_lines[i,]=c(i,1,x[1],y[i],x[length(x)],y[i])
  }
  else{
    grid_lines[i,]=c(i,2,x[i-length(y)],y[1],x[i-length(y)],y[length(y)])
  }
}

grid_lines=as.data.frame(grid_lines)
colnames(grid_lines)<- c("indx","orient_line","coor_x_1","coor_y_1","coor_x_2","coor_y_2")

# Individual raster
f<- system.file(paste0("external/rast_farms_NSW_",size,".tif"), package="contactsimulator")
f_rast<- raster(f)
pop=round(raster::values(f_rast)*size^2)
pop[is.na(pop)]=0
mat=matrix(pop,nrow = nrow_grid, byrow = TRUE)
f_rast=flipdim(mat)
y<- system.file(paste0("external/rast_backy_NSW_",size,".tif"), package="contactsimulator")
b_rast<- raster(y)
pop=round(raster::values(b_rast)*size^2)
pop[is.na(pop)]=0
mat=matrix(pop,nrow = nrow_grid, byrow = TRUE)
b_rast=flipdim(mat)

param<- data.frame(epsilon=10,beta=15,c=30,b1=0.3,alpha1=18,alpha2=1000,t0=0,omega=2*pi,mu_lat=0.062,var_lat=0.903,gama=0.5)
path="/run/user/1000/gvfs/sftp:host=login-cpu.hpc.cam.ac.uk/home/ha411/big_space/BBTV/Newrybar_partial/latent-leaf/"
path1="/run/user/1000/gvfs/sftp:host=login-cpu.hpc.cam.ac.uk/home/ha411/big_space/BBTV/"
dat=as.data.frame(read.table(paste0(path1,"Montville/leaf-2/leaf/Dout")))
dat=as.data.frame(read.table(paste0(path,"no-initial-infection/Dout")))

farm_pos_cat<- read.table(paste0(path1,"NSW_8_1_19/expo-kernel/farm_pos_cat.txt"),fill=T,header = T)
farm_pos_cat<- farm_pos_cat[with(farm_pos_cat,order(farm_pos_cat$cat)),]


M=read.table(paste0(path1,"Montville/leaf-2/cyclic_latent_omegapi/parameters_current.txt"),head=T)
M=read.table(paste0(path,"test-vague-prior/cyclic_latent_omegapi/parameters_current.txt"),head=T)
samp=sample(600000:nrow(M),1000);Param=data.frame(epsilon=M[samp,1],beta=M[samp,2],c=M[samp,5], delta=M[samp,6], b1=M[samp,7],alpha1=1/M[samp,8],alpha2=M[samp,9],t0=M[samp,10],omega=M[samp,11],mu_lat=M[samp,3],var_lat=M[samp,4])
Param$gama=0.5
ini<- data.frame(x=2069503,y=-3293246,t_e=0,t_i=0,typ=0,row=9,col=15)
ini=dat%>%filter(V5==min(V5))%>%dplyr::select(V2,V3,V4,V5,V10,V12,V13)%>%rename(x=V2,y=V3,t_e=V4,t_i=V5,typ=V10,row=V12,col=V13)
ini=dat%>%slice(1:4)%>%dplyr::select(V2,V3,V4,V5,V10,V12,V13)%>%rename(x=V2,y=V3,t_e=V4,t_i=V5,typ=V10,row=V12,col=V13)
ini<- ini%>%mutate(row=row+1,col=col+1)%>%arrange(t_i)
#ini<- ini%>%mutate(row=row+1,col=col+1)
t_obs<- read.table(paste0(path1,"Montville/leaf-2/obs_time"),fill = T)[,1]
t_max=max(t_obs)+1
L=list()
sim=numeric(1000)
L<- lapply(1:1000,function(x){
  print(x)
  param=Param[x,]
  # param$delta=.6
  xx=Simulate_contact_control_LER_farm(param=param, grid_lines=grid_lines, pop_grid=pop_grid,t_max = t_max, EI_model = 1,kern_model = 5,t_obs = t_obs,grid_size = grid_size,m_start = nrow(ini),nb=2,ini = ini,leav = c(2,6))
  # xx=Simulate_contact_control_LER(param=param, grid_lines=grid_lines, pop_grid=pop_grid,t_max = t_max, EI_model = 1,kern_model = 5,t_obs = 2000,grid_size = grid_size,m_start = 5,nb=2,ini = ini)
  return(xx)
})


sim<- unlist(lapply(L,nrow))
hist(sim,breaks=100)
quantile(sim,c(0.025,0.5,0.975))

df<- L[[18]]
midx<- matrix(c(df$row,df$col),nrow = nrow(df))
df1=df%>%mutate(t_up=t_i,age=age-1,row=row-1,col=col-1,leaf=3,t_e=t_e,t_i=t_i,t_r=t_r)%>%
  dplyr::select(k,coor_x,coor_y,t_e,t_i,t_r,t_up,leaf,age,typ,infected_source,row, col)
df1$dens<- pop_grid[midx]
write.table(df1,"/run/user/1000/gvfs/sftp:host=login-cpu.hpc.cam.ac.uk/home/ha411/big_space/BBTV/Newrybar_partial/Simulation/Dout",row.names = FALSE)

df1<- read.table("/run/user/1000/gvfs/sftp:host=login-cpu.hpc.cam.ac.uk/home/ha411/big_space/BBTV/Newrybar_partial/Simulation/Dout",fill = T,header = T)
df1<- df1%>%mutate(t_e=365*t_e,t_i=365*t_i,t_r=365*t_r,t_up=365*t_up)


## End(Not run)