R/createSimulatedCodeSet.R

In rhoR: Rho for Inter Rater Reliability

###
#' @title Create Simulated codeSet
#' 
#' @description
#' Creates a simulated \code{\link{codeSet}} with the given parameters
#' 
#' @param length the length of the simulated \code{\link{codeSet}} to be created
#' @param baserate the \code{\link{baserate}} of the simulated \code{\link{codeSet}}
#' @param kappaMin the minimum kappa of the simulated \code{\link{codeSet}}
#' @param kappaMax the maximum kappa of the simulated \code{\link{codeSet}}
#' @param precisionMin the minimum precision of the simulated \code{\link{codeSet}}
#' @param precisionMax the maximum precision of the simulated \code{\link{codeSet}}
#' @param ... Parameters passed to createRandomSet (e.g. type = "set" or type = "ct")
#' @param tries the maximum number of tries to generate a valid set, smaller set lengths may require an increased number of tries
#' 
#' @details
#' \code{\link{codeSet}}s are generated by first picking a random kappa within its range and a random precision within its range.  If the random kappa, random precision, and baserate are not mathematically possible, then the precision is resampled from a range of mathematically possible values within its range.  A unique simulated \code{\link{codeSet}} is then constructed given these parameters.
#' 
#' @export
#' @return A \code{\link{codeSet}} that fulfills the given parameters
###
createSimulatedCodeSet = function(length, baserate, kappaMin, kappaMax, precisionMin, precisionMax, ..., tries = 50){
  if(length <= 0){stop("length must be positive")}
  if(baserate < 0){stop("baserate must be positive")}
  if(kappaMin < 0 | kappaMin > 1) stop("kappaMin must be between 0 and 1.")
  if(kappaMax < 0 | kappaMax > 1) stop("kappaMax must be between 0 and 1.")
  if(kappaMin > kappaMax){stop("kappaMin must be less than kappaMax")}
  if(precisionMin < 0 | precisionMin > 1) stop("precisionMin must be between 0 and 1.")
  if(precisionMax < 0 | precisionMax > 1) stop("precisionMax must be between 0 and 1.")
  if(precisionMin > precisionMax){stop("precisionMin must be less than precisionMax")}
  if(tries < 1){stop("tries must be greater than 1")}
  
  setFound = NULL
  validSet = F
  triesLeft = tries
  Ks = c()
  while(!validSet && triesLeft > 0) {
    set = createRandomSet(setLength = length, baserate = baserate, kappaMin = kappaMin, kappaMax = kappaMax, minPrecision = precisionMin, maxPrecision = precisionMax)
    k = kappa(set)
    
    if ((k > kappaMin && k < kappaMax) || any_equal(k, c(kappaMin, kappaMax))) {
      setFound = set
      validSet = T
    }
    
    Ks = c(Ks, k)
    triesLeft = triesLeft - 1
  }
  
  if (is.null(setFound)) {
    Ks_under_min <- Ks[which(Ks < kappaMin)]
    Kdist.to.min <- kappaMin - Ks_under_min
    Kdist.to.min.low <- ifelse(length(Ks_under_min) > 0, min(Kdist.to.min), NA)
    
    Ks_over_min  <- Ks[which(Ks > kappaMax)]
    Kdist.to.max <- Ks_over_min - kappaMax
    Kdist.to.max.low <- ifelse(length(Ks_over_min) > 0, min(Kdist.to.max), NA)
    
    Kdist.all_mins <- c(Kdist.to.min, Kdist.to.max)
    
    both_mins <- c(Kdist.to.min.low, Kdist.to.max.low)
    both_mins <- both_mins[!is.na(both_mins)]
    closest <- c(Ks_under_min, Ks_over_min) [which(Kdist.all_mins == min(both_mins))][1]
    
    stop(paste0(
      "Unable to create a set of the provided length (", length, ") ",
        "in the provided kappa range (", kappaMin, "\U2014", kappaMax, "). ",
        "The closest kappa obtained after ", tries, " tries was: ", 
        round(x = closest, digits = 5), "\n",
        "\tTry increasing the set length or the range of valid kappas"
    ))
  }
  
  return(setFound)
  
  # return(createRandomSet(setLength = length, baserate = baserate, kappaMin = kappaMin, kappaMax = kappaMax, minPrecision = precisionMin, maxPrecision = precisionMax, ...))
}