协整检验是为了检验非平稳序列的因果关系，协整检验是解决伪回归为问题的重要方法。首先回归伪回归例子：

伪回归Spurious regression伪回归方程的拟合优度、显著性水平等指标都很好，但是其残差序列是一个非平稳序列，拟合一个伪回归:

#调用相关R包

library(lmtest)

library(tseries)

#模拟序列

set.seed(123456)

e1=rnorm(500)

e2=rnorm(500)

trd=1:500

y1=0.8*trd+cumsum(e1)

y2=0.6*trd+cumsum(e2)

sr.reg=lm(y1~y2)

#提取回归残差

error=residuals(sr.reg)

#作残差散点图

plot(error, main="Plot of error")

#对残差进行单位根检验

adf.test(error)

## Dickey-Fuller = -2.548, Lag order = 7, p-value = 0.3463

## alternative hypothesis: stationary

#伪回归结果，相关参数都显著

summary(sr.reg)

## Residuals:

## Min 1Q Median 3Q Max

## -30.654 -11.526 0.359 11.142 31.006

## Coefficients:

## Estimate Std. Error t value Pr(>|t|)

## (Intercept) -29.32697 1.36716 -21.4 <2e-16 ***

## y2 1.44079 0.00752 191.6 <2e-16 ***

## Residual standard error: 13.7 on 498 degrees of freedom

## Multiple R-squared: 0.987, Adjusted R-squared: 0.987

## F-statistic: 3.67e+04 on 1 and 498 DF, p-value: <2e-16

dwtest(sr.reg)

## DW = 0.0172, p-value <2.2e-16

恩格尔-格兰杰检验Engle-Granger第一步：建立两变量（y1,y2）的回归方程，第二部：对该回归方程的残差(resid)进行单位根检验其中，原假设两变量不存在协整关系，备择假设是两变量存在协整关系。利用最小二乘法对回归方程进行估计，从回归方程中提取残差进行检验。

set.seed(123456)

e1=rnorm(100)

e2=rnorm(100)

y1=cumsum(e1)

y2=0.6*y1+e2

# (伪)回归模型

lr.reg=lm(y2~y1)

error=residuals(lr.reg)

adf.test(error)

## Dickey-Fuller = -3.988, Lag order = 4, p-value = 0.01262

## alternative hypothesis: stationary

error.lagged=error[-c(99,100)]

#建立误差修正模型ECM.REG

dy1=diff(y1)

dy2=diff(y2)

diff.dat=data.frame(embed(cbind(dy1, dy2),2))#emed表示嵌入时间序列dy1,dy2到diff.dat

colnames(diff.dat)=c("dy1","dy2","dy1.1","dy2.1")

ecm.reg=lm(dy2~error.lagged+dy1.1+dy2.1, data=diff.dat)

summary(ecm.reg)

## Residuals:

## Min 1Q Median 3Q Max

## -2.959 -0.544 0.137 0.711 2.307

## Coefficients:

## Estimate Std. Error t value Pr(>|t|)

## (Intercept) 0.0034 0.1036 0.03 0.97

## error.lagged -0.9688 0.1585 -6.11 2.2e-08 ***

## dy1.1 0.8086 0.1120 7.22 1.4e-10 ***

## dy2.1 -1.0589 0.1084 -9.77 5.6e-16 ***

## Residual standard error: 1.03 on 94 degrees of freedom

## Multiple R-squared: 0.546, Adjusted R-squared: 0.532

## F-statistic: 37.7 on 3 and 94 DF, p-value: 4.24e-16

par(mfrow=c(2,2))

plot(ecm.reg)

Johansen-Juselius(JJ)协整检验法，该方法是一种用向量自回归(VAR)模型进行检验的方法，适用于对多重一阶单整I(1)序列进行协整检验。JJ检验有两种：特征值轨迹检验和最大特征值检验。我们可以调用urca包中的ca.jo命令完成这两种检验。其语法：

ca.jo(x, type = c("eigen", "trace"), ecdet = c("none", "const", "trend"), K = 2,spec=c("longrun", "transitory"), season = NULL, dumvar = NULL)

其中：x为矩阵形式数据框；type用来设置检验方法；ecdet用于设置模型形式：none表示不带截距项，const表示带常数截距项，trend表示带趋势项。K表示自回归序列的滞后阶数；spec表示向量误差修正模型反映的序列间的长期或短期关系；season表示季节效应；dumvar表示哑变量设置。

set.seed(12345)e1=rnorm(250,0,0.5)e2=rnorm(250,0,0.5)e3=rnorm(250,0,0.5)#模拟没有移动平均的向量自回归序列；u1.ar1=arima.sim(model=list(ar=0.75), innov=e1, n=250)u2.ar1=arima.sim(model=list(ar=0.3), innov=e2, n=250)y3=cumsum(e3)y1=0.8*y3+u1.ar1y2=-0.3*y3+u2.ar1#合并y1,y2,y3构成进行JJ检验的数据库；y.mat=data.frame(y1, y2, y3)#调用urca包中cajo命令对向量自回归序列进行JJ协整检验vecm=ca.jo(y.mat)jo.results=summary(vecm)#cajorls命令可以得到限制协整阶数的向量误差修正模型的最小二乘法回归结果vecm.r2=cajorls(vecm, r=2)vecm.r2## Call:lm(formula = substitute(form1), data = data.mat)## Coefficients:## y1.d y2.d y3.d## ect1 -0.33129 0.06461 0.01268## ect2 0.09447 -0.70938 -0.00916## constant 0.16837 -0.02702 0.02526## y1.dl1-0.22768 0.02701 0.06816## y2.dl1 0.14445 -0.71561 0.04049## y3.dl1 0.12347 -0.29083 -0.07525## $beta## ect1 ect2## y1.l2 1.000e+00 0.0000## y2.l2 -3.402e-18 1.0000## y3.l2 -7.329e-01 0.2952

在R中，代码可以分为如下几个级别：

首先，是你输入了函数对象名称，你可以直接看到代码的，如要获得函数对象fivenum的代码，就只需要在Console中键入函数对象名称fivenum就可以得到如下结果：

function (x, na.rm = TRUE)

{

xna <- is.na(x)

if (na.rm)

x <- x[!xna]

else if (any(xna))

return(rep.int(NA, 5))

x <- sort(x)

n <- length(x)

if (n == 0)

rep.int(NA, 5)

else {

n4 <- floor((n + 3)/2)/2

d <- c(1, n4, (n + 1)/2, n + 1 - n4, n)

0.5 * (x[floor(d)] + x[ceiling(d)])

}

}

<environment: namespace:stats>

从上面的例子可以看出，这类函数对象的代码是最容易看到的，也是我们学习的最好的材料了，而R中最大多数的函数对象是以这种方式出现的。

其次，我们在输入mean这类函数名次的时候，会出现如下结果：

function (x, ...)

UseMethod("mean")

<environment: namespace:base>

这表示函数作者把函数“封”起来了。这个时候我们可以先试一试methods(mean)，利用methods函数看看mean这个函数都有哪些类型的，我们得到的结果如下：

[1] mean.data.frame mean.Date mean.defaultmean.difftime mean.POSIXct mean.POSIXlt

其实对此可以有一个简单的理解，虽然不够精确。因为在R中，mean函数可以求得属于不同类型对象的平均值，而不同类型对象平均值的求法还是有一些小小差 异的，比如说求一个向量的平均值和求一个数据框的平均值就有所差异，就要编写多个mean函数，然后“封”起来，以一个统一的mean出现，方便我们使 用。这正好也反映了R有一种类似泛型编程语言的性质。

既然我们已经知道mean中还有这么多种类，我们可以输入mean.default试一试就可以得到：

function (x, trim = 0, na.rm = FALSE, ...)

{

if (!is.numeric(x) &&!is.complex(x) &&!is.logical(x)) {

warning("argument is not numeric or logical: returning NA")

return(as.numeric(NA))

}

if (na.rm)

x <- x[!is.na(x)]

trim <- trim[1]

n <- length(x)

if (trim >0 &&n >0) {

if (is.complex(x))

stop("trimmed means are not defined for complex data")

if (trim >= 0.5)

return(stats::median(x, na.rm = FALSE))

lo <- floor(n * trim) + 1

hi <- n + 1 - lo

x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]

n <- hi - lo + 1

}

.Internal(mean(x))

}

<environment: namespace:base>

同样就可以得到mean.data.frame、mean.Date、mean.difftime、mean.POSIXct、mean.POSIXlt 的具体内容了。值得注意的是，在R中，出现有多个同样近似功能的函数封装为一个函数的时候（这时候在函数中多半会出现类似UseMethod函数使用的情 况），我们不妨先输入mean.default试一试。这种形式的函数在R中一般作为默认的函数表示。

第三，这是一种特殊的情况，有人认为应该和第二种是一类，但是我还是要提出来单独归类。在这种情况也和第二种的原因有些类似，但并不是完全一致。

也许我们大家都很熟悉plot函数了吧，输入函数名plot的时候，我们会得到如下结果：

function (x, y, ...)

{

if (is.null(attr(x, "class")) &&is.function(x)) {

nms <- names(list(...))

if (missing(y))

y <- {

if (!"from" %in% nms)

0

else if (!"to" %in% nms)

1

else if (!"xlim" %in% nms)

NULL

}

if ("ylab" %in% nms)

plot.function(x, y, ...)

else plot.function(x, y, ylab = paste(deparse(substitute(x)),

"(x)"), ...)

}

else UseMethod("plot")

}

<environment: namespace:graphics>

请注意plot函数中也出现了UseMethod这个函数，但是和mean不同的是，前面有相当多的语句用于处理其他一些事情。这个时候，我们也使用methods(plot)来看看，得到如下结果：

plot.acf* plot.data.frame*plot.Date* plot.decomposed.ts* plot.default

plot.dendrogram*plot.densityplot.ecdf plot.factor*plot.formula*

plot.hclust*plot.histogram* plot.HoltWinters* plot.isoreg*plot.lm

plot.medpolish* plot.mlmplot.POSIXct* plot.POSIXlt* plot.ppr*

plot.prcomp*plot.princomp* plot.profile.nls* plot.spec plot.spec.coherency

plot.spec.phase plot.stepfunplot.stl* plot.table* plot.ts

plot.tskernel* plot.TukeyHSD

不看不知道，一看吓一跳，还以为我们输入plot的输出就是函数本身，结果也许不是如此。可能有人已经理解了，其实最后的UseMethod函数实在默认的调用plot.default函数，赶快再看看plot.default函数吧，发现它再调用plot.xy函数，再看看plot.xy函数，再plot.xy函数中调用了一个.Internal(plot.xy(xy, type, pch, lty, col, bg, cex, lwd, ...))函数，也许这就是真正起作用的函数了吧。思路基本上就是如此了，是否这个时候您可以获得一些阅读查找R函数内容的乐趣。

除了直接输入FUN.default形式外，还可以使用getS3method(FUN,"default")来获得代码。这样就解决了绝大多数函数代码查看的工作了。

在第二种情况种，我们说了一般可以通过FUN.default获得想要的结果。但是只有称为generic的函数才有这种“特权”。而lm等则没有，不过我们也可以尝试使用methods(lm)来看看结果如何，发现：

[1] lm.fit lm.fit.null lm.influence lm.wfit lm.wfit.null

Warning message:

function 'lm' appears not to be generic in: methods(lm)

出现了警告信息，表示说lm不是泛型函数，但是还是给出了结果lm.fit等，大致上可以看成是和lm相关的系列函数吧。这样子就出现了有趣的局面，比如说既有plot.ts，也有ts.plot。

依照第三种情况，我们发现竟然有的函数用星号标识了的，比如plot.stl*等，当我们输入plot.stl，甚至是plot.stl*的时候都会给出 要么找不到这个对象，要么干脆是代码错误的信息。原来凡是用了*标识的函数，都是隐藏起来的函数，估计是怕被人看见（其实这是玩笑话）！我们要看这些函数 的代码，我们该怎么办呢？其实也很容易，使用功能强大的getAnywhere(FUN)，看看这个函数的名称，就可以猜想到它的功能估计是很强大的， Anywhere的内容都可以找到！getAnywhere(plot.stl)的结果如下：

A single object matching 'plot.stl' was found

It was found in the following places

registered S3 method for plot from namespace stats

namespace:stats

with value

function (x, labels = colnames(X), set.pars = list(mar = c(0,

6, 0, 6), oma = c(6, 0, 4, 0), tck = -0.01, mfrow = c(nplot,

1)), main = NULL, range.bars = TRUE, ..., col.range = "light gray")

{

sers <- x$time.series

ncomp <- ncol(sers)

data <- drop(sers %*% rep(1, ncomp))

X <- cbind(data, sers)

colnames(X) <- c("data", colnames(sers))

nplot <- ncomp + 1

if (range.bars)

mx <- min(apply(rx <- apply(X, 2, range), 2, diff))

if (length(set.pars)) {

oldpar <- do.call("par", as.list(names(set.pars)))

on.exit(par(oldpar))

do.call("par", set.pars)

}

for (i in 1:nplot) {

plot(X[, i], type = if (i <nplot)

"l"

else "h", xlab = "", ylab = "", axes = FALSE, ...)

if (range.bars) {

dx <- 1/64 * diff(ux <- par("usr")[1:2])

y <- mean(rx[, i])

rect(ux[2] - dx, y + mx/2, ux[2] - 0.4 * dx, y -

mx/2, col = col.range, xpd = TRUE)

}

if (i == 1 &&!is.null(main))

title(main, line = 2, outer = par("oma")[3] >0)

if (i == nplot)

abline(h = 0)

box()

right <- i%%2 == 0

axis(2, labels = !right)

axis(4, labels = right)

axis(1, labels = i == nplot)

mtext(labels[i], side = 2, 3)

}

mtext("time", side = 1, line = 3)

invisible()

}

<environment: namespace:stats>

注意到前面有一段解释型的语言，描述了我们要找的这个函数放在了什么地方等等。其实对任意我们可以在R中使用的函数，都可以先试一试getAnywhere，看看都有些什么内容。算是一个比较“霸道”的函数。

在上面plot.xy函数中，我们还可以看到.Internal这个函数，类似的也许还可以看到.Primitive、.External、.Call等函数这就和R系统内部工作方式和与外部接口的定义有关了，如果对这些函数有兴趣的话，就要学习组成R系统的源代码了。

最后，如果真的想阅读组成R系统本身的源代码，在各个CRAN中均有下载。你可以得到组成R系统所需要的材料。其中很多C语言（还有就是F）的源代码，均 是精心挑选过的算法，哪怕就是想学从头到尾编写具体的算法，也是学习的好材料。同时，你可以看到R系统内部是如何构成的，理解了这些对于高效使用R有至关 重要的作用。这个范畴的材料就要着重看一看R-Lang和R-inits了。

至此，R中阅读代码的内容就依照我的理解介绍了一下。随后将有一些R代码示例的分析注解、语言本身、R应用的和行业使用的材料翻译和具体例子说明。欢迎大家多多和我交流，一起进步。