📄 map_form.frm
字号:
Next i
'Determining grid cells whether containning a deposit
For i = 1 To deposit_num
xx = deposit_co(i, 1)
yy = deposit_co(i, 2)
ixx = Fix((xx - xmin) / dx) + 1
iyy = Fix((yy - ymin) / dy) + 1
ii = (iyy - 1) * l + ixx
grid_dep(ii, 1) = 1
Next i
'Initialize the grid_dep
For i = 1 To k * l
For j = 1 To m
grid_dep(i, j + 1) = -1
Next j
Next i
'Determining map patterns whether exist in grid cells
For j = 1 To m
'Open the map pattern file and input the data
filename = file(2 * j)
Open filename For Input As #2
Call InputEvi(evidence_co, point_num, region_num, 2)
For ij = 1 To k
yg = grid_co((ij - 1) * l + 1, 2)
kk = 0
For i1 = 1 To region_num
kkks = 0
For ii = kk + 1 To kk + point_num(i1) - 1
xx1 = evidence_co(ii, 1)
yy1 = evidence_co(ii, 2)
xx2 = evidence_co(ii + 1, 1)
yy2 = evidence_co(ii + 1, 2)
If ii < kk + point_num(i1) - 1 Then
xx3 = evidence_co(ii + 2, 1)
yy3 = evidence_co(ii + 2, 2)
ElseIf ii = kk + point_num(i1) - 1 Then
xx3 = evidence_co(kk + 2, 1)
yy3 = evidence_co(kk + 2, 2)
End If
'Determining the intersecting points of the scanning line and the polygon boundaries
If yy1 <> yy2 Then
If (yg > yy1 And yg < yy2) Or (yg < yy1 And yg > yy2) Then
kkks = kkks + 1
joint_co(kkks) = (xx2 - xx1) * (yg - yy1) / (yy2 - yy1) + xx1
ElseIf yg = yy2 Then
If (yy3 > yg And yy1 < yg) Or (yy3 < yg And yy1 > yg) Then
kkks = kkks + 1
joint_co(kkks) = xx2
ElseIf yy3 > yg And yy1 > yg Then
kkks = kkks + 2
joint_co(kkks - 1) = xx2
joint_co(kkks) = xx2
ElseIf yy3 < yg And yy1 < yg Then
ixx = Fix((xx2 - xmin) / dx) + 1
iyy = Fix((yy2 - ymin) / dy) + 1
grid_dep((iyy - 1) * l + ixx) = 1
End If
End If
ElseIf yy1 = yg And yy2 = yg Then
kkks = kkks + 2
joint_co(kkks - 1) = xx1
joint_co(kkks) = xx2
End If
Next ii
'Sort the X_coordinates
For iii = 1 To kkks - 1
For jjj = iii + 1 To kkks
If joint_co(iii) > joint_co(jjj) Then
xs = joint_co(iii)
joint_co(iii) = joint_co(jjj)
joint_co(jjj) = xs
End If
Next jjj
Next iii
'Determining the grid_dep() values
kks = kkks \ 2
For iii = 1 To kks
For jjj = 1 To l
If grid_co((ij - 1) * l + jjj, 1) >= joint_co(2 * iii - 1) And grid_co((ij - 1) * l + jjj, 1) <= joint_co(2 * iii) Then
grid_dep((ij - 1) * l + jjj, j + 1) = 1
End If
Next jjj
Next iii
kk = kk + point_num(i1)
Next i1
Next ij
Close #2
'Open the unmapped region file and input the data
filename = file(2 * j + 1)
Open filename For Input As #2
Call InputEvi(evidence_co, point_num, region_num, 2)
For ij = 1 To k
yg = grid_co((ij - 1) * l + 1, 2)
kk = 0
For i1 = 1 To region_num
kkks = 0
For ii = kk + 1 To kk + point_num(i1) - 1
xx1 = evidence_co(ii, 1)
yy1 = evidence_co(ii, 2)
xx2 = evidence_co(ii + 1, 1)
yy2 = evidence_co(ii + 1, 2)
If ii < kk + point_num(i1) - 1 Then
xx3 = evidence_co(ii + 2, 1)
yy3 = evidence_co(ii + 2, 2)
ElseIf ii = kk + point_num(i1) - 1 Then
xx3 = evidence_co(kk + 2, 1)
yy3 = evidence_co(kk + 2, 2)
End If
'Determining the intersecting points of the scanning line and the polygon boundaries
If yy1 <> yy2 Then
If (yg > yy1 And yg < yy2) Or (yg < yy1 And yg > yy2) Then
kkks = kkks + 1
joint_co(kkks) = (xx2 - xx1) * (yg - yy1) / (yy2 - yy1) + xx1
ElseIf yg = yy2 Then
If (yy3 > yg And yy1 < yg) Or (yy3 < yg And yy1 > yg) Then
kkks = kkks + 1
joint_co(kkks) = xx2
ElseIf yy3 > yg And yy1 > yg Then
kkks = kkks + 2
joint_co(kkks - 1) = xx2
joint_co(kkks) = xx2
ElseIf yy3 < yg And yy1 < yg Then
ixx = Fix((xx2 - xmin) / dx) + 1
iyy = Fix((yy2 - ymin) / dy) + 1
grid_dep((iyy - 1) * l + ixx) = 0
End If
End If
ElseIf yy1 = yg And yy2 = yg Then
kkks = kkks + 2
joint_co(kkks - 1) = xx1
joint_co(kkks) = xx2
End If
Next ii
'Sort the X_coordinates
For iii = 1 To kkks - 1
For jjj = iii + 1 To kkks
If joint_co(iii) > joint_co(jjj) Then
xs = joint_co(iii)
joint_co(iii) = joint_co(jjj)
joint_co(jjj) = xs
End If
Next jjj
Next iii
'Determining the grid_dep() values
kks = kkks \ 2
For iii = 1 To kks
For jjj = 1 To l
If grid_co((ij - 1) * l + jjj, 1) >= joint_co(2 * iii - 1) And grid_co((ij - 1) * l + jjj, 1) <= joint_co(2 * iii) Then
grid_dep((ij - 1) * l + jjj, j + 1) = 0
End If
Next jjj
Next iii
kk = kk + point_num(i1)
Next i1
Next ij
Close #2
Next j
'Conditional independence test
kkd = 0
For i = 1 To k * l
If grid_dep(i, 1) = 1 Then
kkd = kkd + 1
End If
Next i
For j1 = 1 To m - 1
For j2 = j1 + 1 To m
'for Y+
kke1 = 0
kke2 = 0
kke3 = 0
kke4 = 0
kke11 = 0
kke12 = 0
kke21 = 0
kke22 = 0
'for Y-
kke5 = 0
kke6 = 0
kke7 = 0
kke8 = 0
kkef11 = 0
kkef12 = 0
kkef21 = 0
kkef22 = 0
For i = 1 To k * l
If grid_dep(i, 1) = 1 Then
If grid_dep(i, j1 + 1) = 1 Then
kke1 = kke1 + 1
ElseIf grid_dep(i, j1 + 1) = -1 Then
kke2 = kke2 + 1
End If
If grid_dep(i, j2 + 1) = 1 Then
kke3 = kke3 + 1
ElseIf grid_dep(i, j2 + 1) = -1 Then
kke4 = kke4 + 1
End If
If grid_dep(i, j1 + 1) = 1 And grid_dep(i, j2 + 1) = 1 Then
kke11 = kke11 + 1
ElseIf grid_dep(i, j1 + 1) = 1 And grid_dep(i, j2 + 1) = -1 Then
kke12 = kke12 + 1
ElseIf grid_dep(i, j1 + 1) = -1 And grid_dep(i, j2 + 1) = 1 Then
kke21 = kke21 + 1
ElseIf grid_dep(i, j1 + 1) = -1 And grid_dep(i, j2 + 1) = -1 Then
kke22 = kke22 + 1
End If
ElseIf grid_dep(i, 1) = 0 Then
If grid_dep(i, j1 + 1) = 1 Then
kke5 = kke5 + 1
ElseIf grid_dep(i, j1 + 1) = -1 Then
kke6 = kke6 + 1
End If
If grid_dep(i, j2 + 1) = 1 Then
kke7 = kke7 + 1
ElseIf grid_dep(i, j2 + 1) = -1 Then
kke8 = kke8 + 1
End If
If grid_dep(i, j1 + 1) = 1 And grid_dep(i, j2 + 1) = 1 Then
kkef11 = kkef11 + 1
ElseIf grid_dep(i, j1 + 1) = 1 And grid_dep(i, j2 + 1) = -1 Then
kkef12 = kkef12 + 1
ElseIf grid_dep(i, j1 + 1) = -1 And grid_dep(i, j2 + 1) = 1 Then
kkef21 = kkef21 + 1
ElseIf grid_dep(i, j1 + 1) = -1 And grid_dep(i, j2 + 1) = -1 Then
kkef22 = kkef22 + 1
End If
End If
Next i
If kke11 = 0 Then kke11 = 1
If kke12 = 0 Then kke12 = 1
If kke21 = 0 Then kke21 = 1
If kke22 = 0 Then kke22 = 1
If kkef11 = 0 Then kkef11 = 1
If kkef12 = 0 Then kkef12 = 1
If kkef21 = 0 Then kkef21 = 1
If kkef22 = 0 Then kkef22 = 1
sum1 = (CDbl(kke1) / CDbl(kkd)) * (CDbl(kke3) / CDbl(kkd)) * (CDbl(kkd) / CDbl(k * l)) / (CDbl(kke11) / CDbl(k * l))
sum2 = (CDbl(kke1) / CDbl(kkd)) * (CDbl(kke4) / CDbl(kkd)) * (CDbl(kkd) / CDbl(k * l)) / (CDbl(kke12) / CDbl(k * l))
sum3 = (CDbl(kke2) / CDbl(kkd)) * (CDbl(kke3) / CDbl(kkd)) * (CDbl(kkd) / CDbl(k * l)) / (CDbl(kke21) / CDbl(k * l))
sum4 = (CDbl(kke2) / CDbl(kkd)) * (CDbl(kke4) / CDbl(kkd)) * (CDbl(kkd) / CDbl(k * l)) / (CDbl(kke22) / CDbl(k * l))
sum5 = (CDbl(kke5) / CDbl(k * l - kkd)) * (CDbl(kke7) / CDbl(k * l - kkd)) * (CDbl(k * l - kkd) / CDbl(k * l)) / (CDbl(kkef11) / CDbl(k * l))
sum6 = (CDbl(kke5) / CDbl(k * l - kkd)) * (CDbl(kke8) / CDbl(k * l - kkd)) * (CDbl(k * l - kkd) / CDbl(k * l)) / (CDbl(kkef12) / CDbl(k * l))
sum7 = (CDbl(kke6) / CDbl(k * l - kkd)) * (CDbl(kke7) / CDbl(k * l - kkd)) * (CDbl(k * l - kkd) / CDbl(k * l)) / (CDbl(kkef21) / CDbl(k * l))
sum8 = (CDbl(kke6) / CDbl(k * l - kkd)) * (CDbl(kke8) / CDbl(k * l - kkd)) * (CDbl(k * l - kkd) / CDbl(k * l)) / (CDbl(kkef22) / CDbl(k * l))
If sum1 > 0 Then sum1 = Log(sum1)
If sum2 > 0 Then sum2 = Log(sum2)
If sum3 > 0 Then sum3 = Log(sum3)
If sum4 > 0 Then sum4 = Log(sum4)
If sum5 > 0 Then sum5 = Log(sum5)
If sum6 > 0 Then sum6 = Log(sum6)
If sum7 > 0 Then sum7 = Log(sum7)
If sum8 > 0 Then sum8 = Log(sum8)
ctest(j1, j2) = -2 * (sum1 + sum2 + sum3 + sum4)
ctest(j2, j1) = -2 * (sum1 + sum2 + sum3 + sum4 + sum5 + sum6 + sum7 + sum8)
ctest(j1, j2) = Abs(ctest(j1, j2))
ctest(j2, j1) = Abs(ctest(j2, j1))
Next j2
Next j1
'output the conditional independence test results
Open "c:\Chi_test.txt" For Output As #15
Print #15, "The estimated chi-square statistics:"
For j1 = 1 To m
For j2 = 1 To m
Print #15, ctest(j1, j2),
Next j2
Print #15,
Next j1
Close #15
'Calculating the weight coeficients and their variances for all map patterns
For j = 1 To m
kke1 = 0
kke2 = 0
kke3 = 0
kke4 = 0
kke5 = 0
kke6 = 0
For i = 1 To k * l
If grid_dep(i, j + 1) = 1 Then
kke5 = kke5 + 1
kke1 = kke1 + grid_dep(i, 1) * grid_dep(i, j + 1)
kke2 = kke2 + (1 - grid_dep(i, 1)) * grid_dep(i, j + 1)
ElseIf grid_dep(i, j + 1) = -1 Then
kke6 = kke6 + 1
kke3 = kke3 + grid_dep(i, 1) * (-grid_dep(i, j + 1))
kke4 = kke4 + (1 - grid_dep(i, 1)) * (-grid_dep(i, j + 1))
End If
Next i
If kke1 <> 0 And kke2 <> 0 And kke3 <> 0 And kke4 <> 0 And kke5 <> 0 And kke6 <> 0 Then
weight(j, 1) = Log(((CDbl(kke1)) / (CDbl(kkd))) / (((CDbl(kke2))) / (CDbl(k * l - kkd))))
weight(j, 2) = Log(((CDbl(kke3)) / (CDbl(kkd))) / (((CDbl(kke4))) / (CDbl(k * l - kkd))))
weightvar(j, 1) = 1# / CDbl(kke1) + 1# / CDbl(kke2)
weightvar(j, 2) = 1# / CDbl(kke3) + 1# / CDbl(kke4)
misdeviate(j) = (CDbl(kke1) / CDbl(kke5) - CDbl(kkd) / CDbl(k * l)) ^ 2 * (CDbl(kke5) / CDbl(k * l)) + (CDbl(kke3) / CDbl(kke6) - CDbl(kkd) / CDbl(k * l)) ^ 2 * (CDbl(kke6) / CDbl(k * l))
Else
weight(j, 1) = 0#
weight(j, 2) = 0#
weightvar(j, 1) = 0#
weightvar(j, 2) = 0#
End If
Next j
'output the weight coefficients and their variances
Open "c:\weights.txt" For Output As #10
Print #10, "The two estimated weights and their deviations:"
For j = 1 To m
Print #10, weight(j, 1), weightvar(j, 1), weight(j, 2), weightvar(j, 2), misdeviate(j)
Next j
Close #10
'Calculating the posterior probabilities and posterior probability deviations for all grids
For i = 1 To k * l
sum1 = 0#
sum2 = 0#
sum3 = 0#
sum4 = 0#
sum5 = 0#
For j = 1 To m
If grid_dep(i, j + 1) = 1 Then
sum1 = sum1 + weight(j, 1)
sum3 = sum3 + weightvar(j, 1)
ElseIf grid_dep(i, j + 1) = -1 Then
sum2 = sum2 + weight(j, 2)
sum4 = sum4 + weightvar(j, 2)
ElseIf grid_dep(i, j + 1) = 0 Then
sum5 = sum5 + misdeviate(j)
End If
Next j
odds(i) = Exp(sum1 + sum2)
sum1 = odds(i)
odds(i) = sum1 / (1 + sum1)
postdeviate(i) = Sqr((1# / CDbl(kkd) + sum3 + sum4) * odds(i) + sum5)
Next i
'Output the results into the MapInfo Interchange files (*.mif and *.mid)
filename = Text4.Text
Open filename For Output As #3
ii = Len(Trim(filename))
filename1 = Left(Trim(filename), ii - 3) + "mid"
Open filename1 For Output As #4
filename2 = Left(Trim(filename), ii - 3) + "grd"
Open filename2 For Output As #5
filename3 = Left(Trim(filename), ii - 4) + "1." + "grd"
Open filename3 For Output As #6
Call Output1(grid_co, grid_dep, odds, postdeviate, 3, 4, 5, 6, xmin, ymin, xmax, ymax, m, k, l, "PostProbability")
Close #3
Close #4
Close #5
Close #6
Screen.MousePointer = vbDefault
map_form.Print " Program Runs OK!"
Exit Sub
errprint:
Screen.MousePointer = vbDefault
ShowError
Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -