R/blatentSimulate.R

In jonathantemplin/blatent: Bayesian Latent Variable Models

#' @title Simulates data using blatent syntax and simulated parameters input
#'
#' @description Simulates data from a model specified by blatent syntax and using a set of default parameter specifications.
#'
#' @param modelText A character string that contains the specifications for the model to be run. See \code{\link{blatentSyntax}}
#'                  or more information about syntax formatting.
#'
#' @param nObs The number of observations to be simulated.
#'
#' @param defaultSimulatedParameters The specifications for the generation of the types of parameters in the simulation. Currently comprised
#' of a list of unevaluated expressions (encapsulated in quotation marks; not calls for ease of user input) that will be evaluated by
#' simulation function to generate parameters. Defaults to values generated by \code{\link{setDefaultSimulatedParameters}}.
#' The list of unevaluated expressions must include:
#' \itemize{
#'   \item \code{observedIntercepts} The data generating function for all intercepts for observed variables.
#'   \item \code{observedMainEffects} The data generating function for the main effects for observed variables.
#'   \item \code{observedInteractions} The data generating function for all interactions for observed variables.
#'   \item \code{latentIntercepts} The data generating function for all intercepts for latent variables.
#'   \item \code{latentMainEffects} The data generating function for the main effects for latent variables.
#'   \item \code{latentInteractions} The data generating function for all interactions for latent variables.
#' }
#'
#' @param paramVals A named vector of parameter values which will be set rather than generated. A named vector of the length parameters of an analysis
#' can be obtained by using \code{\link{createParameterVector}}. The NA values of this vector can be overwritten by values to be used in the
#' simulation.
#'
#' @param seed The random number seed value used for setting the data. Defaults to \code{NULL}.
#'
#' @param calculateInfo A logical variable where \code{TRUE} indicates information statistics will be calculated (only when a single latent
#' multivariate Bernoulli variable is in the model) and \code{FALSE} disables calculation.
#'
#' @examples
#'
#' # Generating data using Q-matrix structure from data example in Chapter 9 of
#' #  Rupp, Templin, & Henson (2010).
#'
#' RTHCh9ModelSyntax = "
#'    item1 ~ A1
#'    item2 ~ A2
#'    item3 ~ A3
#'    item4 ~ A1 + A2 + A1:A2
#'    item5 ~ A1 + A3 + A1:A3
#'    item6 ~ A2 + A3 + A2:A3
#'    item7 ~ A1 + A2 + A3 + A1:A2 + A1:A3 + A2:A3 + A1:A2:A3
#'
#'    # Latent Variable Specifications:
#'  A1 A2 A3 <- latent(unit='rows',distribution='bernoulli',structure='univariate',type='ordinal')
#'
#'    # Observed Variable Specifications:
#'    item1-item7 <- observed(distribution = 'bernoulli', link = 'probit')
#' "
#'
#' simSpecs = setDefaultSimulatedParameters(
#'    observedIntercepts = "runif(n = 1, min = -1, max = -1)",
#'    observedMainEffects = "runif(n = 1, min = 2, max = 2)",
#'    observedInteractions = "runif(n = 1, min = 0, max = 0)",
#'    latentIntercepts = "runif(n = 1, min = 0, max = 0)",
#'    latentMainEffects  = "runif(n = 1, min = 0, max = 0)",
#'    latentInteractions = "runif(n = 1, min = 0, max = 0)"
#'  )
#'
#' simulatedData = blatentSimulate(modelText = RTHCh9ModelSyntax, nObs = 1000,
#'                                 defaultSimulatedParameters = simSpecs)
#'
#' # setting values for specific parameters:
#' paramVals = createParameterVector(modelText = RTHCh9ModelSyntax)
#' paramVals["item1.(Intercept)"] = -2
#'
#' # creating data
#' simulatedData2 = blatentSimulate(modelText = RTHCh9ModelSyntax, nObs = 1000,
#'                                  defaultSimulatedParameters = simSpecs, paramVals = paramVals)
#'
#' @references Rupp, A. A., Templin, J., & Henson, R. A. (2010). Diagnostic Measurement: Theory, Methods, and Applications. New York: Guilford.
#'
#' @export
blatentSimulate = function(modelText,
                           nObs,
                           defaultSimulatedParameters = setDefaultSimulatedParameters(),
                           paramVals = NULL,
                           seed = NULL,
                           calculateInfo = FALSE) {

  # mirror blatentEstimate function to gain objects with distributions to use:

  # need options for other parts
  options = blatentControl(seed = seed)

  # intialize blatent specs--some will be invalid as blatentControl is for MCMC specs and dataMat does not exist yet
  specs = initializeSpecs(modelText = modelText, dataMat = data.frame(matrix(data = NA, nrow = nObs, ncol = 1)), options = options)

  # add defaultSimulatedParameters to specs
  specs$defaultSimulatedParameters = defaultSimulatedParameters

  # build better temporary data frame:
  data = data.frame(matrix(data = 1, nrow = nObs, ncol = length(specs$allVariables)))
  names(data) = specs$allVariables

  # create variables objects:
  variables = lapply(
    X = 1:length(specs$modelVector),
    FUN = createVariable,
    specs = specs,
    data = data,
    options = options
  )

  names(variables) = unlist(lapply(X = variables, FUN = function(x) return(x$variableName)))

  # set the random seed
  set.seed(seed = seed)
  seed = .Random.seed

  # generate parameter values
  temp = lapply(X = variables, FUN = function(x) {x$simulateParameters(); return(NULL)})

  # overwrite generated values if any parameters have been input into paramVals
  if (any(!is.na(paramVals))) {
    variables = lapply(
      X = variables,
      FUN = function(x, paramValsNum, data) {
        temp = x$provideParameterTypesAndLocations(data = data)
        if (any(temp$paramNames %in% names(paramValsNum))){
          inParams = temp$paramNames[which(temp$paramNames %in% names(paramValsNum))]
          for (param in 1:length(inParams)){
            eval(parse(text = paste0(
              temp$paramLocation[which(temp$paramNames == inParams[param])],
              "=",
              as.character(paramValsNum[which(names(paramValsNum) == inParams[param])])
            )))

          }
        }
        return(x)
      },
      paramValsNum = paramVals[which(!is.na(paramVals))],
      data = data
    )
  }

  trueValues = lapply(X = variables, FUN = function(x) return(x$provideParameterValues()))
  names(trueValues) = names(variables)

  # using a loop as order of variables matters and may not be maintained in vapply or lapply
  for (var in 1:length(specs$predOrder)){
    data[variables[[specs$predOrder[var]]]$allDrawnVariables] =
      variables[[specs$predOrder[var]]]$simulateUnits(
        data = data
      )
  }


  simOutput = blatentSimulatedData$new(nObs = nObs, simModel = modelText, defaultSimulatedParameters = defaultSimulatedParameters,
                                       seed = seed, data = data, trueValues = trueValues, variables = variables, specs = specs)


  if (calculateInfo){
    temp = simOutput$calculateInformationStatistics()
  }


  return(simOutput)

}