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