原文地址：
https://www.r-bloggers.com/how-to-fit-a-copula-model-in-r-heavily-revised-part-2-fitting-the-copula/
接上文，第二部分是個小案例。
這部分作者要選擇一個copula，用測試數(shù)據(jù)集擬合，評估擬合，從擬合的多元分布中生成隨機觀測值。另外，這部分還會告訴大家怎么計算Spearman's Rho和Kendall's Tau，用于度量相關性。要完成這部分，你需要兩個包：copula和VineCopula。
數(shù)據(jù)集
這部分我要用到一組數(shù)據(jù)，你可以從這里下載。這個數(shù)據(jù)集包含兩個變量，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都比較合適。當然我們這只是隨便猜的，正常來說要做出選擇需要進一步分析才行。目前對我們來說這不是重點。接下來就是要確定參數(shù)了，我們會從分布中隨機抽樣，然后比較。
# 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，是一種標準分布，類似正態(tài)分布，可以用來模擬其他真實數(shù)據(jù)，調整參數(shù)后可以適應不同density的數(shù)據(jù)。詳見wiki。）
Kendall tau和Spearman rho度量
現(xiàn)在，是時候來看看聯(lián)合分布的情況了。比如我們可以先看看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
記住這部分的相關性數(shù)據(jù)，等會copula完成后可以拿來比較一下。
使用VineCopula包選擇copula
因為我們的數(shù)據(jù)集是二元的，我們可以用散點圖來先看看二者之間的關系，以幫助我們理解。如你所知，copula就是描述二元之間的如何聯(lián)動的，因此先看看圖可以幫助我們選取合適的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()接受偽觀測值作為參數(shù)。也就是$[0,1]^2$上的觀測值。pobs()則將原觀測值轉換為偽觀測值，其輸出值為矩陣，而不是數(shù)據(jù)框dataframe。
上面顯示clayton為本案例合適的選擇，且參數(shù)theta估計值為1.65。
給定copula后的擬合過程
BiCopSelect函數(shù)也能估計copula的參數(shù)。不過如果你已經(jīng)知道用什么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
可以發(fā)現(xiàn)擬合的結果挺不錯，和BiCopSelect()一樣。同時Kendall's Tao 和之前用x和y計算的也差不多。
擬合測試的好處
一旦copula擬合完成了，我們可以測試一下結果好壞，使用gofCopula()可以完成。注意該測試可能速度較慢。
為了比較，我們運行兩遍，第一遍用正態(tài)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構建二元分布
我們已經(jīng)成功的選擇和擬合了copula，接下來我們給聯(lián)合關系建模，用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")
接下來我們可以對此估計的聯(lián)合分布抽樣，看看效果。
# 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")
對新生成的聯(lián)合分布抽樣
用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就能達到的。
除了本文提到的工具，我想沒有更簡單的了。
