<div style="text-indent: 2em;">
示例欢迎通过以下网址下载:
http://www.myfootprints.cn/blog/upload/ACF_PACF.xls
以下是vba 模块:
注:传入ACF()函数的参数必须是已经中心化后的数组。而传入PACF()函数的参数是由ACF()函数计算出来的数组序列。
使用中心化后的相同的数据在本Excel文件中和在SAS软件中计算的结果是一致的。
如:下载后示例文件后,将如下数据在SAS软件中计算其自相关函数与偏自相关函数:
-5.552941176 -3.352941176 -1.552941176 -4.152941176 -1.552941176 -4.152941176 -3.152941176 -2.152941176 -1.152941176 -0.152941176 0.847058824 1.847058824 2.847058824 3.847058824 4.847058824 5.847058824 6.847058824
SAS 程序为:
data mydata; input x; cards; -5.552941176 -3.352941176 -1.552941176 -4.152941176 -1.552941176 -4.152941176 -3.152941176 -2.152941176 -1.152941176 -0.152941176 0.847058824 1.847058824 2.847058824 3.847058824 4.847058824 5.847058824 6.847058824 ; run;proc arima; identify var = x nlag = 864 outcov = out1; run;
计算自相关函数的的自定义函数是acf(),偏自关函数是pacf(),它们的参数都是一组数据,而这组数据来自excel中的单元格范围,故它们都调用了一个函数,用来将excel的单元格范围转化成一个数组,这个函数就是range2array()。
range2array()的算法很简单,用for each循环将range中的每一个数字逐个填充到预先定义好的array()中。而这个array()的大小,与range中的单元格数相同。
acf()的算法,即是根据样本自相关函数的定义而实现的。即
而pacf()的算法,也是根据偏自相关函数的定义来的。即
在pacf()中,先根据输入的参数数组,分别得到分母矩阵和分子矩阵,然后分别对分母矩阵和分子矩阵求行列式值。最后相除即可。
分母矩阵实际上是一个对称矩阵,而且观察后可以发现有这样的规律,即,每个元素的下标,都是其行列号的差的绝对值。
而分子矩阵,除了最后一列,其他的元素都与分母矩阵相同。
Option Explicit 'Option Private Module
'''''''''''''''''''''''''''''''''' ' 计算列数据的自相关函数 ' '''''''''''''''''''''''''''''''''' Public Function ACF(ByRef rng As Range, ByVal k As Long) As Double Dim dDenominator As Double Dim dNumerator As Double Dim daX() As Variant Dim i As Long Dim lUB As Long, lLB As Long
daX = Range2Array(rng)
'计算分子
dNumerator = 0
lUB = UBound(daX)
lLB = LBound(daX)
For i = lLB + k To lUB
dNumerator = dNumerator + daX(i) * daX(i - k)
Next i
'计算分母
dDenominator = 0
For i = lLB To lUB
dDenominator = dDenominator + daX(i) * daX(i)
Next i
ACF = dNumerator / dDenominator
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 计算列数据的偏自相关函数 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function PACF(ByRef rng As Range, ByVal k As Long) As Double Dim dDenominator As Double Dim dNumerator As Double Dim dMatrixDenominator() As Double Dim dMatrixNumerator() As Double Dim vArray() As Variant Dim i As Long, j As Long Dim sString As String
vArray = Range2Array(rng, 1)
vArray(LBound(vArray)) = 1
ReDim dMatrixDenominator(0 To k - 1, 0 To k - 1)
ReDim dMatrixNumerator(0 To k - 1, 0 To k - 1)
'生成分母矩阵
' sString = "分母矩阵:" & vbCrLf
For i = 0 To k - 1
For j = 0 To k - 1
dMatrixDenominator(i, j) = CDbl(vArray(Abs(i - j)))
' sString = sString & dMatrixDenominator(i, j) & vbTab Next j ' sString = sString & vbCrLf Next i ' Debug.Print sString
'生成分子矩阵
For i = 0 To k - 1
For j = 0 To k - 2
dMatrixNumerator(i, j) = CDbl(vArray(Abs(i - j)))
Next j
Next i
For i = 0 To k - 1
dMatrixNumerator(i, k - 1) = CDbl(vArray(i + 1))
Next i
' sString = "分子矩阵:" & vbCrLf ' For i = 0 To k - 1 ' For j = 0 To k - 1 ' sString = sString & dMatrixNumerator(i, j) & vbTab ' Next j ' sString = sString & vbCrLf ' Next i ' Debug.Print sString
'计算PACF(k,k)
PACF = Application.WorksheetFunction.MDeterm(dMatrixNumerator) / Application.WorksheetFunction.MDeterm(dMatrixDenominator)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 求和 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function SigmaSum(ByRef rng As Range, ByVal lBegin As Long, ByVal lEnd As Long, ByVal power As Double) As Double SigmaSum = 0
Dim i As Long
For i = lBegin To lEnd
SigmaSum = SigmaSum + CDbl(rng.Cells(i).Value) ^ power
Next i
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 将Range转换成数组 (变体型) ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function Range2Array(ByRef rng As Range, Optional ByVal lOffset As Long = 0) As Variant() Dim vaRet() As Variant Dim i As Long Dim rngCell As Range
ReDim vaRet(0 To rng.Cells.Count - 1)
i = lOffset
For Each rngCell In rng
vaRet(i) = rngCell.Value
If i >= UBound(vaRet) Then
Exit For
End If
i = i + 1
Next rngCell
Range2Array = vaRet
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 将Range转换成数组 (双精度型) ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function Range2ArrayDouble(ByRef rng As Range) As Double() Dim daRet() As Double Dim i As Long Dim rngCell As Range
ReDim vaRet(0 To rng.Cells.Count - 1)
i = 0
For Each rngCell In rng
On Error Resume Next
daRet(i) = CDbl(rngCell.Value)
If Err.Number <> 0 Then
daRet(i) = 0
Err.Clear
End If
i = i + 1
Next rngCell
Range2ArrayDouble = daRet
End Function
示例文件:ACF_PACF.xls