
Baseline data simulation
Beatriz Valcarcel
2022-04-20
Source:vignettes/baseline_data_simulation.Rmd
baseline_data_simulation.Rmd
library(ggplot2)
library(data.table)
library(magrittr)
library(surveillance)
#> Loading required package: sp
#> Loading required package: xtable
#> This is surveillance 1.21.0; see 'package?surveillance' or
#> https://surveillance.R-Forge.R-project.org/ for an overview.
#>
#> Attaching package: 'surveillance'
#> The following object is masked from 'package:data.table':
#>
#> year
Simulate 16 baselines
Simulation of 16 different time series of count data. Parameter values for data simulation are presented in Noufaily et al. (2019), table 1.
Each of the simulatation take into account a combination of differents properties of syndromic data such as:
- Baseline frequencies of reports (determined by parameter alpha)
- Linear trends (determined by parameterbeta)
- Seasonal trends (determined by parameters gamma_1 and gamma_2),
- Day-of-the week effects (determined by parameters gamma_3 and gamma_4)
- Over dispersion (determined by parameter phi).
baseline_1 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 2,
alpha = 6,
beta = 0,
gamma_1 = 0.2,
gamma_2 = 0.2,
gamma_3 = 0.5,
gamma_4 = 0.4,
phi = 2,
shift_1 = 29
)
baseline_1[,s:=1]
baseline_2 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 2,
alpha = 0.5,
beta = 0,
gamma_1 = 1.5,
gamma_2 = 1.4,
gamma_3 = 0.5,
gamma_4 = 0.4,
phi = 1,
shift_1 = -167
)
baseline_2[,s:=2]
baseline_3 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 0,
weekly_pattern_n = 2,
alpha = 5.5,
beta = 0,
gamma_1 = 0,
gamma_2 = 0,
gamma_3 = 0.3,
gamma_4 = 0.25,
phi = 1,
shift_1 = 1
)
baseline_3[,s:=3]
baseline_4 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 0,
weekly_pattern_n = 2,
alpha = 0,
beta = 0,
gamma_1 = 0,
gamma_2 = 0,
gamma_3 = 0.3,
gamma_4 = 0.25,
phi = 1,
shift_1 = 1
)
baseline_4[,s:=4]
baseline_5 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 2,
alpha = 6,
beta = 0,
gamma_1 = 0.3,
gamma_2 = 2,
gamma_3 = 0.3,
gamma_4 = 0.5,
phi = 1.5,
shift_1 = -50
)
baseline_5[,s:=5]
baseline_6 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 1,
alpha = 1,
beta = 0,
gamma_1 = 0.1,
gamma_2 = 2,
gamma_3 = 0.05,
gamma_4 = 0.05,
phi = 1,
shift_1 = -50
)
baseline_6[,s:=6]
baseline_7 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 0,
weekly_pattern_n = 1,
alpha = 6,
beta = 0.0001,
gamma_1 = 0,
gamma_2 = 0,
gamma_3 = 0.6,
gamma_4 = 0.9,
phi = 1.5,
shift_1 = 0
)
baseline_7[,s:=7]
baseline_8 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 1,
alpha = 3,
beta = 0,
gamma_1 = 1.5,
gamma_2 = 0.1,
gamma_3 = 0.2,
gamma_4 = 0.3,
phi = 1,
shift_1 = -150 )
baseline_8[,s:=8]
baseline_9 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 1,
alpha = 3,
beta = 0,
gamma_1 = 0.2,
gamma_2 = 0.1,
gamma_3 = 0.05,
gamma_4 = 0.15,
phi = 1,
shift_1 = -200
)
baseline_9[,s:=9]
baseline_10 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 1,
alpha = 5,
beta = 0,
gamma_1 = 0.2,
gamma_2 = 0.1,
gamma_3 = 0.05,
gamma_4 = 0.1,
phi = 1,
shift_1 = 0
)
baseline_10[,s:=10]
baseline_11 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 2,
weekly_pattern_n = 1,
alpha = 0.5,
beta = 0,
gamma_1 = 0.4,
gamma_2 = 0,
gamma_3 = 0.05,
gamma_4 = 0.15,
phi = 1,
shift_1 = 0
)
baseline_11[,s:=11]
baseline_12 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 2,
weekly_pattern_n = 1,
alpha = 9,
beta = 0,
gamma_1 = 0.5,
gamma_2 = 0.2,
gamma_3 = 0.2,
gamma_4 = 0.4,
phi = 4,
shift_1 = 57
)
baseline_12[,s:=12]
baseline_13 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 2,
weekly_pattern_n = 1,
alpha = 2,
beta = 0.0005,
gamma_1 = 0.8,
gamma_2 = 0.8,
gamma_3 = 0.8,
gamma_4 = 0.4,
phi = 4,
shift_1 = 57
)
baseline_13[,s:=13]
baseline_14 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 4,
alpha = 0.05,
beta = 0,
gamma_1 = 0.01,
gamma_2 = 0.01,
gamma_3 = 1.8,
gamma_4 = 0.1,
phi = 1,
shift_1 = -85
)
baseline_14[,s:=14]
baseline_15 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 1,
weekly_pattern_n = 2,
alpha = 3,
beta = 0,
gamma_1 = 0.8,
gamma_2 = 0.6,
gamma_3 = 0.8,
gamma_4 = 0.4,
phi = 4,
shift_1 = 29)
baseline_15[,s:=15]
baseline_16 <- csalert::simulate_baseline_data(
start_date = as.Date("2012-01-01"),
end_date = as.Date("2019-12-31"),
seasonal_pattern_n = 0,
weekly_pattern_n = 2,
alpha = 6,
beta = 0,
gamma_1 = 0,
gamma_2 = 0,
gamma_3 = 0.8,
gamma_4 = 0.4,
phi = 4,
shift_1 = 1
)
baseline_16[,s:=16]
baseline <- rbind(baseline_1,
baseline_2,
baseline_3,
baseline_4,
baseline_5,
baseline_6,
baseline_7,
baseline_8,
baseline_9,
baseline_10,
baseline_11,
baseline_12,
baseline_13,
baseline_14,
baseline_15,
baseline_16)
baseline[, label:=paste("Sim", s, sep=" ")]
q <- ggplot(baseline, aes(x = date, y = n))
q <- q + geom_line(lwd = 1)
q <- q + facet_wrap(~s, scales = "free")
q <- q + csstyle::scale_fill_cs(palette = "posneg")
q <- q + csstyle::theme_cs(legend_position = "bottom")
q
Weekly patterns
q <- ggplot(baseline, aes(wday, n, group=wday))
q <- q + facet_wrap(~s, scales = "free")
q <- q + geom_boxplot()
q
Monthly patterns
q <- ggplot(baseline, aes(wday, n, group=calmonth))
q <- q + facet_wrap(~s, scales = "free")
q <- q + geom_boxplot()
q