R/AUX_prob_opt.R

Defines functions prob_opt

#This function uses the best (in terms of time/precision) function from the packages above depending of the dimension of the vector,
#degrees of freedom and even if one method collapses

prob_opt = function(lower = rep(-Inf,ncol(sigma)),upper = rep(Inf,ncol(sigma)),mean = rep(0,ncol(sigma)),sigma,nu = NULL,uselog2 = FALSE){
  mean = c(mean)
  sigma = as.matrix(sigma)
  p = ncol(sigma)
  if(is.null(nu)){
    #normal case
    if(p < 10){

      prob = pmvnorm(lower = lower,upper = upper,mean = mean,sigma = sigma)[1]

      if(prob < 0){

        return(pmvn.genz(lower = lower,upper = upper,mean = mean,sigma = sigma,uselog2 = uselog2)[[1]])

      }else{

        return(ifelse(uselog2,log2(prob),prob))
      }
    }else{

      return(pmvn.genz(lower = lower,upper = upper,mean = mean,sigma = sigma,uselog2 = uselog2)[[1]])

    }
  }else{
    #student t case
    if(p < 10 & nu%%1 == 0){
      lower = lower - mean
      upper = upper - mean

      prob = mvtnorm::pmvt(lower = lower,upper = upper,sigma = sigma,df = nu)[1]

      if(prob < 0){

        return(pmvt.genz(lower = lower,upper = upper,sigma = sigma,nu = nu,uselog2 = uselog2)[[1]])

      }else{

        return(ifelse(uselog2,log2(prob),prob))
      }

    }else{
      return(pmvt.genz(lower = lower,upper = upper,mean = mean,sigma = sigma,nu = nu,uselog2 = uselog2)[[1]])
    }
  }
}

Try the CensMFM package in your browser

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

CensMFM documentation built on Feb. 16, 2023, 9:08 p.m.