# ------------------------------------------------------------------------ #
# There are different scenarios of using the function generatedata_mpin() #
# ------------------------------------------------------------------------ #
# With no arguments, the function generates one dataset object spanning
# 60 days, containing a number of information layers uniformly selected
# from `{1, 2, 3, 4, 5}`, and where the parameters are chosen as
# described in the details.
sdata <- generatedata_mpin()
# The number of layers can be deduced from the simulation parameters, if
# fed directly to the function generatedata_mpin() through the argument
# 'parameters'. In this case, the output is a dataset object with one
# information layer.
givenpoint <- c(0.4, 0.1, 800, 300, 200)
sdata <- generatedata_mpin(parameters = givenpoint)
# The number of layers can alternatively be set directly through the
# argument 'layers'.
sdata <- generatedata_mpin(layers = 2)
# The simulation parameters can be randomly drawn from their corresponding
# ranges fed through the argument 'ranges'.
sdata <- generatedata_mpin(ranges = list(alpha = c(0.1, 0.7),
delta = c(0.2, 0.7),
mu = c(3000, 5000)))
# 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_mpin(ranges = list(alpha = 0.4, delta = c(0.2, 0.7),
eps.b = c(100, 7000),
mu = c(8000, 12000)))
# If both arguments 'parameters', and 'layers' are simultaneously provided,
# and the number of layers detected from the length of the argument
# 'parameters' is different from the argument 'layers', the former is used
# and a warning is displayed.
sim.params <- c(0.4, 0.2, 0.9, 0.1, 400, 700, 300, 200)
sdata <- generatedata_mpin(days = 120, layers = 3, parameters = sim.params)
# Display the details of the generated data
show(sdata)
# \donttest{
# ------------------------------------------------------------------------ #
# Use generatedata_mpin() to compare the accuracy of estimation methods #
# ------------------------------------------------------------------------ #
# The example below illustrates the use of the function 'generatedata_mpin()'
# to compare the accuracy of the functions 'mpin_ml()', and 'mpin_ecm()'.
# The example will depend on three variables:
# n: the number of datasets used
# l: the number of layers in each simulated datasets
# xc : the number of extra clusters used in initials_mpin
# For consideration of speed, we will set n = 2, l = 2, and xc = 2
# These numbers can change to fit the user's preferences
n <- l <- xc <- 2
# We start by generating n datasets simulated according to the
# assumptions of the MPIN model.
dataseries <- generatedata_mpin(series = n, layers = l, verbose = FALSE)
# Store the estimates in two different lists: 'mllist', and 'ecmlist'
mllist <- lapply(dataseries@datasets, function(x)
mpin_ml(x@data, xtraclusters = xc, layers = l, verbose = FALSE))
ecmlist <- lapply(dataseries@datasets, function(x)
mpin_ecm(x@data, xtraclusters = xc, layers = l, verbose = FALSE))
# For each estimate, we calculate the absolute difference between the
# estimated mpin, and empirical mpin computed using dataset parameters.
# The absolute differences are stored in 'mldmpin' ('ecmdpin') for the
# ML (ECM) method,
mldpin <- sapply(1:n,
function(x) abs(mllist[[x]]@mpin - dataseries@datasets[[x]]@emp.pin))
ecmdpin <- sapply(1:n,
function(x) abs(ecmlist[[x]]@mpin - dataseries@datasets[[x]]@emp.pin))
# Similarly, we obtain vectors of running times for both estimation methods.
# They are stored in 'mltime' ('ecmtime') for the ML (ECM) method.
mltime <- sapply(mllist, function(x) x@runningtime)
ecmtime <- sapply(ecmlist, function(x) x@runningtime)
# Finally, we calculate the average absolute deviation from empirical PIN
# as well as the average running time for both methods. This allows us to
# compare them in terms of accuracy, and speed.
accuracy <- c(mean(mldpin), mean(ecmdpin))
timing <- c(mean(mltime), mean(ecmtime))
comparison <- as.data.frame(rbind(accuracy, timing))
colnames(comparison) <- c("ML", "ECM")
rownames(comparison) <- c("Accuracy", "Timing")
show(round(comparison, 6))
# }
Run the code above in your browser using DataLab