tau <- 0.5
(theta <- copGumbel@iTau(tau)) # 2
(copG <- onacopulaL("Gumbel", list(theta, 1:5))) # d = 5
set.seed(1)
n <- 1000
x <- rnacopula(n, copG)
x <- qnorm(x) # x now follows a meta-Gumbel model with N(0,1) marginals
u <- pobs(x) # build pseudo-observations
## graphically check if the data comes from a meta-Gumbel model
## with the transformation of Hering and Hofert (2014):
u.h <- htrafo(u, cop=copG) # transform the data
pairs(u.h, gap=0, cex=0.2) # looks good
## with the transformation of Rosenblatt (1952):
u.r <- rtrafo(u, cop=copG) # transform the data
pairs(u.r, gap=0, cex=0.2) # looks good
## what about a meta-Clayton model?
## the parameter is chosen such that Kendall's tau equals (the same) tau
copC <- onacopulaL("Clayton", list(copClayton@iTau(tau), 1:5))
## plot of the transformed data (Hering and Hofert (2014)) to see the
## deviations from uniformity
u.H <- htrafo(u, cop=copC) # transform the data
pairs(u.H, gap=0, cex=0.2) # clearly visible
## plot of the transformed data (Rosenblatt (1952)) to see the
## deviations from uniformity
u.R <- rtrafo(u, cop=copC) # transform the data
pairs(u.R, gap=0, cex=0.2) # clearly visible
## rtrafo() for elliptical:
fN <- fitCopula(normalCopula(dim=ncol(u)), u) # fit a Gauss copula
pairs(rtrafo(u, cop=fN@copula), gap=0, cex=0.2) # visible but not so clearly
if(copula:::doExtras()) {
f.t <- fitCopula(tCopula(dim=ncol(u)), u)
tCop <- f.t@copula
} else {
tCop <- tCopula(param = 0.685, df = 7, dim=ncol(u))
}
u.Rt <- rtrafo(u, cop=tCop) # transform with a fitted t copula
pairs(u.Rt, gap=0, cex=0.2) # *not* clearly visible
stopifnot(all.equal(log(u.R),
rtrafo(u, cop=copC, log=TRUE), tolerance=1e-14),
all.equal(log(rtrafo(u, cop= fN@copula)),
rtrafo(u, cop=fN@copula, log=TRUE), tolerance=1e-14),
all.equal(log(u.Rt),
rtrafo(u, cop=tCop, log=TRUE), tolerance=1e-14),
TRUE)Run the code above in your browser using DataLab