R/simInfl.R

Defines functions simInfl

Documented in simInfl

simInfl <- function(
  x = 1:10, 
  slope = 0.02, 
  error = 0.05, 
  nrev = 1000, 
  ...)
{
  ## counter function
  counter <- function (i) 
  {
    if (i%%10 == 0) 
      cat(i)
    else cat(".")
    if (i%%50 == 0) 
      cat("\n")
    flush.console()
  }
  
  ## create combinations and result grid
  GRID <- expand.grid(1:nrev, slope, error)
  colnames(GRID) <- c("nrev", "slope", "error")
  MAT <- matrix(NA, nrow = nrow(GRID), ncol = 19)
  
  ## initialize loop counter & reversal counter
  seeds <- 1
  i <- 1
  isRev <- 1
  
  ## preallocate result vectors
  seedVec <- pVec <- rep(NA, nrev)
  mList <- vector("list", length = nrev)
  
  ## loop until isRev = nrev
  while (isRev <= nrev) {
    ## create exact model 
    LME <- lmExact(x = x, slope = GRID[i, 2], error = GRID[i, 3], 
                   plot = FALSE, seed = seeds, verbose = FALSE, ...)
    ## get reversal results
    RES <- lmInfl(LME$lm, verbose = FALSE, ...)
    
    ## if reversal, populate result matrix and increase counters
    if (!is.null(RES$sel)) {
      counter(isRev)
      seedVec[i] <- seeds
      pVec[i] <- RES$origP
      MAT[i, ] <- as.numeric(RES$infl[RES$sel[1], ])
      mList[[i]] <- LME$lm
      isRev <- isRev + 1
      i <- i + 1
    }
    seeds <- seeds + 1
  }
  
  ## create result list
  colnames(MAT) <- colnames(RES$infl)
  OUT <- list(models = mList, mat = cbind(GRID, seed = seedVec, origP = pVec, MAT))
  return(OUT)
}
anspiess/reverseR documentation built on June 23, 2018, 2:22 a.m.