Определения и понятия 

Унитреугольная матрица (верхняя или нижняя) — треугольная матрица A, в которой все элементы на главной диагонали равны единице: ajj =1

.Data Scientist — это специалист по работе с данными для решения задач бизнеса (аналитик баз данных).  Он работает на стыке программирования, машинного обучения и математики. В основные обязанности дата-сайентиста входит сбор и анализ данных, построение моделей, их обучение и тестирование. Data Scientist должен разбираться в том, как работает компания и конкретная индустрия, в которой он занят. Профессия Data Scientist постоянно развивается и высоко оплачивается.
Локальная флора – флора географического пункта (может совпадать с конкретной флорой)
Коэффициент сходства Съеренсена  – мера схожести двух наборов данных,   равна отношению удвоенного количества общих для обоих наборов элементов к суммарному количеству элементов в анализируемых наборах данных. 

Введение

В практике вычислений, реализуемых с помощью MS Excel, встречается численная оценка похожих по составу объектов c целью их последующего отбора по заданным критериям. Такие задачи могут возникать: при анализе объектов недвижимости по заданному набору характеристик; анализе интернет-сообществ; анализе совокупности профилей сотрудников компании и т.д. 
Как следствие, идея автоматизировать численную оценку схожести объектов приводит к разработке модели, которая бы наглядно отображала попарное сходство анализируемых объектов. На языке математики такое отображение хорошо описывается нижней унитреугольной матрицей. 
Таким образом, задачей становится разработать модель, которая сформирует унитреугольную матрицу произвольного размера, где на пересечении строк и столбцов будут выведены попарные коэффициенты сходства наборов данных друг с другом (далее – Модель).
Далее опишем концепцию разработки такой Модели, реализуемую методами VBA Excel.

Концепция и код VBA Модели

Концепция  Модели состоит из следующих основных блоков расчета (см. Рис. 1):

Рис. 1. Концепция модели формирования унитреугольной матрицы произвольной размерности

Код VBA Модели, соответствующий приведенным этапам формирования унитреугольной матрицы, приведен на Рис.  2.
Рассмотрим алгоритм работы модели по блокам расчета.
1.    Блок оформления матрицы коэффициентов сходства. В этом блоке, в частности,  заполняются строки первого столбца и столбцы первой строки, создающие заголовки проектируемой матрицы операциями VBA (см. подраздел Блока 1 “формируем заголовки матрицы и прописываем "1" в  главной диагонали”).
2.    Блок расчета числа дубликатов элементов в двух анализируемых наборах данных. Комментарий к расчету: показатель числа дубликатов Count Duplicates рассчитывается  формулой

в цикле

For i = 2 To RowsNum1

, где каждый из элементов одного столбца сравнивается попарно с элементами второго столбца, создавая на выходе из цикла удвоенное число дубликатов в обоих столбцах

формируя числитель формулы коэффициента сходства.
3.    Блок расчета общего числа элементов в двух анализируемых наборах. Идея расчета состоит в формировании двух объектных переменных диапазонов анализируемых столбцов:

 Set InputDateRange1 = .Range(.Cells(2, Compare1Column), .Cells(RowsNum, Compare1Column))

и

Set InputDateRange2 = .Range(.Cells(2, Compare2Column), .Cells(RowsNum, Compare2Column))

, а затем формируется объединенный диапазон операцией Union:

Set InputDateRange = Application.Union(InputDateRange1, InputDateRange2)

. Далее в цикле

For Each rCell In InputDateRange.Cells

 по объединенному диапазону подсчитывается количество ненулевых элементов CountTotalStrings, формируя знаменатель формулы коэффициента сходства.
4.     Блок расчета, записи и условного форматирования коэффициентов сходства. Комментарий к расчету: Расчет коэффициента сходства двух анализируемых наборов данных производится по формуле

, "Standard") ,  которая формирует значение в стандартном формате числа. Далее в цикле по диапазону матрицы

For Each rCell In MatrixRange.Cells

операторами сопоставления  коэффициентов с граничными значениями ячейки коэффициентов заливаются цветом в соответствии с заданной легендой, например:

rCell.Interior.Color = vbCyan

Приводим код VBA Модели (Рис. 2).

Public Sub SemblanceKoeffMatrix()
 
 Dim EndColumn As Long ' количество столбцов в матрице
 Dim LastColumn As Long ' номер последнего столбца
 Dim iRow As Long, InputWS As Worksheet
 Dim String1 As String, String2 As String ' строковые переменные элементов наборов данных
 Dim RowsNum1 As Double, RowsNum2 As Double ' переменные числа строк в анализируемых столбцах
 Dim Compare1Column As Integer ' номер первого сравниваемого столбца
 Dim Compare2Column As Integer ' номер второго сравниваемого столбца
 Dim CountDuplicates As Long ' переменная количества попарных дублей элементов
 Dim i, j, k As Long ' переменные циклов
 Dim InputDateRange1 As Range ' объектная переменная 1-го набора сопоставляемых данных
 Dim InputDateRange2 As Range ' объектная переменная 2-го набора сопоставляемых данных
 Dim CountTotalStrings As Long ' переменная количества элементов
 Dim MatrixRange As Range ' объектная переменная диапазона матрицы
 Dim MatrixToClear As Range ' объектная переменная диапазона очищаемой матрицы
 Dim PatternColumnWidth As Variant ' переменная ширины столбца
 Dim PatternRowHeight As Variant ' переменная высоты строки
 
 ' ==== ==================
 
 With Worksheets("Lists of species")
 
 LastColumn = .Rows(1).Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column ' номер последнего столбца данных
 End With
 
 With Worksheets("Sorensen (Dice)").Columns(2)
 PatternColumnWidth = .ColumnWidth
 End With
 
 With Worksheets("Sorensen (Dice)").Rows(2)
 PatternRowHeight = .RowHeight
 End With
 ' ------------------- формируем заголовки матрицы и прописываем "1" в главной диагонали ---------------------------
 For j = 2 To LastColumn + 1 ' создаем цикл для всех столбцов
 Worksheets("Sorensen (Dice)").Cells(1, j).Value = "Area " & j - 1
 Worksheets("Sorensen (Dice)").Cells(1, j).Interior.Color = vbYellow ' заливка желтым цветом
 Worksheets("Sorensen (Dice)").Cells(1, j).HorizontalAlignment = xlCenter
 Worksheets("Sorensen (Dice)").Cells(j, 1).Value = "Area " & j - 1
 Worksheets("Sorensen (Dice)").Cells(1, j).VerticalAlignment = xlCenter
 Worksheets("Sorensen (Dice)").Cells(j, 1).Interior.Color = vbYellow ' заливка желтым цветом
 Worksheets("Sorensen (Dice)").Cells(j, j).Value = 1 ' заполняем "1" главную диагональ
 ' форматируем ширину столбцов и высоту строк
 With Worksheets("Sorensen (Dice)")
 .Columns(j).ColumnWidth = PatternColumnWidth
 .Rows(j).RowHeight = PatternRowHeight
 End With
 
 Next j ' следующая ячейка в строке 1 и столбце 1
 ' сетка для 1 строки и 1 столбца
 Worksheets("Sorensen (Dice)").Range(Cells(1, 1), Cells(1, LastColumn + 1)).Borders.Weight = xlThin ' формируем сетку для матрицы
 Worksheets("Sorensen (Dice)").Range(Cells(1, 1), Cells(LastColumn + 1, 1)).Borders.Weight = xlThin ' формируем сетку для матрицы
 ' óäàëÿåì ëèøíèå ñòðîêè
 Worksheets("Sorensen (Dice)").Rows(LastColumn + 2).Delete ' óäàëÿåì íåíóæíóþ удаляем лишние строки
 ' ------------------- очищаем матрицу---------------------------
 Set MatrixRange = Worksheets("Sorensen (Dice)").Range(Cells(2, 2), Cells(LastColumn + 1, LastColumn + 1))
 MatrixRange.ClearContents ' очищаем матрицу перед расчетом
 MatrixRange.Borders.Weight = xlThin ' формируем сетку для матрицы
 ' ==== Блок 1 оформления матрицы коэффциентов сходства - конец ==================
 
 ' ==== Блок 2 расчета числа дубликатов элементов в двух анализируемых наборах данных начало ==================
 k = 2 ' начальное значение строк матрицы
 
 For j = 2 To LastColumn + 1 ' цикл по столбцам матрицы в каждой ячейке должен быть расчет коэффициента схожести столбцов
 Worksheets("Sorensen (Dice)").Cells(j, j).Value = 1 ' прописываем главную диагональ матрицы
 ' оформляем главную диагональ матрицы
 Worksheets("Sorensen (Dice)").Cells(j, j).HorizontalAlignment = xlCenter
 Worksheets("Sorensen (Dice)").Cells(j, j).VerticalAlignment = xlCenter
 Worksheets("Sorensen (Dice)").Cells(j, j).Interior.Color = vbYellow ' заливка желтым цветом
 Compare1Column = j - 1 ' номер текущего 1-го сравниваемого столбца матрицы
 For k = j + 1 To LastColumn + 1 ' цикл по столбцам матрицы c искомыми ячейками ниже диагонали
 Compare2Column = k - 1 ' номер 2-го сравниваемого столбца матрицы
 ' определены координаты ячейки, в которую должно попасть значение коэффициента схожести
 Set InputWS = ThisWorkbook.Sheets("Lists of species") ' лист с данными
 With Worksheets("Lists of species")
 Set InputWS = ThisWorkbook.Sheets("Lists of species") ' лист с данными
 RowsNum1 = .Cells(Rows.Count, Compare1Column).End(xlUp).Row ' количество строк в 1 столбце
 RowsNum2 = .Cells(Rows.Count, Compare2Column).End(xlUp).Row ' количество строк во 2 столбце
 ' ------------- определяем общее число строк для будущей матрицы поиска уникальных элементов RowsNum
 If RowsNum1 > RowsNum2 Then ' если число строк в столбце 1 больше числа строк во 2-м
 RowsNum = RowsNum1 ' присваиваем это число переменной общего числа строк
 ElseIf RowsNum2 > RowsNum1 Then ' если число строк в столбце 2 больше числа строк во 1-м
 RowsNum = RowsNum2 ' присваиваем это число переменной общего числа строк
 Else ' èíà÷å
 RowsNum = RowsNum1 ' присваиваем RowsNum1 переменной общего числа строк
 End If
 ' ------------- определяем общее число строк для будущей матрицы поиска уникальных элементов RowsNum
 'цикл по каждой ячейке 1-го из сравниваемых столбцов
 CountDuplicates = 0 ' начальное значение числа дубликатов
 For i = 2 To RowsNum1 ' цикл по строкам 1 столбца, начиная со 2-й строки
 String1 = .Cells(i, Compare1Column).Text ' если это название имеется в диапазоне 2 столбца
 If Application.WorksheetFunction.CountIf(.Range(.Cells(2, Compare2Column), _
 .Cells(RowsNum2, Compare2Column)), String1) > 0 Then
 CountDuplicates = CountDuplicates + 1 ' то наращиваем счетчик совпадений
 Else ' иначе это название не найдено
 End If
 Next i продолжаем цикл
 
 CountDuplicates = CountDuplicates * 2 ' домножаем на 2 для получения числителя формулы расчета схожести
 
 ' ==== Блок 2 расчета расчета числа дубликатов элементов в двух анализируемых наборах данных конец ==================
 
 ' ==== Блок 3 расчета общего числа элементов в двух анализируемых наборах данных начало ==================
 
 Dim InputDateRange As Range ' объектная переменная диапазона исходных данных
 Dim rCell As Range ' ячейка цикла
 ' создаем матрицу - массив из несмежных диапазонов для поиска уникальных значений
 Set InputDateRange1 = .Range(.Cells(2, Compare1Column), .Cells(RowsNum, Compare1Column)) ' установить 1-й диапазон исходных данных
 Set InputDateRange2 = .Range(.Cells(2, Compare2Column), .Cells(RowsNum, Compare2Column)) ' установить 2-й диапазон исходных данных
 Set InputDateRange = Application.Union(InputDateRange1, InputDateRange2) ' установить сводный (1+2) диапазон исходных данных
 
 CountTotalStrings = 0 ' начальное значение переменной числа ненулевых элементов
 For Each rCell In InputDateRange.Cells ' для каждой ячейки диапазона
 If rCell.Value <> "" Then ' если элемент ненулевой
 CountTotalStrings = CountTotalStrings + 1 ' число значений нарастающим итогом
 Else ' иначе
 End If ' конец условия
Next rCell ' следующая ячейка
End With
' ==== Блок 3 расчета общего числа элементов в двух анализируемых наборах данных конец ==================

' ===== Блок 3 расчета общего числа элементов в двух анализируемых наборах данных конец ==============
SemblaceCoeff = Format(CountDuplicates / CountTotalStrings, "Standard") ' расчет коэффициента сходства в стандартном формате числа

With Worksheets("Sorensen (Dice)").Cells(k, j) ' оформление для целевой ячейки матрицы - размещения коэффициента сходства
 .Value = SemblaceCoeff
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
 .Font.Size = 12
End With

Next k ' продолжаем цикл по столбцам матрицы c искомыми ячейками ниже диагонали
Next j ' продолжаем цикл по столбцам матрицы в каждой ячейке должен быть расчет коэффициента схожести столбцов

' ------------- оформляем главную диагональ матрицы -----------------------------------------
With Worksheets("Sorensen (Dice)").Cells(LastColumn + 1, LastColumn + 1)
 .Value = 1 ' прописываем главную диагональ матрицы
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
 .Interior.Color = vbYellow ' заливка желтым цветом
End With
' ---------- применяем условное форматирование к значениям коэффициента Серенсена---------------------
For Each rCell In MatrixRange.Cells ' для каждой ячейки матрицы
 If rCell.Row > rCell.Column And IsNumeric(rCell.Value) Then ' если ячейка находится в нижней диагонали матрицы и не пустая
 If rCell.Value >= 0# And rCell.Value <= 0.5 Then ' если ячейка в диапазоне 0 - 0,50
 rCell.Interior.Color = vbCyan ' ячейка заливается цветом vbCyan
ElseIf rCell.Value > 0.5 And rCell.Value <= 0.99 Then ' если ячейка в диапазоне 0,5 - 0,99
rCell.Interior.Color = vbMagenta ' ячейка заливается цветом vbMagenta
Else ' иначе
End If ' конец условия
Else ' ячейка не находится в нижней диагонали матрицы и пустая
End If ' конец условия
Next rCell ' следующая ячейка диапазона матрицы
' Блок 4 Расчет, запись и условное форматирование коэффициентов сходства конец
' ==== ==============

End Sub


 

Рис 2. Код  VBA модели построения унитреугольной матрицы произвольного размера

Практические результаты расчетов Модели

В изложенной версии Модели в качестве исходных данных для анализа коэффициентов сходства применялись данные локальных флор, полученные при геоботанических исследованиях. Пользователь модели формирования унитреугольной матрицы произвольной размерности может как добавлять, так и удалять различное количество наборов/столбцов исходных данных. В качестве исходных данных Модели сформированы наборы/столбцы, состоящие из названий растений (локальные флоры), произрастающих на площадках Area1,…Area9 (см. рис.3). Самым простым способом вычисления сходства объектов по текстовым характеристикам является расчет коэффициента схожести Съеренсена (Кs).

В результате расчетов  Модель размещает коэффициенты Съеренсена  в унитреугольной  матрице коэффициентов (см. рис. 4).
Цветом отмечены классификационные ранги сообществ:  цветом cyan  выделены слабые сочетания растительных сообществ, цветом magenta  -  сильные сочетания растительных сообществ, которые относятся к одной ассоциации.

 
Рис. 4 – Унитреугольная матрица  произвольного размера