frmfuzzy.frm

用VB开发的基于模糊数学的水质评价中的应用实例

VERSION 5.00
Begin VB.Form frmfuzzy 
   Caption         =   "Form4"
   ClientHeight    =   3480
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3915
   LinkTopic       =   "Form4"
   ScaleHeight     =   3480
   ScaleWidth      =   3915
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   2400
      TabIndex        =   8
      Top             =   2760
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   375
      Left            =   600
      TabIndex        =   7
      Top             =   2760
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Index           =   2
      Left            =   1560
      TabIndex        =   6
      Top             =   1800
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Index           =   1
      Left            =   1560
      TabIndex        =   5
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Index           =   0
      Left            =   1560
      TabIndex        =   4
      Top             =   600
      Width           =   1215
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "标准级别数："
      Height          =   180
      Left            =   360
      TabIndex        =   3
      Top             =   1920
      Width           =   1080
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "样品数："
      Height          =   180
      Left            =   360
      TabIndex        =   2
      Top             =   1320
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "评价因子数："
      Height          =   180
      Left            =   360
      TabIndex        =   1
      Top             =   720
      Width           =   1080
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请输入："
      Height          =   180
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   720
   End
End
Attribute VB_Name = "frmfuzzy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
Dim n As Integer, nn As Integer, m As Integer, zw As Double
Dim c() As Double, d() As Double, a() As Double, r() As Double, s() As Double, _
    e() As Double, w() As Double, f() As Double, b() As Double, g() As Double, h() As Double

    n = Text1(0).Text
    nn = Text1(1).Text
    m = Text1(2).Text
ReDim c(1 To n, 1 To (m + 1)) As Double, d(1 To n) As Double
ReDim b(m) As Double, f(m) As Double, g(m) As Double, h(m) As Double
ReDim a(1 To n) As Double, r(1 To n, 1 To (m + 1)) As Double, _
      s(1 To n) As Double, e(1 To n, 1 To m) As Double, w(1 To n, 1 To m) As Double
Open "e:\fuzzy\c.txt" For Input As #1
Open "e:\fuzzy\b.txt" For Output As #6
Open "e:\fuzzy\d.txt" For Input As #2

For i = 1 To n
    For j = 1 To m + 1
       Input #1, c(i, j)
    Next j
    Input #2, d(i)
Next i

       
For i = 1 To n
    s(i) = 0#
    For j = 1 To m
        r(i, j) = 0#
        If (d(i) < c(i, 1)) Then r(i, 1) = 1#
        If (d(i) >= c(i, m)) Then r(i, 1) = 1#
        If (d(i) > c(i, j) And d(i) < c(i, j + 1)) Then
            r(i, j) = (c(i, j + 1) - d(i)) / (c(i, j + 1) - c(i, j))
            r(i, j + 1) = (d(i) - c(i, j)) / (c(i, j + 1) - c(i, j))
            GoTo 10
        End If
    Next j
10:
    For j = 1 To m
        s(i) = c(i, j) / m + s(i)
    Next j
Next i
zw = 0#
For i = 1 To n
    a(i) = d(i) / s(i)
    zw = a(i) + zw
Next i
For j = 1 To m
    b(j) = 0#
    f(j) = 0#
    g(j) = 0#
    h(j) = 0#
    For i = 1 To n
        a(i) = a(i) / zw
        e(i, j) = a(i) * r(i, j)
        w(i, j) = min(a(i), r(i, j))
            If (f(j) < e(i, j)) Then f(j) = e(i, j)
            If (b(j) < w(i, j)) Then b(j) = w(i, j)
            g(j) = g(j) + e(i, j)
            h(j) = h(j) + w(i, j)
    Next i
Next j
dd = 0#
For j = 1 To m
    If (h(j) > 1#) Then h(j) = 1#
    dd = g(j) + dd
Next j
For j = 1 To m
    g(j) = g(j) / dd
Next j
For j = 1 To m
    Write #6, b(j), f(j), g(j), h(j)
    Debug.Print b(j), f(j), g(j), h(j)

Next j

End Sub

Private Sub Command2_Click()
End
End Sub