Дипломна работа на Пламена Димитрова Чонгова F18015 на тема програмна система за многокритериален анализ mka 2

Клас ElectreObj

• 
  CriterProp – съхранява типа на критерия;
  
• 
  MinMaxProp – съхранява свойството минимален / максимален за критерия;
  
• 
  Threshold_Unit – съхранява въведената мерна единицата, характеризираща критерия;
  
• 
  Weight – съхранява въведения тегловен коефициент от ЛВР;
  
• 
  Veto_threshold – съхранява въведената стойност за вето-праг
  
• 
  Ind_Threshold – съхранява въведената стойност за праг на предпочитание;
  
• 
  Pre_Threshold – съхранява въведената стойност за праг на безразличие;
  
• 
  Aver_Performance – съхранява типа на въведените стойности за активните прагови полета в процентен или числов вид;
  
• 
  MaxMinDiff – съхранява стойността, получена от разликата между максималната и минималната стойност за критерия по отношение на всички алтернативи;
  
• 
  Unit – съхранява стойността на средно предпочитание за даден критерий;
  
• 
  IsPropSet – съхранява 0 или 1, в зависимост дали е попълнена цялата информация за критерия;
  
• 
  Check1Status – проверява дали е активиран вето-прага.
  

Форма за въвеждане на допълнителна информация, изискваща се за метода ELECTRE.

При зареждане на формата се извиква процедурата Form_Load, инициализира се променливата ElectreVisible със стойност True. Инициализира се масив от обекти PropStore със свойствата му, всеки обект от масива представлява критерий, а свойствата съхраняват въведената информация от ЛВР. Инициализира се масива AverPerf, който съхранява стойността на средното предпочитание за всеки критерий, изчислява се като сума от всички стойности за критерия по отношение на всички алтернативи, разделена на броя алтернативи.

Public Sub Form_Load()

Dim i, j, k As Integer

Dim AverBuf As Double

Dim AverBufTemp As Double

Dim AverPerfF As Double

CenterForm Electre

Command1.Picture = MDIForm1.ImageList3.ListImages(16).Picture

Command2.Picture = MDIForm1.ImageList3.ListImages(18).Picture

Command3.Picture = MDIForm1.ImageList3.ListImages(2).Picture

s = False

h = False

Option1.Value = True

Text(9).Text = ""

Text(9).Visible = False

Text(9).Enabled = False

Text(10).Text = ""

Text(10).Visible = False

Text(10).Enabled = False

Text(11).Text = ""

Text(11).Visible = False

Text(11).Enabled = False

Check1.Value = 0

FlagProcent = 0

BufValP = 0

BufValVeto = 0

ElectreVisible = True

DataIsSet = False

ChangeLanguage_Electre

Show_Hide True, False

MSFlexGrid1.BackColorSel = &H8000000D

MSFlexGrid1.Tag = 1

ReDim Preserve ElectrePropStore(G_Crit_Number - 1)

k = 0

ReDim AverPerf(G_Crit_Number - 1)

For i = 0 To G_Crit_Number - 1

For j = 0 To G_Alt_Number - 1

AverBufTemp = MegaMatrix(i, j)

AverBuf = AverBuf + AverBufTemp

Next

AverPerfF = AverBuf / G_Alt_Number

AverBufTemp = 0

AverBuf = 0

AverPerfF = 0

Next

'=============== End Find Average Performance==================

FlagMaxMinDiff = False

KeyPreview = True

Rezult = False

If PrinterVisible = True Then

Form8.Check7.Enabled = True

End If

End Sub
При настъпване на събитие “натиснат клавиш” на текстовите полета Text(3), Text(4), Text(5), Text(6) и Text(7) се извиква процедурата Text_KeyPress, която получава като параметър индекса на съответното текстово поле и ASCII кода на натиснатия клавиш за обработка.

If index = 7 Then Exit Sub

CurText = ""

CurText = Text(index).Text

If Text(index).SelLength = Len(Text(index).Text) And KeyAscii = 8 Then

Text(index).Text = ""

Else

KeyPressCheck (KeyAscii)

End If

Извиква се процедурата KeyPressCheck, която обработва получения като параметър натиснат клавиш и го връща обратно на процедурата Text_KeyPress. Ако полученият символ съдържа ASCII кода на буква, то процедурата връща грешка.

Private Sub KeyPressCheck(KeyAscii As Integer)

If KeyAscii = 8 Then

If Len(CurText) > 0 Then CurText = Left(CurText, Len(CurText) - 1)

Exit Sub

If ((KeyAscii >= 48) And (KeyAscii <= 57)) Or (Chr(KeyAscii) = GetDecimalSep) Then

If Chr(KeyAscii) = GetDecimalSep Then

If InStr(CurText, GetDecimalSep) <> 0 Then Exit Sub

End If

CurText = CurText + Chr(KeyAscii)

End If

Private Sub Check1_Click()

If Check1.Value = 0 Then

Text(4).Enabled = True

Text(4).BackColor = &H80000018

Text(9).Enabled = True

Text(9).BackColor = &H80000018

Else

Text(9).Text = ""

Text(4).BackColor = &H80000013

Text(9).BackColor = &H80000013

Text(4).Enabled = False

Text(9).Enabled = False

Text(9).Visible = False

End If

Private Sub Option1_Click()

If Option1.Value = True Then

If (Text(9).Enabled = True And Text(9).Text = "") Or (Text(10).Enabled = True And Text(10).Text = "") Or (Text(11).Enabled = True And Text(11).Text = "") Then

Option1.Value = False

G_Mesg.errormsg 91

Option2.Value = True

Exit Sub

Show_Hide False, True

If FlagProcent = True And FlagMaxMinDiff = True Then

If DataIsSet = False Then

If Check1.Value = 0 Then

Text(4).Text = Round(CDbl(Text(9).Text) * MaxMinDiff(MSFlexGrid1.Col - 1) / 100, 4)

ElseIf Text(9).Enabled = True And Text(9).Visible = False Then

Text(9).Text = ""

Text(9).Enabled = False

Text(9).Visible = False

End If

Text(5).Text = Round(CDbl(Text(10).Text) * MaxMinDiff(MSFlexGrid1.Col - 1) / 100, 4)

End If

Text(10).Text = ""

Text(11).Text = ""

Text(9).Visible = False

Text(9).Enabled = False

Text(10).Visible = False

Text(10).Enabled = False

Text(11).Visible = False

Text(11).Enabled = False

FlagProcent = False

End If

End If

Private Sub Option2_Click()

If FlagMaxMinDiff = True Then

If Check1.Value = 0 Then

If Text(4).Text = "" Or Text(5).Text = "" Or Text(8).Text = "" Then

G_Mesg.errormsg 260

Option1.Value = True

Option2.Value = False

Exit Sub

End If

Label38.ForeColor = &H80000012

BufValQ = CDbl(Text(4).Text)

Text(9).Enabled = True

Text(9).Visible = True

Text(9).Text = Round((BufValQ * 100) / MaxMinDiff(MSFlexGrid1.Col - 1), 4)

BufValQ = 0

Label24.ForeColor = &H80000012

BufValVeto = CDbl(Text(5).Text)

Text(10).Enabled = True

Text(10).Visible = True

Text(10).Text = Round((BufValVeto * 100) / MaxMinDiff(MSFlexGrid1.Col - 1), 4)

BufValVeto = 0

Label26.ForeColor = &H80000012

BufValP = CDbl(Text(8).Text)

Text(11).Enabled = True

Text(11).Visible = True

Text(11).Text = Round((BufValP * 100) / MaxMinDiff(MSFlexGrid1.Col - 1), 4)

BufValP = 0

FlagProcent = True

Else

If Text(5).Text = "" Or Text(8).Text = "" Then

Option1.Value = True

Option2.Value = False

Exit Sub

If Text(9).Enabled = True And Text(9).Visible = False Then

Text(9).Enabled = False

Text(9).Visible = False

End If

Label38.ForeColor = &HE2CFCD

Label24.ForeColor = &H80000012

BufValVeto = CDbl(Text(5).Text)

Text(10).Enabled = True

Text(10).Visible = True

Text(10).Text = Round((BufValVeto * 100) / MaxMinDiff(MSFlexGrid1.Col - 1), 4)

BufValVeto = 0

Label26.ForeColor = &H80000012

BufValP = CDbl(Text(8).Text)

Text(11).Enabled = True

Text(11).Visible = True

Text(11).Text = Round((BufValP * 100) / MaxMinDiff(MSFlexGrid1.Col - 1), 4)

BufValP = 0

FlagProcent = True

End If

End If

Public Sub LabelAlt_Crit()

Dim i As Integer

LabelAlt_CritGrid MSFlexGrid1, Electre, G_Alt_Number

For i = 0 To G_Crit_Number - 1

If ElectrePropStore(i).IsPropSet = 1 Then

MSFlexGrid1.Col = i + 1

MSFlexGrid1.Row = 0

MSFlexGrid1.CellBackColor = &HFF8080

MSFlexGrid1.CellForeColor = &HFFFFFF

MSFlexGrid1.BackColorSel = &H8000000D

End If

Resize MSFlexGrid1, Electre, G_Alt_Number, G_Crit_Number

MSFlexGrid1.Col = 1

End Sub
Процедурата Show_Hide получава два параметъра “s” и ”h”. В зависимост от техните стойности се визуализира или скрива означението за процент “%”, непосредствено след праговите полета. Ако Option2.Value има стойност True, то знакът за процент се визуализира след праговото поле, което е активно в момента; ако Option2.Value има стойност False, знакът за процент се скрива.

Private Sub Show_Hide(s As Boolean, h As Boolean)

If s = True Then

Label23.ForeColor = &H0&

ElseIf h = True Then

Label23.ForeColor = &HE2CFCD

Label24.ForeColor = &HE2CFCD

Label26.ForeColor = &HE2CFCD

Label38.ForeColor = &HE2CFCD

End If

End Sub
Процедурата Command1_Click се извиква при натискане на бутона Command1. Извършва проверка дали е въведена информацията за критерия, необходима за сработването на алгоритъма. При невъведена информация се извежда съобщение за съответната грешка. Ако информацията е коректна и пълна, се въвежда в структурата PropStore.

Dim i, cnt As Integer

If Option1.Value = True Then

If Text(3).Text = "" Then

Text(3).SetFocus

G_Mesg.errormsg 91

Exit Sub

ElseIf Text(5).Text = "" Then

Text(5).SetFocus

G_Mesg.errormsg 91

Exit Sub

ElseIf Text(8).Text = "" Then

Text(8).SetFocus

G_Mesg.errormsg 91

Exit Sub

End If

If Text(4).Text = "" Then

Text(4).SetFocus

G_Mesg.errormsg 91

Exit Sub

End If

Text(5).SetFocus

G_Mesg.errormsg 92

Exit Sub

Text(8).SetFocus

G_Mesg.errormsg 92

Exit Sub

If CDbl(Text(8).Text) > CDbl(Text(4).Text) Then

Text(8).SetFocus

G_Mesg.errormsg 261

Exit Sub

End If

If CDbl(Text(5).Text) > MaxMinDiff(MSFlexGrid1.Col - 1) Then

Text(5).SetFocus

G_Mesg.errormsg 92

Exit Sub

ElseIf CDbl(Text(8).Text) > MaxMinDiff(MSFlexGrid1.Col - 1) Then

Text(8).SetFocus

G_Mesg.errormsg 92

Exit Sub

End If

If CDbl(Text(5).Text) < 0 Then

Text(5).SetFocus

G_Mesg.errormsg 262

Exit Sub

End If

Text(5).SetFocus

G_Mesg.errormsg 94

Exit Sub

Else

If Text(9).Text = "" Then

Text(9).SetFocus

G_Mesg.errormsg 91

Exit Sub

ElseIf CDbl(Text(9).Text) > 100 Then

Text(9).SetFocus

G_Mesg.errormsg 93

Exit Sub

ElseIf Text(10).Text = "" Then

Text(10).SetFocus

G_Mesg.errormsg 91

Exit Sub

ElseIf CDbl(Text(10).Text) > 100 Then

Text(10).SetFocus

G_Mesg.errormsg 93

Exit Sub

ElseIf Text(11).Text = "" Then

Text(11).SetFocus

G_Mesg.errormsg 91

Exit Sub

ElseIf CDbl(Text(11).Text) > 100 Then

Text(11).SetFocus

G_Mesg.errormsg 93

Exit Sub

End If

Text(11).SetFocus

G_Mesg.errormsg 261

Exit Sub

End If

Text(10).SetFocus

G_Mesg.errormsg 93

Exit Sub

Text(11).SetFocus

G_Mesg.errormsg 93

Exit Sub

If CDbl(Text(10).Text) > CDbl(Text(11).Text) Then

Text(10).SetFocus

G_Mesg.errormsg 94

Exit Sub

End If

ElectrePropStore(MSFlexGrid1.Col - 1).CriterProp = Label36.Caption

ElectrePropStore(MSFlexGrid1.Col - 1).MinMaxProp = Label37.Caption

ElectrePropStore(MSFlexGrid1.Col - 1).Weight = CDbl(Text(3).Text)

ElectrePropStore(MSFlexGrid1.Col - 1).MaxMinDiff = CDbl(Text8.Text)

ElectrePropStore(MSFlexGrid1.Col - 1).Unit = Text9.Text

ElectrePropStore(MSFlexGrid1.Col - 1).Check1Status = Check1.Value

ElectrePropStore(MSFlexGrid1.Col - 1).IsPropSet = 1

If Option1.Value = True Then

ElectrePropStore(MSFlexGrid1.Col - 1).Threshold_Unit = "Absolute"

ElectrePropStore(MSFlexGrid1.Col - 1).Ind_Threshold = CDbl(Text(5).Text)

ElectrePropStore(MSFlexGrid1.Col - 1).Pre_Threshold = CDbl(Text(8).Text)

If Check1.Value = 0 Then

ElectrePropStore(MSFlexGrid1.Col - 1).Veto_threshold = CDbl(Text(4).Text)

Else

Text(4).Text = ""

End If

ElectrePropStore(MSFlexGrid1.Col - 1).Threshold_Unit = "Percent"

ElectrePropStore(MSFlexGrid1.Col - 1).Ind_Threshold = CDbl(CDbl(Text(10).Text) * MaxMinDiff(MSFlexGrid1.Col - 1) / 100)

ElectrePropStore(MSFlexGrid1.Col - 1).Pre_Threshold = CDbl(CDbl(Text(11).Text) * MaxMinDiff(MSFlexGrid1.Col - 1) / 100)

If Check1.Value = 0 Then

ElectrePropStore(MSFlexGrid1.Col - 1).Veto_threshold = CDbl(CDbl(Text(9).Text) * MaxMinDiff(MSFlexGrid1.Col - 1) / 100)

Else

Text(9).Text = ""

End If

If (CritType(MSFlexGrid1.Col - 1) = "qn") And ((MinMax(MSFlexGrid1.Col - 1) = "min") Or (MinMax(MSFlexGrid1.Col - 1) = "ìèí")) Then

ElectrePropStore(MSFlexGrid1.Col - 1).Aver_Performance = CDbl(Text(7).Text) * (-1)

Else

End If

MSFlexGrid1.CellBackColor = &HFF8080

MSFlexGrid1.CellForeColor = &HFFFFFF

Resize MSFlexGrid1, Electre, G_Alt_Number, G_Crit_Number

For i = 0 To G_Crit_Number - 1

If ElectrePropStore(i).IsPropSet = 1 Then

cnt = cnt + 1

End If

If cnt = G_Crit_Number Then

Command2.Enabled = True

Else

End If

Private Sub Command2_Click()

If AHPrezultVisible = True Then

Unload AHPrezult

End If

Rezult = True

End Sub
Процедурата Command3_Click се извиква при натискане на бутона Command3. Чрез нея се осъществява връщане към предходната форма за избор на метод.

Private Sub Command3_Click()

If MethodsVisible = True Then

Methods.SetFocus

Else

End If

End Sub
В процедурата Solve_All е реализирана математическата обработка на алгоритъма. Крайното наредено множество от алтернативи се съхранява в масива Naredba. Масивът е сортиран в низходящ ред.

Private Sub Solve_All()

Dim i As Integer

Dim j As Integer

Dim L As Integer

Dim k As Integer

Dim SumWeight As Double

Dim SrtRankBuf1 As Double ' for array Naredba sort

Dim SrtRankBuf2 As Double ' for array Naredba sort

Dim Buf, Sum, maxval, minval As Double 'for result view

'============== Begin Calculate Concordance Matrix ==============

ReDim ConcordanceMatrix(G_Alt_Number - 1, G_Alt_Number - 1)

'ReDim TempMatrix(G_Alt_Number - 1)

ReDim TempMatrix(G_Crit_Number - 1)

SumWeight = 0

For k = 0 To G_Crit_Number - 1

SumWeight = SumWeight + ElectrePropStore(k).Weight

Next

For j = 0 To G_Alt_Number - 1

If j = L Then

ConcordanceMatrix(j, L) = 1

Else

For i = 0 To G_Crit_Number - 1

If MegaMatrix(i, j) + ElectrePropStore(i).Ind_Threshold >= MegaMatrix(i, L) Then

TempMatrix(i) = 1

ElseIf MegaMatrix(i, j) + ElectrePropStore(i).Pre_Threshold <= MegaMatrix(i, L) Then

TempMatrix(i) = 0

ElseIf ElectrePropStore(i).Pre_Threshold - ElectrePropStore(i).Ind_Threshold = 0 Then

TempMatrix(i) = ElectrePropStore(i).Pre_Threshold + MegaMatrix(i, j) - MegaMatrix(i, L)

'trqbva da se presmetne kak da se polu4i

Else

End If

Next

Next

'ReDim TempMatrix(0)

'============== End Calculate Concordance Matrix ==============

'============== Begin Calculate Discordance Matrix ==============

ReDim DiscordanceMatrix(G_Crit_Number - 1, G_Alt_Number - 1, G_Alt_Number - 1)

For i = 0 To G_Crit_Number - 1

For j = 0 To G_Alt_Number - 1

For L = 0 To G_Alt_Number - 1

If j = L Then

DiscordanceMatrix(i, j, L) = 1

Else

If MegaMatrix(i, j) + ElectrePropStore(i).Pre_Threshold >= MegaMatrix(i, L) Or ElectrePropStore(i).Veto_threshold = 0 Then

ElseIf MegaMatrix(i, j) + ElectrePropStore(i).Veto_threshold <= MegaMatrix(i, L) Then

DiscordanceMatrix(i, j, L) = 1

'ElseIf ElectrePropStore(i).Veto_threshold - ElectrePropStore(i).Pre_Threshold = 0 Then

'DiscordanceMatrix(i, j, L) = ElectrePropStore(i).Veto_threshold + MegaMatrix(i, j) - MegaMatrix(i, L)

'trqbva da se presmetne kak da se polu4i

Else

DiscordanceMatrix(i, j, L) = (MegaMatrix(i, L) - MegaMatrix(i, j) - ElectrePropStore(i).Pre_Threshold) / (ElectrePropStore(i).Veto_threshold - ElectrePropStore(i).Pre_Threshold)

End If

Next

'============== End Calculate Discordance Matrix ==============

'============== Begin Calculate Credibility Matrix ==============

ReDim CredibilityMatrix(G_Alt_Number - 1, G_Alt_Number - 1)

For j = 0 To G_Alt_Number - 1

For L = 0 To G_Alt_Number - 1

CredibilityMatrix(j, L) = 1

If j <> L Then

For i = 0 To G_Crit_Number - 1

If DiscordanceMatrix(i, j, L) > ConcordanceMatrix(j, L) Then

CredibilityMatrix(j, L) = CredibilityMatrix(j, L) * ((1 - DiscordanceMatrix(i, j, L)) / (1 - ConcordanceMatrix(j, L)))

End If

CredibilityMatrix(j, L) = CredibilityMatrix(j, L) * ConcordanceMatrix(j, L)

End If

Next

'============== End Calculate Credibility Matrix ==============

'============== Begin Calculate Distillation ==============

Dim n As Integer

Dim Y As Integer

Dim X As Integer

Dim indA As Integer

Dim indA1 As Integer

Dim indD As Integer

Dim indC As Integer

Dim indD1 As Integer

Dim indC1 As Integer

Dim s As Integer

Dim max, min, loD, loC, loD1, loC1

ReDim Descend(G_Alt_Number - 1, 1)

ReDim Ascend(G_Alt_Number - 1, 1)

ReDim a(G_Alt_Number)

ReDim D(G_Alt_Number)

ReDim D1(G_Alt_Number)

ReDim p2(G_Alt_Number - 1)

ReDim q2(G_Alt_Number - 1)

ReDim f2(G_Alt_Number - 1)

ReDim A1(G_Alt_Number)

ReDim c(G_Alt_Number)

ReDim c1(G_Alt_Number)

ReDim p1(G_Alt_Number - 1)

ReDim q1(G_Alt_Number - 1)

ReDim f1(G_Alt_Number - 1)

n = 0

Y = 0

a(i) = i

For j = 0 To 1

Descend(i, j) = 0

Ascend(i, j) = 0

Next

Next

a(G_Alt_Number) = n

loD = 0

For i = 0 To G_Alt_Number - 1

If (a(i) > -G_Alt_Number) And (a(j) > -G_Alt_Number) And (i <> j) And (CredibilityMatrix(i, j) > loD) Then

loD = CredibilityMatrix(i, j)

End If