How to fit a copula model in R [heavily revised]. Part 2: fitting the copula（非直译文）

原文地址：

https://www.r-bloggers.com/how-to-fit-a-copula-model-in-r-heavily-revised-part-2-fitting-the-copula/

---

接上文，第二部分是个小案例。

这部分作者要选择一个copula，用测试数据集拟合，评估拟合，从拟合的多元分布中生成随机观测值。另外，这部分还会告诉大家怎么计算Spearman's Rho和Kendall's Tau，用于度量相关性。要完成这部分，你需要两个包：copula和VineCopula。

数据集

这部分我要用到一组数据，你可以从这里下载。这个数据集包含两个变量，x和y，其特点是严重左尾相关性。

你可以从下图看到x和y的关系，x和y在取值较小时高度相关。

library(copula)
library(VineCopula)
library(ggplot2)

mydata1 <- read.csv("/home/kevin/Downloads/mydata.csv")
mydata <- mydata1[,2:3]
qplot(mydata$x, mydata$y, xlab = "x", ylab = "y",
main = "Test dataset", colour = mydata$x)

x和y的分布

我们首先分别看一下对应的边缘分布，这一步应该不难。我们可以用柱状图来看看。

对每个变量提前看看分布是个好习惯，有助于之后选择合适的分布。此例子中Gamma分布对x和y都比较合适。当然我们这只是随便猜的，正常来说要做出选择需要进一步分析才行。目前对我们来说这不是重点。接下来就是要确定参数了，我们会从分布中随机抽样，然后比较。

# Estimate x gamma distribution parameters and visually
# compare simulated vs observed data

x_mean <- mean(mydata$x)
x_var <- var(mydata$x)
x_rate <- x_mean / x_var
x_shape <- ((x_mean)^2) / x_var

hist(mydata$x, breaks = 20, col = "green", density = 20)
hist(rgamma(nrow(mydata), rate = x_rate, shape = x_shape),
breaks = 20,col = "blue", add = T, density = 20,
angle = -45)

# Estimate y gamma distribution parameters and visually
# compare simulated vs observed data
y_mean <- mean(mydata$y)
y_var <- var(mydata$y)
y_rate <- y_mean / y_var
y_shape <- ( (y_mean)^2 ) / y_var

hist(mydata$y, breaks = 20, col = "green", density = 20)
hist(rgamma(nrow(mydata), rate = y_rate, shape = y_shape),
breaks = 20, col = "blue", add = T, density = 20,
angle = -45)

图中绿色的是实际值，蓝色的是模拟值。看起来都还挺匹配的。（关于Gamma，是一种标准分布，类似正态分布，可以用来模拟其他真实数据，调整参数后可以适应不同density的数据。详见wiki。）

Kendall tau和Spearman rho度量

现在，是时候来看看联合分布的情况了。比如我们可以先看看x和y的相关性。copulas处理相关性的度量有两个，分别是Kendall Tau和Spearman Rho。这两个一般来说比线性度量要好一些，对于处理copulas来说。下面用Kendall Tau来看看。

# Measure association using Kendall's Tau
cor(mydata, method = "kendall")
## x y
## x 1.0000000 0.4212052
## y 0.4212052 1.0000000

记住这部分的相关性数据，等会copula完成后可以拿来比较一下。

使用VineCopula包选择copula

因为我们的数据集是二元的，我们可以用散点图来先看看二者之间的关系，以帮助我们理解。如你所知，copula就是描述二元之间的如何联动的，因此先看看图可以帮助我们选取合适的copula。

猜当然不是什么办法，况且一旦多过三个变量，就无法做到可视化从而猜了。这时候我们就需要VineCopula提供的功能了。

VineCopula包提供了BiCopSelect()，可以方便地选择copula，此包使用BIC和AIC进行选择。

var_a <- pobs(mydata)[,1]
var_b <- pobs(mydata)[,2]
selectedCopula <- BiCopSelect(var_a, var_b, familyset = NA)
selectedCopula
selectedCopula$p.value.indeptest
selectedCopula$family
selectedCopula$par

注意BiCopSelect()接受伪观测值作为参数。也就是$[0,1]^2$上的观测值。pobs()则将原观测值转换为伪观测值，其输出值为矩阵，而不是数据框dataframe。

上面显示clayton为本案例合适的选择，且参数theta估计值为1.65。

给定copula后的拟合过程

BiCopSelect函数也能估计copula的参数。不过如果你已经知道用什么copula了，你也可以使用fitCopula()进行拟合。

# Estimate copula parameters
cop_model <- claytonCopula(dim = 2)
m <- pobs(as.matrix(mydata))
fit <- fitCopula(cop_model, m, method = 'ml')
coef(fit)
# Check Kendall's tau value for the Clayton copula with theta = 1.65
tau(claytonCopula(param = 1.65))
# 0.4520548

可以发现拟合的结果挺不错，和BiCopSelect()一样。同时Kendall's Tao 和之前用x和y计算的也差不多。

拟合测试的好处

一旦copula拟合完成了，我们可以测试一下结果好坏，使用gofCopula()可以完成。注意该测试可能速度较慢。
为了比较，我们运行两遍，第一遍用正态copula，第二遍用Clayton。

gf <- gofCopula(normalCopula(dim = 2), as.matrix(mydata), N = 50)
gf
# data: x
# statistic = 0.25221, parameter = 0.63658, p-value=0.009804
# can refuse null (normal copula)

gfc <- gofCopula(claytonCopula(dim = 2), as.matrix(mydata), N = 50)
gfc
# data: x
# statistic = 0.014269, parameter = 1.6467, p-value =0.6373
# cannot refuse null (clayton copula)

用copula构建二元分布

我们已经成功的选择和拟合了copula，接下来我们给联合关系建模，用part1中的基本工具。

# Build the bivariate distribution
my_dist <- mvdc(claytonCopula(param = 1.48, dim = 2), margins = c("gamma","gamma"), paramMargins = list(list(shape = x_shape, rate = x_rate), list(shape = y_shape, rate = y_rate)))
<
# Generate random sample observations from the multivariate distribution
v <- rMvdc(5000, my_dist)
# Compute the density
pdf_mvd <- dMvdc(v, my_dist)
# Compute the CDF
cdf_mvd <- pMvdc(v, my_dist)

# 3D plain scatterplot of the generated bivariate distribution
par(mfrow = c(1, 2))
scatterplot3d(v[,1],v[,2], pdf_mvd, color="red", main="Density", xlab = "u1", ylab="u2", zlab="pMvdc",pch=".")
scatterplot3d(v[,1],v[,2], cdf_mvd, color="red", main="CDF", xlab = "u1", ylab="u2", zlab="pMvdc",pch=".")
persp(my_dist, dMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "Density")
contour(my_dist, dMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "Contour plot")
persp(my_dist, pMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "CDF")

接下来我们可以对此估计的联合分布抽样，看看效果。

# Build the bivariate distribution

my_dist <- mvdc(claytonCopula(param = 1.48, dim = 2), margins = c("gamma","gamma"), paramMargins = list(list(shape = x_shape, rate = x_rate), list(shape = y_shape, rate = y_rate)))

# Generate random sample observations from the multivariate distribution

v <- rMvdc(5000, my_dist)

# Compute the density

pdf_mvd <- dMvdc(v, my_dist)

# Compute the CDF

cdf_mvd <- pMvdc(v, my_dist)

# 3D plain scatterplot of the generated bivariate distribution

par(mfrow = c(1, 2))

scatterplot3d(v[,1],v[,2], pdf_mvd, color="red", main="Density", xlab = "u1", ylab="u2", zlab="pMvdc",pch=".")

scatterplot3d(v[,1],v[,2], cdf_mvd, color="red", main="CDF", xlab = "u1", ylab="u2", zlab="pMvdc",pch=".")

persp(my_dist, dMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "Density")

contour(my_dist, dMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "Contour plot")

persp(my_dist, pMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "CDF")

contour(my_dist, pMvdc, xlim = c(-4, 4), ylim=c(0, 2), main = "Contour plot")

对新生成的联合分布抽样

用part1中的工具就行了。

# Sample 1000 observations from the distribution
sim <- rMvdc(1000,my_dist)

# Plot the data for a visual comparison
plot(mydata$x, mydata$y, main = 'Test dataset x and y', col = "blue")
points(sim[,1], sim[,2], col = "red")
legend('bottomright', c('Observed', 'Simulated'), col = c('blue', 'red'), pch=21)

cor(mydata, method = "kendall")
## x y
## x 1.0000000 0.4212052
## y 0.4212052 1.0000000

cor(sim, method = "kendall")
## [,1] [,2]
## [1,] 1.0000000 0.4082803
## [2,] 0.4082803 1.0000000

注意Kendall's Tau依旧保持了原样。相关性结构被copula保持了下来，不管边缘分布如何。当然这还只是基本的阿基米德copulas就能达到的。

除了本文提到的工具，我想没有更简单的了。