模糊识别m3.bas

来自「用VB编写的基于模糊数学原理的模糊识别程序」· BAS 代码 · 共 90 行

Attribute VB_Name = "modMethod"
'模糊识别
'贴近度方法模块
Option Explicit
'格贴近度
'A(1 To M)：待定样本，M为元素数或指标数
'B(1 To M)：标准模型，M为元素数或指标数
'C为贴近度
Public Sub MM1(A() As Double, B() As Double, C As Double)
    Dim M As Integer, I As Integer
    Dim dM1 As Double, dM2 As Double
    Dim dC1 As Double, dC2 As Double
    M = UBound(A, 1)          'M:元素数或指标数
    dM1 = 0: dM2 = 1
    For I = 1 To M
        If A(I) < B(I) Then dC1 = A(I) Else dC1 = B(I)
        If A(I) > B(I) Then dC2 = A(I) Else dC2 = B(I)
        If dC1 > dM1 Then dM1 = dC1
        If dC2 < dM2 Then dM2 = dC2
    Next I
    C = (dM1 + (1 - dM2)) / 2
End Sub

'海明贴近度
'A(1 To M)：待定样本，M为元素数或指标数
'B(1 To M)：标准模型，M为元素数或指标数
'C为贴近度
Public Sub MM2(A() As Double, B() As Double, C As Double)
    Dim M As Integer, I As Integer
    Dim D As Double
    M = UBound(A, 1)          'M:元素数或指标数
    D = 0
    For I = 1 To M
        D = D + Abs(A(I) - B(I))
    Next I
    C = 1 - D / M
End Sub
    
'欧氏贴近度
'A(1 To M)：待定样本，M为元素数或指标数
'B(1 To M)：标准模型，M为元素数或指标数
'C为贴近度
Public Sub MM3(A() As Double, B() As Double, C As Double)
    Dim M As Integer, I As Integer
    Dim D As Double
    M = UBound(A, 1)          'M:元素数或指标数
    D = 0
    For I = 1 To M
        D = D + (A(I) - B(I)) ^ 2
    Next I
    C = 1 - Sqr(D / M)
End Sub

'最大最小法
'A(1 To M)：待定样本，M为元素数或指标数
'B(1 To M)：标准模型，M为元素数或指标数
'C为贴近度
Public Sub MM4(A() As Double, B() As Double, C As Double)
    Dim M As Integer, I As Integer
    Dim dMin As Double, dMax As Double
    Dim dC1 As Double, dC2 As Double
    M = UBound(A, 1)          'M:元素数或指标数
    For I = 1 To M
        If A(I) < B(I) Then dC1 = A(I) Else dC1 = B(I)
        If A(I) > B(I) Then dC2 = A(I) Else dC2 = B(I)
        dMin = dMin + dC1
        dMax = dMax + dC2
    Next I
    C = dMin / dMax
End Sub

'算术平均值最小法
'A(1 To M)：待定样本，M为元素数或指标数
'B(1 To M)：标准模型，M为元素数或指标数
'C为贴近度
Public Sub MM5(A() As Double, B() As Double, C As Double)
    Dim M As Integer, I As Integer
    Dim dMin As Double
    Dim dC1 As Double, dC2 As Double, dC As Double
    M = UBound(A, 1)          'M:元素数或指标数
    For I = 1 To M
        If A(I) < B(I) Then dC1 = A(I) Else dC1 = B(I)
        dMin = dMin + dC1
        dC2 = A(I) + B(I)
        dC = dC + dC2
    Next I
    C = 2 * dMin / dC
End Sub