+ʢk

来自「模糊数学基础及实用算法 (源码) 科学出版社 www.sciencep.com」· 代码 · 共 101 行

Attribute VB_Name = "modMethod"
'模糊物元分析
'计算隶属度方法模块
Option Explicit
'模式I：
'越大越优型
'R(1 To n)：模糊物元分析数据矩阵
Public Sub Method1(X() As Double)
    Dim N As Integer, I As Integer
    Dim dC1 As Double, dC2 As Double
    N = UBound(X, 1)                        'N:事物数
    dC1 = X(1): dC2 = X(1)
    For I = 1 To N
        If dC1 < X(I) Then dC1 = X(I)       'dC1为极大值
        If dC2 > X(I) Then dC2 = X(I)       'dC2为极小值
    Next I
    For I = 1 To N
        X(I) = X(I) / dC1
    Next I
    For I = 1 To N
        X(I) = Int((X(I) + 0.00005) * 10000) / 10000
    Next I
End Sub

'越小越优型
'R(1 To n)：模糊物元分析数据矩阵
Public Sub Method0(X() As Double)
    Dim N As Integer, I As Integer
    Dim dC1 As Double, dC2 As Double
    N = UBound(X, 1)                        'N:事物数
    dC1 = X(1): dC2 = X(1)
    For I = 1 To N
        If dC1 < X(I) Then dC1 = X(I)       'dC1为极大值
        If dC2 > X(I) Then dC2 = X(I)       'dC2为极小值
    Next I
    For I = 1 To N
        X(I) = dC2 / X(I)
    Next I
    For I = 1 To N
        X(I) = Int((X(I) + 0.00005) * 10000) / 10000
    Next I
End Sub
    
'近常数最优型
'R(1 To n)：模糊物元分析数据矩阵
Public Sub Method2(X() As Double, U0 As Double)
    Dim N As Integer, I As Integer
    Dim dC1 As Double, dC2 As Double
    N = UBound(X, 1)                        'N:事物数
    dC1 = X(1): dC2 = X(1)
    For I = 1 To N
        If U0 < X(I) Then dC1 = U0 Else dC1 = X(I)
        If U0 > X(I) Then dC2 = U0 Else dC2 = X(I)
        X(I) = dC1 / dC2
    Next I
    For I = 1 To N
        X(I) = Int((X(I) + 0.00005) * 10000) / 10000
    Next I
End Sub

'模式II：
'越大越优型
'R(1 To n)：模糊物元分析数据矩阵
Public Sub Method21(X() As Double)
    Dim N As Integer, I As Integer
    Dim dC1 As Double, dC2 As Double
    N = UBound(X, 1)                        'N:事物数
    dC1 = X(1): dC2 = X(1)
    For I = 1 To N
        If dC1 < X(I) Then dC1 = X(I)       'dC1为极大值
        If dC2 > X(I) Then dC2 = X(I)       'dC2为极小值
    Next I
    For I = 1 To N
        X(I) = (X(I) - dC2) / (dC1 - dC2)
    Next I
    For I = 1 To N
        X(I) = Int((X(I) + 0.00005) * 10000) / 10000
    Next I
End Sub

'越小越优型
'R(1 To n)：模糊物元分析数据矩阵
Public Sub Method20(X() As Double)
    Dim N As Integer, I As Integer
    Dim dC1 As Double, dC2 As Double
    N = UBound(X, 1)                        'N:事物数
    dC1 = X(1): dC2 = X(1)
    For I = 1 To N
        If dC1 < X(I) Then dC1 = X(I)       'dC1为极大值
        If dC2 > X(I) Then dC2 = X(I)       'dC2为极小值
    Next I
    For I = 1 To N
        X(I) = (dC1 - X(I)) / (dC1 - dC2)
    Next I
    For I = 1 To N
        X(I) = Int((X(I) + 0.00005) * 10000) / 10000
    Next I
End Sub