1## Calculate Kendall's tau and Spearman's rho for 2-D copula density estimate 2summary.sscopu <- function(object,...) 3{ 4 ## Check input 5 if (class(object)!="sscopu") stop("gss error in summary.sscopu: not a sscopu object") 6 if (dim(object$mdsty)[2]!=2) stop("gss error in summary.sscopu: not a 2-D copula") 7 ## Set up quadrature 8 hsz <- 40 9 qdsz <- 2*hsz 10 qd <- gauss.quad(qdsz,c(0,1)) 11 gap <- diff(qd$pt) 12 g.wk <- gap[hsz]/2 13 for (i in 1:(hsz-2)) g.wk <- c(g.wk,gap[hsz+i]-g.wk[i]) 14 g.wk <- 2*g.wk 15 pp <- qd$pt[1]/(1/2-sum(g.wk)) 16 adj <- c(pp,rep(.5,qdsz-2),1-pp) 17 qd.pt <- cbind(rep(qd$pt,qdsz),rep(qd$pt,rep(qdsz,qdsz))) 18 ## Calculate cdf 19 d.qd <- dsscopu(object,qd.pt) 20 d.qd.wk <- matrix(d.qd,qdsz,qdsz) 21 f.qd <- NULL 22 for (i in 1:qdsz) { 23 for (j in 1:qdsz) { 24 wt1 <- qd$wt[1:i] 25 wt1[i] <- wt1[i]*adj[i] 26 wt2 <- qd$wt[1:j] 27 wt2[j] <- wt2[j]*adj[j] 28 f.qd <- c(f.qd,sum(d.qd.wk[1:i,1:j]*outer(wt1,wt2))) 29 } 30 } 31 ## Calculate tau and rho 32 tau <- 4*sum(f.qd*d.qd*outer(qd$wt,qd$wt))-1 33 rho <- 12*sum(d.qd*outer(qd$pt*qd$wt,qd$pt*qd$wt))-3 34 ## return 35 list(tau=tau,rho=rho) 36} 37