4.Этап выполнения

4.1.Входные данные

Входными данными ЭС, как уже было сказано в пункте 3.1, являются априорные вероятности исходов и вероятности событий при условии совершении исходов.

Записываем их на рабочий лист Excel (рис.4.1.1-2).

Рисунок 4.1.1 – Априорные вероятности исходов

Рисунок 4.1.2 – Вероятности событий при совершении исходов - p(A_y|h_i)

Кроме того, к входным данным ЭС относятся список вопросов, терминов и их определений, также расположенных на рабочих листах книги Excel.

4.2.Разработка форм и определение исходов

В процессе создания ЭС было создано 6 форм: вводная форма (ufStart), две формы с вопросами (uf1, uf3), форма с результатов (uf2), словарь терминов (ufTerms) и форма статистики (ufData).

В формах с вопросами пользователю необходимо ответить на представленные вопросы нажатием на соответствующую кнопку, либо выбрать из предложенных вариантов ответа (рис.4.2.1-2). Если при ответе на вопросы ЭС у пользователя возникают трудности с пониманием тех или иных терминов, он может воспользоваться специальным словарем терминов, нажав на кнопку в правом верхнем углу формы (рис.4.2.3).

Открытие словаря терминов

Возвращение видимости рабочей книги:

Application.Visible=True

Рисунок 4.2.1 – Форма с вопросами (uf1)

Рисунок 4.2.2 – Форма с вопросом (uf3)

Рисунок 4.2.3 – Словарь терминов (ufTerms)

При ответе пользователем на вопрос, ответ записывается на рабочий лист (рис.4.2.7).

Для выполнения основной задачи ЭС – определения наиболее вероятного исхода, выполняются следующие процедуры:

1. Задается нумерация элементов массивов с единицы, и объявляются необходимые массивы и переменные;

Option Base 1

Dim chance(), apriori(11) As Double, first, second, firstI, secondI As String, finish As Long

2. При инициализации формы результатов (uf2) записываются массивы вероятностей:

Private Sub UserForm_Initialize()

' массивы

' запись в массив априорных вероятностей

Worksheets("P").Activate

For i = 1 To 11

apriori(i) = Cells(i + 1, 8).Value

Next i

' массив вероятностей исходов при ответе ДА

Worksheets("1").Activate

ReDim chance(11, 8)

For i = 1 To 11

For j = 1 To 7

chance(i, j) = Cells(i + 1, j + 1).Value

Next j

Next i

For i = 1 To 11

chance(i, 8) = Cells(i + 1, uf3.column).Value

Next i

3. Происходит пересчет условных вероятностей в массив apriori() с помощью функций Байеса, заранее записанных в качестве, соответственно, функций:

Function baes_yes(p, py)

' формула пересчета усл.вероятности при ответе ДА

baes_yes = (py * p) / (py * p + (1 - py) * (1 - p))

End Function

Function baes_no(p, py)

' формула пересчета усл.вероятности при ответе НЕТ

baes_no = ((1 - py) * p) / ((1 - py) * p + py * (1 - p))

End Function

4. Возвращаясь к процедуре инициализации формы результатов:

' пересчет усл.вероятностей

For i = 1 To 11

For j = 1 To 8

Worksheets("Rezults").Activate

If Trim(Cells(ufStart.newrow, j + 2).Value) = "Да" Then

apriori(i) = Module2.baes_yes(apriori(i), chance(i, j))

ElseIf Trim(Cells(ufStart.newrow, j + 2).Value) = "Нет" Then

apriori(i) = Module2.baes_no(apriori(i), chance(i, j))

End If

Next j

Next i

5. Далее пересчитанные условные вероятности исхода выводятся на рабочий лист:

Worksheets("1").Activate

For i = 1 To 11

Cells(i + 1, 11).Value = apriori(i)

Next i

6. И происходит отбор 2-х наибольших вероятностей (на рабочем листе):

Range("K13").Select

ActiveCell.FormulaR1C1 = "=LARGE(R[-11]C:R[-1]C,1)"

Range("K14").Select

ActiveCell.FormulaR1C1 = "=LARGE(R[-12]C:R[-2]C,2)"

7. Затем по индексам условных вероятностей в массиве ищутся сами термины Инкотермс, записанные также на рабочем листе (рис.4.2.4), и их значения записываются в переменные:

For i = 1 To 11

If Range("K13").Value = apriori(i) Then

first = Cells(i + 1, 12).Value

firstI = apriori(i)

ElseIf Range("K14").Value = apriori(i) Then

second = Cells(i + 1, 12).Value

secondI = apriori(i)

Else

End If

Next i

Рисунок 4.2.4 – Пересчитанные условные вероятности и определение 2-х наибольших их них

8. Остается только вывод получившихся исходов и их объяснение пользователю:

Label1.Caption = " Итак, для условий поставок, которые Вы указали, подойдут следующие Инкотермс: "

Label2.Caption = first & " (вероятность " & Round(firstI, 3) * 100 & " %) или " & second & " (вероятность " & Round(secondI, 3) * 100 & " %)."

Worksheets("Rezults").Activate

Cells(ufStart.newrow, 11).Value = first & " или " & second

Worksheets("Terms").Activate

For i = 1 To 23

If InStr(1, Cells(i, 8).Value, first, vbTextCompare) > 0 Then

Label3.Caption = Cells(i, 9).Value & Chr(10) & Cells(i + 1, 9).Value & Chr(10) & Cells(i, 10).Value

ElseIf InStr(1, Cells(i, 8).Value, second, vbTextCompare) > 0 Then

Label4.Caption = Cells(i, 9).Value & Chr(10) & Cells(i + 1, 9).Value & Chr(10) & Cells(i, 10).Value

End If

Next i

Пример объявления результатов:

Рисунок 4.2.5 – Форма вывода результатов (uf2)

В качестве дополнения к ЭС была добавлена статистика, включающая подсчет общего числа пользователей ЭС, их средний возраст, среднее время прохождения и частота определения исходов ЭС (рис.4.2.6).

Рисунок 4.2.6 – Форма со статистиков ЭС (ufData)

Коды процедур для выявления статистических данных следующие:

1. Для определения общего числа пользователей:

Worksheets("Rezults").Activate

Rows = _

Application.WorksheetFunction.CountA(Range("A:A"))

2. Для подсчета среднего возраста пользователей:

allage = 0 ' сумма возрастов

For i = 2 To Rows

allage = allage + CInt(Cells(i, 2).Value)

Next i

Aage = allage \ (Rows - 1) ' среднее значение

3. Для определения времени прохождения ЭС данным пользователем:

В процедуре инициализации первой формы с вопросами (uf1) была задана переменная, предварительно объявленная публично:

Public Start As Long

__________________

Start = Timer

При ответе пользователем на последний вопрос во вторую переменную записывается текущее значении таймера и находится разность начального и конечного значений:

Worksheets("Rezults").Activate

finish = Timer

tim = finish - uf1.Start

If tim >= 60 Then

tim = (finish - uf1.Start) \ 60

Cells(ufStart.newrow, 12).Value = tim & " мин."

Else

Cells(ufStart.newrow, 12).Value = tim & " сек."

End If

Данные времени, как указано в коде, выводятся на рабочий лист :

Рисунок 4.2.7 – Данные о пользователях ЭС

4. Для определения среднего времени прохождения ЭС уже используются данные с рабочего листа:

' среднее время прохождения:

sec = 0

For i = 2 To Rows

If InStr(1, Cells(i, 12).Value, "мин", vbTextCompare) > 0 Then ' если время записано в минутах

sec = sec + Val(Cells(i, 12).Value) * 60

Else

sec = sec + Val(Cells(i, 12).Value)

End If

Next i

' среднее значение в секундах

Atime = sec \ (Rows - 1)

min = 0

Do While Atime >= 60

Atime = Atime - 60

min = min + 1 ' счетчик минут

Loop

Label3.Caption = " Среднее время прохождения ЭС составляет " & min & " мин. " & Atime & " сек."

5. Подсчет частоты определений исходов происходил следующим образом:

Термины Инкотермс были записаны в отдельный двумерный массив Incoterms();

Worksheets("1").Activate

For i = 1 To 11

Incoterms(i, 1) = Cells(i + 1, 12).Value

Incoterms(i, 2) = 0

Next i

Среди записанных на рабочем листе результатов отыскивались значения, совпадающие с элементами этого массива, и прибавлялись их числовые значения:

' поиск терминов в исходных результатах

Worksheets("Rezults").Activate

For i = 1 To Rows

For j = 1 To 11

If InStr(1, Trim(Cells(i + 1, 11).Value), Trim(Incoterms(j, 1)), vbTextCompare) > 0 Then

Incoterms(j, 2) = CInt(Incoterms(j, 2)) + 1

Else

End If

Next j

Next i

В дальнейшем данные из массива записывались на рабочий лист и сортировались по второму столбцу (рис.4.2.8):

' сортировка макрорекодером

Worksheets("4").Activate

Range("B1:B12").Select

ActiveWorkbook.Worksheets("4").sort.SortFields.Clear

ActiveWorkbook.Worksheets("4").sort.SortFields.Add Key:=Range("B1"), SortOn _

:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("4").sort

.SetRange Range("A1:B12")

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Затем массив снова перезаписывался, т.к. уже был отсортирован, и выносился в элемент формы:

For i = 1 To 12

For j = 1 To 2

Incoterms(i, j) = Cells(i, j).Value

Next j

Next i

ListBox1.ColumnCount = 2

ListBox1.List = Incoterms()

Рисунок 4.2.8 – Сортировка частоты определения Инкотермс для статистики