Ниже представлен исходный код нейронной сети Кохонена реализованной под Excel. Предназначена для классификации и кластеризации. Задумана под анализ финансовых рынков. Тут немного не доделанный код - необходимо прописать критерий остановки сети - это на усмотрение разработчика. Если что пишите - apsheronka@mail.ru

Здесь теория сети Кохонена: Лекция 5. Сеть Кохонена

' к.т.н. Шумков Евгений (КубГТУ, КТАС, ВТ и АСУ)

Dim KMatrix() As Double ' Основная матрица весов между входным слоем и слоем Кохонена

Dim KInputs() As Double ' Количество входов сети Кохонена

Dim KOutputs() As Double ' На сколько классов бить примеры (то что входит в нейроны выходного слоя)

Dim Out() As Double ' Что выходит из нейронов выходного слоя (гипертангенс)

Dim num_inp As Integer ' Количество входов сети Кохонена

Dim num_out As Integer ' На сколько классов бить примеры

Dim examples As Integer ' Количество примеров обучения

Dim start_pos As Integer ' с какой строчки начинается выборка

Dim end_pos As Integer ' на какой строчке заканчивается выборка

Dim start_col As Integer ' стартовая колонка для обучения

Dim end_col As Integer ' конечная колонка для обучения

Dim num_col As Integer ' количество колонок

Dim new_start_col As Integer ' стартовая колонка после переноса

Dim new_end_col As Integer ' конечная колонка после переноса

Dim Max_value As Double ' максимальное значение в обучающих примерах

Dim Min_value As Double ' минимальное значение в обучающих примерах

Dim sm As Integer ' на сколько смещаем для копирования масштабированных данных

Dim sc As Double '  коэффициент масштабирования

Dim mu As Double ' скорость изменения весов

Dim A As Double ' параметр в гипертангенсе

Dim count As Integer ' номер строки в которую выводить номер примера и итерацию

Dim Error As Double ' признак - останавливать обучение сети или нет

'-----------------------------------------------------------------------------

Sub KohonenMap()

' Главная функция - конструктор, как собирать и обучать сеть

   Application.ScreenUpdating = False ' отключаем автоматический пересчет формул и обновление листов

   Application.EnableEvents = False

   Application.Calculation = xlCalculationManual

       

        tmp = ClearList1()

        tmp = InitKohonenNet()

        tmp = CreateKohonenNet()

        tmp = PreProccess()

        tmp = LearnKohonenNet()

 

   Application.ScreenUpdating = True ' обратно включаем пересчет формул

   Application.EnableEvents = True

   Application.Calculation = xlCalculationAutomatic

End Sub

'-----------------------------------------------------------------------------

 

Function InitKohonenNet()

' инициализация сети Кохонена

 

  num_inp = 3

  num_out = 10

  start_pos = 3

  end_pos = 11

  start_col = 2

  end_col = 4

  num_col = end_col - start_col

  examples = end_pos - start_pos

  Error = 10

  sm = 2 ' смещаем от end_col на 2 столбца

  mu = 0.01 ' скорость изменения весов

  A = 0.5

  count = end_pos + 4

 

End Function

'-----------------------------------------------------------------------------

 

Function CreateKohonenNet()

' создаем сеть Кохонена

    ReDim KInputs(num_inp - 1)

    ReDim KOutputs(num_out - 1)

    ReDim Out(num_out - 1)

    ReDim KMatrix(num_out - 1, num_inp - 1)

    ' инициализация KMatrix

    Randomize

    For i = 0 To num_out - 1 Step 1

        For j = 0 To num_inp - 1 Step 1

            KMatrix(i, j) = Rnd * 2 - 1

        Next j

    Next i

End Function

Function LearnKohonenNet()

' функция обучения сети Кохонена

    Dim num As Integer ' номер для обучения

    Dim i As Integer ' номер итерции обучения

    Dim winner As Integer ' номер выигравшего нейрона

    i = 0

    Randomize

    While Error > 0

        num = Rnd * examples + start_pos

        tmp = KCalc(num)

        winner = FindMaxOutput()

       

        ' корректируем веса связанные с победившим нейроном

        For i = 0 To num_inp - 1 Step 1

            KMatrix(winner, i) = KMatrix(winner, i) - mu * (KInputs(i) - KMatrix(winner, i))

        Next i

        ' выводим

        tmp = PrintData(num, i, winner)

        count = count + 1

        i = i + 1

    Wend

   

End Function

'-----------------------------------------------------------------------------

 

Function KCalc(num As Integer)

' расчет выходов сети Кохонена. Возвращает номер выигравшего нейрона

    tmp = FoultOutputs()

    tmp = SetInputs(num)

    For i = 0 To num_out - 1 Step 1

        For j = 0 To num_inp - 1 Step 1

            KOutputs(i) = KOutputs(i) + KInputs(j) * KMatrix(i, j)

            ' пропускаем через тангенсоиду

        Next j

        Out(i) = GiperTang(KOutputs(i))

    Next i

 

End Function

'-----------------------------------------------------------------------------

 

Function PreProccess()

' Предобработка данных

Max_value = -10000

Min_value = 10000

' ищем максимум-минимум

Worksheets("dat").Activate

    For i = start_pos To end_pos Step 1

        For j = start_col To end_col Step 1

            If Cells(i, j).Value > Max_value Then

                Max_value = Cells(i, j).Value

            End If

            If Cells(i, j).Value < Min_value Then

                Min_value = Cells(i, j).Value

            End If

        Next j

    Next i

' теперь масштабируем и переносим вправо

    If Abs(Max_value) > Abs(Min_value) Then

        sc = Max_value

    Else

        sc = Min_value

    End If

    ' перенос

    For i = start_pos To end_pos Step 1

        For j = start_col To end_col Step 1

            Cells(i, j + num_col + sm).Value = Cells(i, j).Value / sc

        Next j

    Next i

    new_start_col = start_col + num_col + sm

    new_end_col = new_start_col + num_col

End Function

'-----------------------------------------------------------------------------

 

Function SetInputs(num As Integer)

    Worksheets("dat").Activate

    r = 0 ' т к сбиты номера

    For i = new_start_col To new_end_col Step 1

        KInputs(r) = Cells(num, i).Value

        r = r + 1

    Next i

    ' выходы должны формироваться сами

End Function

'-----------------------------------------------------------------------------

 

Function FoultOutputs()

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

    For i = 0 To num_out - 1 Step 1

        KOutputs(i) = 0

    Next i

End Function

Function FindMaxOutput() As Integer

' собственно поиск максимального выхода сети Кохонена

    MaxOutput = 0

    For i = 0 To num_out - 1 Step 1

        If (Abs(Out(i)) > Abs(MaxOutput)) Then

            MaxOutput = Out(i)

            FindMaxOutput = i

        End If

    Next i

   

End Function

'-----------------------------------------------------------------------------

 

Function GiperTang(sea As Double) As Double

' тангенсоида

    GiperTang = (Exp(A * sea) - Exp((-1) * A * sea)) / (Exp(A * sea) + Exp((-1) * A * sea))

End Function

'-----------------------------------------------------------------------------

 

Function TestSetInputs(number As Double)

' для тестового режима устанавливаем входы в указанное число

    For i = 0 To num_inp - 1 Step 1

        KInputs(i) = number

    Next i

End Function

'-----------------------------------------------------------------------------

 

Function TestSetKMatrix(number As Double)

' для тестового режима устанавливаем матрицу в указанное число

    For i = 0 To num_out - 1 Step 1

        For j = 0 To num_inp - 1 Step 1

            KMatrix(i, j) = number

        Next j

    Next i

End Function

'-----------------------------------------------------------------------------

 

Sub TestCalc()

    tmp = InitKohonenNet()

    tmp = CreateKohonenNet()

    tmp = TestSetInputs(1)

    tmp = TestSetKMatrix(1)

    tmp = KCalc(5)

    tmp = 1

End Sub

'-----------------------------------------------------------------------------

 

Function PrintData(num As Integer, pos As Integer, win As Integer)

' трассировка - выводим промежуточные результаты обучения слоя Кохонена

    Worksheets("0").Activate

    ' входы

    For i = 0 To num_inp - 1 Step 1

        Cells(i + 1, 1).Value = KInputs(i)

    Next i

    

    ' выходы

    For i = 0 To num_out - 1 Step 1

        Cells(i + 1, 3).Value = KOutputs(i)

    Next i

   

    ' выходы после гипертангенса

    For i = 0 To num_out - 1 Step 1

        Cells(i + 1, 5).Value = Out(i)

    Next i

       

    ' KMatrix

    For i = 0 To num_out - 1 Step 1

        For j = 0 To num_inp - 1 Step 1

            Cells(i + 1, 7 + j).Value = KMatrix(i, j)

        Next j

    Next i

   

    ' выводим номер поданного примера и номер итерации

    Cells(count, 1).Value = pos

    Cells(count, 2).Value = num

    Cells(count, 3).Value = win

   

    Worksheets("dat").Activate

End Function

'-----------------------------------------------------------------------------

 

Function ClearList1()

' очищаем нулевой лист (аккуратно - должен быть активирован нулевой лист!!!)

    Worksheets("0").Activate

    Cells.Select

    Selection.ClearContents

    Range("A1").Select

    Worksheets("dat").Activate

End Function

'-----------------------------------------------------------------------------

 

Function WeightsStab()

' расчет изменения весов

' на усмотрение для разработчика - как считать, что веса застабилизировались...

' собственно здесь устанавливать Error в ноль

 

End Function