R/prod2COP.R

In wasquith/copBasic: General Bivariate Copula Theory and Many Utility Functions

"prod2COP" <-
function(u,v, cop1=NULL, para1=NULL, cop2=NULL, para2=NULL,
              para=NULL, pinterval=NULL, ...) {

   if(! is.null(para)) {
      cop1  <- para$cop1;    cop2  <- para$cop2
      para1 <- para$para1;   para2 <- para$para2
      if(exists("pinterval", para)) pinterval <- get("pinterval", para)
   }

   if(is.null(cop1)) {
        warning("must have first copula specified, returning NULL")
        return(NULL)
   }
   if(is.null(cop2)) {
        warning("must have second copula specified, returning NULL")
        return(NULL)
   }

   if(length(u) > 1 & length(v) > 1 & length(u) != length(v)) {
      warning("length u = ", length(u), " and length v = ", length(v))
      warning("longer object length is not a multiple of shorter object length, no recycling")
      return(NA)
   }
   if(length(u) == 1) {
      u <- rep(u, length(v))
   }
   else if(length(v) == 1) {
      v <- rep(v, length(u))
   }

   # d/du derCOP and d/dv derCOP2  (Nelsen, 2006, eq. 6.4.2)
   "afunc" <- function(t, U=NA, V=NA, ...) derCOP( t,V, cop=cop2, para=para2, ...) *
                                           derCOP2(U,t, cop=cop1, para=para1, ...)
   lo <- 0; hi <- 1
   if(! is.null(pinterval)) { lo <- pinterval[1]; hi <- pinterval[2] }
   return(sapply(1:length(u), function(i) integrate(afunc, lo,hi, U=u[i], V=v[i],
                           cop1=cop1, cop2=cop2, para1=para1, para2=para2, ...)$value))
}