# ------------------------------------------------------------------------ #
# Generate data following the AdjPIN model using generatedata_adjpin() #
# ------------------------------------------------------------------------ #
# With no arguments, the function generates one dataset object spanning
# 60 days, and where the parameters are chosen as described in the section
# 'Details'.
sdata <- generatedata_adjpin()
# Alternatively, simulation parameters can be provided. Recall the order of
# parameters (alpha, delta, theta, theta', eps.b, eps.s, mub, mus, db, ds).
givenpoint <- c(0.4, 0.1, 0.5, 0.6, 800, 1000, 2300, 4000, 500, 500)
sdata <- generatedata_adjpin(parameters = givenpoint)
# Data can be generated following restricted AdjPIN models, for example, with
# restrictions 'eps.b = eps.s', and 'mu.b = mu.s'.
sdata <- generatedata_adjpin(restricted = list(eps = TRUE, mu = TRUE))
# Data can be generated using provided ranges of simulation parameters as fed
# to the function using the argument 'ranges', where thetap corresponds to
# theta'.
sdata <- generatedata_adjpin(ranges = list(
alpha = c(0.1, 0.15), delta = c(0.2, 0.2),
theta = c(0.2, 0.6), thetap = c(0.2, 0.4)
))
# The value of a given simulation parameter can be set to a specific value by
# setting the range of the desired parameter takes a unique value, instead of
# a pair of values.
sdata <- generatedata_adjpin(ranges = list(
alpha = 0.4, delta = c(0.2, 0.7),
eps.b = c(100, 7000), mu.b = 8000
))
# Display the details of the generated simulation data
show(sdata)
# ------------------------------------------------------------------------ #
# Use generatedata_adjpin() to check the accuracy of adjpin() #
# ------------------------------------------------------------------------ #
model <- adjpin(sdata@data, verbose = FALSE)
summary <- cbind(
c(sdata@emp.pin['adjpin'], model@adjpin, abs(model@adjpin -
sdata@emp.pin['adjpin'])),
c(sdata@emp.pin['psos'], model@psos, abs(model@psos -
sdata@emp.pin['psos']))
)
colnames(summary) <- c('adjpin', 'psos')
rownames(summary) <- c('Data', 'Model', 'Difference')
show(knitr::kable(summary, 'simple'))
Run the code above in your browser using DataLab