R/rDiscrete.R

Defines functions rDiscrete

Documented in rDiscrete

rDiscrete <-
function(n=1,pf){
    min.pf = min(pf)
    max.pf = max(pf)
    min.n = min(n)
    if ((sum(is.finite(pf)) < length(pf)) | (is.null(pf) == TRUE) | (min.pf < 0) | (max.pf > 1) | (round(sum(pf))!=1)){
       stop("Sum of probabilities is not equal to one! Please enter a probability function.")
    }
    if (any(is.finite(n)==FALSE) | any(is.null(n)==TRUE) | (min.n < 0) | (length(n)!=1) ){
      stop("Number of observations must be entered as a finite and positive scalar!")
    }
    
    cdf.initial=t(cumsum(pf))
    r=0
    r=runif(n,0,1)
    cdf=cbind(0,cdf.initial)
    names=array("",(length(cdf.initial)+1))
    rDiscrete=0
    for (i in 1:n){
      for (j in 2:(length(cdf)+1)){
        if ((r[i]>cdf[j-1]) & (r[i]<=cdf[j])){
          rDiscrete[i]=j-1
        }
      }
    }
    cdf.initial=as.array(c(0,cdf.initial))
    list(rDiscrete=rDiscrete,cdf=cdf.initial)
}

Try the rTableICC package in your browser

Any scripts or data that you put into this service are public.

rTableICC documentation built on Aug. 21, 2023, 9:09 a.m.