PHỤ LỤC 1 : MÃ NGUỒN CHƢƠNG TRÌNH
1 MODULE TÍNH KHOẢNG CÁCH GIỮA CÁC PHẦN TỬ
1.3 Tính khoảng cách hỗn hợp (công thức Kaufman và Rousseeuw)
'Arr1(),Arr2() là hai mảng lƣu dữ liệu để tính khoảng cách 'Arr3() là mảng lƣu kỉeu dữ liệu tƣơng ứng
'Có các kiểu dữ liệu nhƣ sau 'BINARY: nhị phân 'NORMINAL: định danh 'ODINAL: thứ tự
'INTERVAL: khoảng cáh 'RATIO: tỷ lệ
'Công thức tính: Kaufman và Rousseeuw
Public Function Mixed_distance (Arr1() As String, Arr2() As String, Arr3() As String) As Double
Dim Count As Integer Dim i As Double Dim j As Integer
Dim Sum As Double Dim Total As Double
' Tu so va mau so trong cong thuc Kaufman và Rousseeuw
Dim Max_ As Double Dim Min_ As Double Dim Max1_ As Double Dim Min1_ As Double Dim Max2_ As Double Dim Min2_ As Double
Dim a() As Double Dim b() As Double Dim c() As Double Dim d() As Double Dim e() As Double
'Cac mang tam de luu trong qua trinh tinh toan
Dim Check As Boolean Dim DArr1() As Variant Dim DArr2() As Variant
If UBound(Arr1) <> UBound(Arr2) Then
MsgBox "So luong phan tu hai mang phai bang nhau" Else
Count = UBound(Arr1) End If
Sum = 0 ' Tu so ap dung cho cong thuc Total = 0 ' Mau so ap dung cho cong thuc
ReDim a(Count), b(Count), c(Count), d(Count), e(Count) As Double For i = 0 To Count a(i) = 0 b(i) = 0 c(i) = 0 d(i) = 0 e(i) = 0 Next i
'Doan chuong trinh kiem tra xem co phai tat ca du lieu co cung kieu khong Check = True
If Arr3(0) = "UNKNOW" Then Check = False
Else
For i = 0 To Count
If Arr3(i) <> Arr3(0) Then Check = False
End If Next i End If
If Check = True Then
'Tinh cho mot loai du lieu dong nhat Select Case Arr3(0)
Case "BINARY" 'Nhi phan doi xung For i = 0 To Count
If (Arr1(i) = Arr2(i)) Then If Arr1(i) = 1 Then a(i) = a(i) + 1 Else d(i) = d(i) + 1 End If Else If Arr1(i) = 1 Then c(i) = c(i) + 1 Else b(i) = b(i) + 1 End If End If
Sum = Sum + b(i) + c(i)
Total = Total + a(i) + b(i) + c(i) + d(i)
Next i
Case "ABINARY" 'Nhi phan bat doi xung For i = 0 To Count
If (Arr1(i) = Arr2(i)) Then If Arr1(i) = 1 Then a(i) = a(i) + 1 Else d(i) = d(i) + 1 End If Else If Arr1(i) = 1 Then c(i) = c(i) + 1 Else b(i) = b(i) + 1 End If End If
Sum = Sum + b(i) + c(i)
Total = Total + a(i) + b(i) + c(i)
Next i
Case "NORMINAL" For i = 0 To Count
If Arr1(i) <> Arr2(i) Then Sum = Sum + 1 End If Next i Total = Count Case "INTERVAL"
'Truong hop nay se ap dung cong thuc Oclit hoac Manhattan For i = 0 To Count
DArr1(i) = Val(Trim(Arr1(i))) DArr2(i) = Val(Trim(Arr2(i))) Next i
Mixed_distance = Euclid_Distance(DArr1, DArr2) Exit Function
Case "ORDINAL" For i = 0 To Count
Sum = Sum + Abs(Arr1(i) - Arr2(i)) Next i
Total = Count End Select
Else ' Cac bien co kieu khac nhau For i = 0 To Count
Select Case Arr3(i) Case "BINARY"
d(i) = 1 Else d(i) = 0 End If e(i) = 1 Case "ABINARY"
If Arr1(i) = Arr2(i) Then d(i) = 1 If Arr1(i) = 0 Then e(i) = 0 Else e(i) = 1 End If Else d(i) = 0 e(i) = 1 End If Case "NORMINAL" If Arr1(i) = Arr2(i) Then d(i) = 0 Else d(i) = 1 End If e(i) = 1 Case "INTERVAL"
'Tim max, min cua cac phan tu hai mang Arr1, Arr2 Max1_ = FindMax(Arr1, Arr3, "INTERVAL") Max2_ = FindMax(Arr2, Arr3, "INTERVAL") If Max1_ > Max2_ Then
Max_ = Max1_ Else
Max_ = Max2_ End If
Min1_ = FindMin(Arr1, Arr3, "INTERVAL") Min2_ = FindMin(Arr2, Arr3, "INTERVAL") If Min1_ > Min2_ Then
Min_ = Min2_ Else
Min_ = Min1_ End If
'Chuan hoa d(i) If Max_ > 0 Then
d(i) = Abs(Val(Trim(Arr1(i))) - Val(Trim(Arr2(i)))) / (Max_ - Min_) Else
d(i) = Abs(Val(Trim(Arr1(i))) - Val(Trim(Arr2(i)))) / Max_ End If Else d(i) = 0 End if e(i) = 1 Case "ORDINAL"
'Tim max, min cua cac phan tu hai mang Arr1, Arr2 Max1_ = FindMax(Arr1, Arr3, "ORDINAL") Max2_ = FindMax(Arr2, Arr3, "ORDINAL") If Max1_ > Max2_ Then
Max_ = Max1_ Else
Max_ = Max2_ End If
Min1_ = FindMin(Arr1, Arr3, "ORDINAL") Min2_ = FindMin(Arr2, Arr3, "ORDINAL") If Min1_ > Min2_ Then
Min_ = Min2_ Else
Min_ = Min1_ End If
'Chuan hoa d(i)
If Max_ <> Min_ Then
d(i) = Abs(Val(Trim(Arr1(i))) - Val(Trim(Arr2(i)))) / (Max_ - Min_) Else
d(i) = Abs(Val(Trim(Arr1(i))) - Val(Trim(Arr2(i)))) / Max_ End If
e(i) = 1 Case "RATIO"
'Tim max, min cua cac phan tu hai mang Arr1, Arr2 Max1_ = FindMax(Arr1, Arr3, "RATIO")
Max2_ = FindMax(Arr2, Arr3, "RATIO") If Max1_ > Max2_ Then
Max_ = Max1_ Else
Max_ = Max2_ End If
Min1_ = FindMin(Arr1, Arr3, "RATIO") Min2_ = FindMin(Arr2, Arr3, "RATIO") If Min1_ > Min2_ Then
Min_ = Min2_ Else
Min_ = Min1_ End If
'Chuan hoa d(i)
If Max_ <> Min_ Then
d(i) = Abs((Val(Trim(Arr1(i))) - Val(Trim(Arr2(i))))) / (Max_ - Min_) Else
d(i) = Abs((Val(Trim(Arr1(i))) - Val(Trim(Arr2(i))))) / Max_ End If
e(i) = 1
Case "UNKNOW" End Select
Sum = Sum + d(i) Total = Total + e(i) Next i
End If
If Total <> 0 Then
Mixed_distance = Sum / Total Else
Mixed_distance = 0 End If