map_form.frm

mif,mid文件的读写 和一些人工智能模型

        grid_co(grid_no, 10) = yy2
        grid_co(grid_no, 11) = xx1
        grid_co(grid_no, 12) = yy1
        
      Next j
    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
  
  'Calculating the certainty factors for all map patterns
   kkd = 0
   For i = 1 To k * l
     If grid_dep(i, 1) = 1 Then
       kkd = kkd + 1
     End If
   Next i
   For j = 1 To m
       kke1 = 0
       kke2 = 0
       kke = 0
       kkef = 0
       For i = 1 To k * l
          If grid_dep(i, j + 1) = 1 Then
             kke1 = kke1 + grid_dep(i, 1) * grid_dep(i, j + 1)
             kke = kke + 1
          ElseIf grid_dep(i, j + 1) = -1 Then
             kke2 = kke2 + grid_dep(i, 1) * (-grid_dep(i, j + 1))
             kkef = kkef + 1
          End If
       Next i
       py = CDbl(kkd) / CDbl(k * l)
       pyz = CDbl(kke1) / CDbl(kke)
       pyzf = CDbl(kke2) / CDbl(kkef)
       If pyz >= py Then
          cf(j, 1) = (pyz - py) / ((1 - py) * pyz)
       Else
          cf(j, 1) = (pyz - py) / (py * (1 - pyz))
       End If
       If pyzf >= py Then
          cf(j, 2) = (pyzf - py) / ((1 - py) * pyzf)
       Else
          cf(j, 2) = (pyzf - py) / (py * (1 - pyzf))
       End If
   Next j
  
  'Synthesizing the bpa functions for all grid cells
   If m >= 2 Then
     For i = 1 To k * l
       myz = 1
       myf = 1
       For j = 1 To m
         If (grid_dep(i, j + 1) = 1 And cf(j, 1) > 0) Or (grid_dep(i, j + 1) = -1 And cf(j, 2) > 0) Then
           If grid_dep(i, j + 1) = 1 Then
             myz = myz * (1 - cf(j, 1))
           ElseIf grid_dep(i, j + 1) = -1 Then
             myz = myz * (1 - cf(j, 2))
           End If
         ElseIf (grid_dep(i, j + 1) = 1 And cf(j, 1) < 0) Or (grid_dep(i, j + 1) = -1 And cf(j, 2) < 0) Then
           If grid_dep(i, j + 1) = 1 Then
             myf = myf * (1 + cf(j, 1))
           ElseIf grid_dep(i, j + 1) = -1 Then
             myf = myf * (1 + cf(j, 2))
           End If
         ElseIf grid_dep(i, j + 1) = 0 Then
             myz = 0
         End If
       Next j
       myz = 1# - myz
       myf = 1# - myf
       km = 1# / (1# + myz * (-1# * myf))
       bpa(i) = km * myz * (1# + (-1# * myf))
     Next i
   Else
     For i = 1 To k * l
       If grid_dep(i, 2) = 1 Then
         If cf(1, 1) > 0 Then
            bpa(i) = cf(1, 1)
         ElseIf cf(1, 1) <= 0 Then
            bpa(i) = 0
         End If
       ElseIf grid_dep(i, 2) = -1 Then
         If cf(1, 2) > 0 Then
           bpa(i) = cf(1, 2)
         ElseIf cf(1, 2) <= 0 Then
           bpa(i) = 0
         End If
       ElseIf grid_dep(i, 2) = 0 Then
         bpa(i) = 0
       End If
     Next i
   End If
   
  '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
   Call Output(grid_co, grid_dep, bpa, 3, 4, 5, xmin, ymin, xmax, ymax, m, k, l, "CombinedBPA")
   Close #3
   Close #4
   Close #5
   
   Screen.MousePointer = vbDefault
   
   map_form.Print " Program Runs OK!"
   Exit Sub
errprint:
   
   Screen.MousePointer = vbDefault
   
   ShowError
   Exit Sub
   
End Sub

Private Sub Exit_Click()
 Unload map_form
End Sub

Private Sub WEM_Click()
   
   SetHourglass
   
   '//////////////////////////////////////////////////////////
   'THIS PROGRAM IS FOR WEIGHTS OF EVIDENCE MODELING PROCEDURE
   'ORIGINATED BY:  CHEN YONGLIANG
   'AFFILIATE TO:   JILIN UNIVERSITY, CHANGCHUN P.R.CHINA
   'DATE:           SEPTEMBER 20,2000
   '///////////////////////////////////////////////////////////
   
   
    Dim xmin As Double, xmax As Double, ymin As Double, ymax As Double, xx As Double, yy As Double, yg As Double
    Dim dx As Double, dy As Double
    Dim m As Integer, np As Integer, k As Integer, l As Integer
    Dim grid_no  As Integer, i As Integer, ii As Integer, ij As Integer, j As Integer, deposit_num As Integer, ixx As Integer, iyy As Integer
    Dim grid_co() As Double, deposit_co(1000, 2) As Double, evidence_co(10000, 2) As Double, joint_co(100) As Double
    Dim grid_dep() As Integer, point_num(1000) As Integer
    Dim weight() As Double, odds() As Double
    Dim filename As String * 80, filename1 As String * 80, filename2 As String * 80, filename3 As String * 80
    Dim region_num As Integer, kk As Integer, i1 As Integer, kkks As Integer, iii As Integer, jjj As Integer
    Dim kks As Integer, kkd As Integer, kke1 As Integer, kke2 As Integer, kke3 As Integer, kke4 As Integer
    Dim kke5 As Integer, kke6 As Integer, kke7 As Integer, kke8 As Integer
    Dim kke11 As Integer, kke12 As Integer, kke21 As Integer, kke22 As Integer
    Dim kkef11 As Integer, kkef12 As Integer, kkef21 As Integer, kkef22 As Integer
    Dim j1 As Integer, j2 As Integer
    Dim ctest() As Double, misdeviate() As Double, postdeviate() As Double, weightvar() As Double
    Dim xs As Double, xx1 As Double, xx2 As Double, xx3 As Double
    Dim yy1 As Double, yy2 As Double, yy3 As Double
    Dim ccc As Double, sum1 As Double, sum2 As Double, sum3 As Double, sum4 As Double, sum5 As Double, sum6 As Double, sum7 As Double, sum8 As Double
    Dim file() As String * 80
    
   'The number of evidences
    m = Val(Text1.Text)
    
   'The number of scanning lines
    k = Val(Text2.Text)
    
    ReDim file(2 * m + 1)
    
    On Error GoTo errprint
   'Open *.txt file and input map layer file names and addresses
    filename = Text3.Text
    Open filename For Input As #1
    For i = 1 To 2 * m + 1
      Input #1, file(i)
    Next i
    Close #1
    
   'Open the *.mif file and input the data of deposit map layer
    filename = file(1)
    Open filename For Input As #1
    Call InputDep(deposit_co, deposit_num, 1, xmin, ymin, xmax, ymax)
    Close #1

    ccc = (xmax - xmin) / (ymax - ymin)
    
   'The number of columns
    l = CInt(k * ccc)

    dx = (xmax - xmin) / CDbl(l)
    dy = (ymax - ymin) / CDbl(k)
    
    
    ReDim grid_co(k * l, 12), grid_dep(k * l, m + 1), odds(k * l), weight(m, 3), ctest(m, m)
    ReDim weightvar(m, 2), postdeviate(k * l), misdeviate(m)
 
   'Generate the uniform grid cells
    For i = 1 To k
      For j = 1 To l
        grid_no = (i - 1) * l + j
        xx = xmin + j * dx - dx / 2#
        yy = ymin + i * dy - dy / 2#
        xx1 = xx - dx / 2#
        yy1 = yy - dy / 2#
        xx2 = xx + dx / 2#
        yy2 = yy + dy / 2#
        grid_co(grid_no, 1) = xx
        grid_co(grid_no, 2) = yy
        grid_co(grid_no, 3) = xx1
        grid_co(grid_no, 4) = yy1
        grid_co(grid_no, 5) = xx2
        grid_co(grid_no, 6) = yy1
        grid_co(grid_no, 7) = xx2
        grid_co(grid_no, 8) = yy2
        grid_co(grid_no, 9) = xx1
        grid_co(grid_no, 10) = yy2
        grid_co(grid_no, 11) = xx1
        grid_co(grid_no, 12) = yy1
      Next j