R/S分析(Rescaldernagenaalyssi,通常称为变尺度分析或重标度距离分析)
下面是别人的一段利用Excel 的宏语言VBA 编写宏程序
Sub Hurst()
'变量和数组的定义
Dim Data()
Dim Array1()
Dim Array2()
Dim R()
Dim S()
Dim Result()
Dim NoOfDataPoints As Integer
Dim NoOfPlottedPoints As Integer
Dim NoOfPeriods
Dim PeriodNo
Dim n As Integer
Dim A As Integer
Dim i As Integer
Dim m
Dim e
Dim RS
'验证A 列中是否输入数据
If Worksheets("Sheet1").Range("A1").Value = 0 Then MsgBox ("请在A 列输入数据!"): Exit Sub
'清空主要的单元格
Worksheets("Sheet1").Range("B3").Value = "Hurst = "
Worksheets("Sheet1").Range("C3").Value = Null
'统计数据的个数
i = 1
Do While i < 10000
i = i + 1
If Worksheets("Sheet1").Cells(i, 1).Value = 0 Then Exit Do
Loop
NoOfDataPoints = i - 1
ReDim Data(NoOfDataPoints)
'验证A 列的数据后将其加载到数组中
i = 1
counter = 1
Do While counter <= NoOfDataPoints
Set curCell = Worksheets("Sheet1").Cells(i, 1)
If Application.WorksheetFunction.IsNumber(curCell.Value) Then
Data(counter) = curCell.Value
counter = counter + 1
End If
i = i + 1
Loop
'运行以下代码则可以直接输入原数据
'i=2
'Do While i <= NoOfDataPoints
'Data(i - 1) = Log(Data(i) / Data(i - 1))
'i = i + 1
'Loop
ReDim Result(NoOfDataPoints / 2, 2)
'进入主循环
A = 2
Do While A <= NoOfDataPoints / 2
'再次定义数组变量
NoOfPeriods = NoOfDataPoints / A
ReDim Array1(Int(NoOfPeriods))
ReDim Array2(A, NoOfPeriods)
ReDim S(Int(NoOfPeriods))
ReDim R(Int(NoOfPeriods))
RS = 0
'求得各个子区间均值
i = 1
Do While i <= NoOfPeriods
e = 0
For PeriodNo = 1 To A
e = e + Data(PeriodNo + (i - 1) * A)
Next PeriodNo
Array1(i) = e / A
i = i + 1
Loop
'求得各个子区间的累积截距和极差
i = 1
Do While i < NoOfPeriods
m = 0
e = 0
For PeriodNo = 1 To A
m = m + ((Data(PeriodNo + (i - 1) * A) - Array1(i)) ^ 2)
e = e + (Data(PeriodNo + (i - 1) * A) - Array1(i))
Array2(PeriodNo,i) = e
Next PeriodNo
'比较最大值与最小值
Maxi = Array2(1,i)
Mini = Array2(1,i)
For n = 1 To A
If Array2(n,i) > Maxi Then Maxi = Array2(n,i)
If Array2(n,i) < Mini Then Mini = Array2(n,i)
Next n
'求得R/S 值
R(i) = Maxi - Mini
S(i) = Sqr(m / A)
RS = RS + R(i) / S(i)
i = i + 1
Loop
'将V 统计量表的数据输出到Excel 表格中
Worksheets("sheet1").Cells(A + 2, 5).Value = (RS / NoOfPeriods) / Sqr(A)
Worksheets("sheet1").Cells(A + 2, 6).Value = Log(A)
'将计算结果装入Result()数组中
Result(A, 1) = Log(A)
Result(A, 2) = Log(RS / NoOfPeriods)
A = A + 1
Loop
'对方程Log(R/S)=Log(c) + H•Log(n)+ε进行线性回归,估计出斜率H 就是Hurst 指数
sumx = 0
Sumy = 0
Sumxy = 0
Sumxx = 0
NoOfPlottedPoints = NoOfDataPoints / 2
For i = 2 To NoOfPlottedPoints
sumx = sumx + Result(i, 1)
Sumy = Sumy + Result(i, 2)
Sumxy = Sumxy + (Result(i, 1)) * (Result(i, 2))
Sumxx = Sumxx + (Result(i, 1)) * (Result(i, 1))
Next i
H = (Sumxy - ((sumx * Sumy) / NoOfPlottedPoints)) / (Sumxx - ((sumx * sumx) / NoOfPlottedPoints))
Worksheets("sheet1").Range("C3").Value = H
End Sub
本程序的默认输入列是A 列,请将数据直接输入A 列中,从A1 开始输入,请不要空格
但是运行的过程中出现了几个问题,求高手指正或者给出其他的程序代码!