The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
First, let’s fix some parameters.
For the marginals, we will use location scale transformed Student distributions.
rtls <- function(n, df, mu, sigma) sigma * rt(n,df) + mu
ptls <- function(x, df, mu, sigma) pt((x - mu)/sigma,df)
qtls <- function(u, df, mu, sigma) sigma * qt(u,df) + mu
dtls <- function(u, df, mu, sigma) dt((x - mu)/sigma,df)/sigma
Let’s generate some data.
rclayton <- function(n, alpha) {
u <- runif(n+1) # innovations
v <- u
for(i in 2:(n+1))
v[i] <- ((u[i]^(-alpha/(1+alpha)) -1)*v[i-1]^(-alpha) +1)^(-1/alpha)
v[2:(n+1)]
}
n <- 200
u <- rclayton(n, alpha = alpha)
u <- qtls(u, df=df, mu=mu, sigma=sigma)
y <- u[-n]
x <- u[-1]
We now estimate the parameters under known marginals
## Call: fitCopula(claytonCopula(dim = 2), data = cbind(ptls(x, df, mu,
## sigma), ptls(y, df, mu, sigma)))
## Fit based on "maximum pseudo-likelihood" and 199 2-dimensional observations.
## Copula: claytonCopula
## alpha
## 11.08
## The maximized loglikelihood is 226.5
## Optimization converged
## Identical margins
M2tlsI <- mvdc(claytonCopula(dim=2), c("tls","tls"),
rep(list(list(df=NA, mu=NA, sigma=NA)), 2), marginsIdentical= TRUE)
(fit.id.mar <- fitMvdc(cbind(x,y), M2tlsI, start=c(3,1,1, 10)))
## Call: fitMvdc(data = cbind(x, y), mvdc = M2tlsI, start = c(3, 1, 1,
## 10))
## Maximum Likelihood estimation based on 199 2-dimensional observations.
## Copula: claytonCopula
## Identical margins:
## m.df m.mu m.sigma
## 3.9098 0.4095 0.7320
## Copula:
## alpha
## 5.938
## The maximized loglikelihood is -338.2
## Optimization converged
## Not necessarily identical margins
M2tls <- mvdc(claytonCopula(dim=2), c("tls","tls"),
rep(list(list(df=NA, mu=NA, sigma=NA)), 2))
fitMvdc(cbind(x,y), M2tls, start=c(3,1,1, 3,1,1, 10))
## Call: fitMvdc(data = cbind(x, y), mvdc = M2tls, start = c(3, 1, 1,
## 3, 1, 1, 10))
## Maximum Likelihood estimation based on 199 2-dimensional observations.
## Copula: claytonCopula
## Margin 1 :
## m1.df m1.mu m1.sigma
## 3.7851 0.4150 0.7288
## Margin 2 :
## m2.df m2.mu m2.sigma
## 4.0760 0.4046 0.7358
## Copula:
## alpha
## 5.944
## The maximized loglikelihood is -338.1
## Optimization converged
u.cond <- function(z, tau, df, mu, sigma, alpha)
((tau^(-alpha/(1+alpha)) -1) * ptls(z,df,mu,sigma)^(-alpha) + 1) ^ (-1/alpha)
y.cond <- function(z, tau, df, mu, sigma, alpha) {
u <- u.cond(z, tau, df, mu, sigma, alpha)
qtls(u, df=df, mu=mu, sigma=sigma)
}
plot(x, y)
title("True and estimated conditional quantile functions")
mtext(quote("for" ~~ tau == (1:5)/6))
z <- seq(min(y),max(y),len = 60)
for(i in 1:5) {
tau <- i/6
lines(z, y.cond(z, tau, df,mu,sigma, alpha))
## and compare with estimate:
b <- fit.id.mar@estimate
lines(z, y.cond(z, tau, df=b[1], mu=b[2], sigma=b[3], alpha=b[4]),
col="red")
}
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.