切换到宽版
  • 1318阅读
  • 2回复

[求助]求:R/S分析技术来分析测井曲线得到对应分形维数、计算Hurst 指数的程序代码 [复制链接]

上一主题 下一主题
离线8142
 
发帖
780
财富
695
威望
6
交易币
0
只看楼主 倒序阅读 使用道具 0楼 发表于: 2012-07-16 | 石油求职招聘就上: 阿果石油英才网
此悬赏帖已过期
最佳答案:20 财富,热心助人剩余点数: 2 财富。
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 开始输入,请不要空格

但是运行的过程中出现了几个问题,求高手指正或者给出其他的程序代码!

评价一下你浏览此帖子的感受

精彩

感动

搞笑

开心

愤怒

无聊

灌水
生命不止,奋斗不息,看帖回帖,交流学习
离线swpulh
发帖
187
财富
7
威望
5
交易币
9
只看该作者 1楼 发表于: 2012-07-17 | 石油求职招聘就上: 阿果石油英才网
我运行的程序好像就是这个 数据不能太长
有测井评价方面软件或者学习资料的果友 请联系我哦  可交换QQ84420548
离线lzh_qepwq
发帖
113
财富
1778
威望
14
交易币
0
只看该作者 2楼 发表于: 2014-12-07 | 石油求职招聘就上: 阿果石油英才网
这个是求赫斯特指数么?分形维数在哪

网站事务咨询:QQ:1392013 | 26189883
阿果石油网为免费个人网站,为石油人提供免费的在线即时技术交流场所,拒绝任何人以任何形式在本论坛发表与中华人民共和国法律相抵触的言论和行为!
如有言论或会员共享的资料涉及到您的权益,请立即通知网站管理员,本站将在第一时间给予配合处理,谢谢!