R/sim_score_data.R

In holland: Statistics for Holland's Theory of Vocational Choice

#' @title Simulation of multivariate score data
#' @keywords misc
#' @export sim_score_data
#' @description This function will simulate Person (raw)-scores for an arbitrary number of dimensions (latent variables), assessed with any type of questionnaire given the maximum and minimum raw score for each dimension.  
#' @details For Hollnd's theory, six dimensions (\code{c("R","I","A","S","E","C")}) are assumed being assessed with an questionnaire with 10 questions per dimension with each question having five response categories which are scored from '0' to '4' -- thus min. raw score is 0 and max. rax score is 40 for each of the six dimension respectively. 
#' @param n integer giving the number of cases (observations) in the data to simulate.
#' @param cormat a correlation matrix describing the associations between the dimensions -- for Hollnd's theory, typical a 6 x 6 matrix with named columns and rows with \code{c("R","I","A","S","E","C")}. 
#' @param min.score numeric (possibly vector with max length == ncol(cormat) -- will be recycled) with numeric value(s) defining the minimum raw scores per dimension
#' @param max.score numeric (possibly vector with max length == ncol(cormat) -- will be recycled) with numeric value(s) defining the maximum raw scores per dimension.
#' @param data.frame logical whether to return a \code{data.frame} or a \code{matrix}
#' @param ... additional parameters passed through to \code{\link{rmvnorm}}.
#' @return a \code{data.frame} with simulated raw scores.
#' @examples
#' # get an RIASEC correlation matrix
#' data(AIST_2005_F_1270)
#' # simulate raw scores with minimum = 0 and maximum = 40
#' a<-sim_score_data(n=1000,cormat=AIST_2005_F_1270)
#' apply(a, 2, range)
#' apply(a, 2, mean)
#' apply(a, 2, sd)
#' # simulate raw scores with minimum = 10 and maximum = 50
#' b<-sim_score_data(n=1000,cormat=AIST_2005_F_1270,min.score=10,max.score=50)
#' apply(b, 2, range)
#' apply(b, 2, mean)
#' apply(b, 2, sd)
#' # simulate norm scores (range between 70 and 130)
#' c<-sim_score_data(n=1000,cormat=AIST_2005_M_1226,min.score=70,max.score=130)
#' apply(c, 2, range)
#' apply(c, 2, mean)
#' apply(c, 2, sd)

############## funktions beginn ####
# func. by: jhheine@googlemail.com 
sim_score_data <- function(n = 1000, cormat , min.score = 0, max.score = 40, data.frame=FALSE, ...) 
{
  if(ncol(cormat)!=nrow(cormat)){stop("non-symmetrical correlation matrix")}
  nam <- paste("dim",1:ncol(cormat),sep = ".")
  if(!is.null(colnames(cormat))){  nam <- colnames(cormat)}
  if(!is.null(rownames(cormat))){  nam <- rownames(cormat)}
  erg1 <- as.list(as.data.frame(rmvnorm(n = n, sigma = cormat, ...)))# , ...
  names(erg1) <- nam
  
  min.score <- rep(min.score,length.out=ncol(cormat))# recycling of r
  max.score <- rep(max.score,length.out=ncol(cormat))# recycling of r
  
  erg2 <- mapply(function(z,mini,maxi){ ((as.numeric(cut(z, breaks = (maxi-mini)+1)))-1)+mini}, z=erg1, mini=min.score, maxi=max.score ,SIMPLIFY = FALSE)
  
  if(data.frame){erg3 <- as.data.frame(erg2,stringsAsFactors = FALSE)}
  if(!data.frame){erg3 <- as.matrix(as.data.frame(erg2,stringsAsFactors = FALSE))}
  # describe(erg3)
  return(erg3)
}
# ende der funktion