(MS Excel) VBA ( )

 

. ROSNEFT LUCKOIL ( ). , . Excel Quik , .

Open[i] Open[i-1], Low[i] Low[i-1], High[i] High[i-1], Close[i-1] Close[i], Close[i+1] Close[i]. , ( i ). , , SetIO(), .

:

NNet() - ( main()), , , . .

Test() . :)

SetParams() ( , ).

CreateNet() - .

InitNet() GMatrix -1 1.

SetIO() ( , ).

Calc() .

Backpropagation() , ( ). , ( Nu1 Nu2) , Nu1 Nu2.

CountError() , . :)

PrintList() 0 , , . , , .

ClearList() 0.

Preprocess() - , -1 1, . .

PlotSuccessResult() , 0 , . .

SaveNet() ( ).

LoadNet() ( ).

 

. . :

GInputs() . list. , GInputs(5,6,7,8) , 5, 6, 7, 8.

GOutputs() . GInputs .

GNeuro() . , GNeuro(4, 8, 6, 1) , 4 (.. ) . 4, 8, 6, 1 , 4 ( GNeuro GInputs !!), 1- 8 , 2- 6 .

GMatrix() . , . , ( ). , 5 .

 

( NNet() Test()), ( VBA F5, ). 2-5 , 4 (OLHC) 1 . , , , .

, .

, 0 -

 

, Module3, NNet() F5 ( Run ). , J , Ctrl+Break, .

, -- ! Metatrader, . , .

 

- , WMR R398365873120 :)

 

apsheronka@mail.ru .

.

 

. .

10.10.10 - ! - ,
>>

Excel:


 

=====================================================================

' VBA (Visual Basic for Application).

' PhD(eng) Shumkov Eugene. KubSTU (Krasnodar).

' march 2010

' (BackProp, Back Propogation)

' Excel

 

Dim inp As Integer

Dim NEU As Integer

Dim OUT As Integer

Dim GInputs() As Variant '

Dim GOutputs() As Variant '

Dim GMatrix() As Double '

Dim Matrix1() As Double '

Dim Matrix2() As Double '

Dim GNeuro() As Variant ' , ( )

Dim GError() As Double '

Dim GDelta() As Double '

Dim GOut() As Variant ' ( 1 , num_layers)

Dim GSum() As Variant ' , *

Dim num_layers As Integer ' ,

Dim InpVector() As Double '

Dim OutVector() As Double '

Dim RealOut() As Double '

Dim Layer1_out() As Double '

Dim list As String ' .

Dim savelist As String '

Dim Alpha As Double '

Dim Error As Double '

Dim CurError As Double '

Dim MaxStep As Long '

Dim MaxSample As Long ' list

Dim Nu2 As Double '

Dim Nu1 As Double '

Dim num_error As Long '

Dim BINARY As Integer ' 1 - 0-1, 0 float, 2 float, 0-1

Dim TANGENSOID As Integer ' 1 , 2 , 0

Dim TEST_SIGNAL As Boolean ' , 1

Dim LINE_SIGNAL As Boolean ' true, , false, (i - (i-1))

Dim Mx As Integer ' GMatrix - , PrintList

Dim start_valid_pos As Integer '

Dim end_valid_pos As Integer '

Dim start_test As Integer ' ,

Dim end_test As Integer ' ,

Dim learning_number_example As Integer ' ( end_valid_pos)

Dim MaxValue As Double

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

Sub NNet()

Application.ScreenUpdating = False '

Application.EnableEvents = False

Application.Calculation = xlCalculationManual

TEST_SIGNAL = False '

tmp = SetParams()

tmp = Preprocess()

tmp = ClearList()

tmp = CreateNet()

tmp = InitNet()

tmp = Backpropagation()

tmp = PrintList()

tmp = PlotSuccessResult()

Application.ScreenUpdating = True '

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

 

End Sub

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

 

Sub Test()

'

Worksheets("0").Cells(2, 3).Value = 3

tmp = SetParams()

TEST_SIGNAL = True

tmp = ClearList()

tmp = CreateNet()

tmp = InitNet()

tmp = Calc(10)

tmp = CountError()

tmp = Backpropagation()

tmp = PrintList()

End Sub

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

 

Function SetParams()

'

GInputs = Array(5, 6, 7, 8) '

GOutputs = Array(8) '

GNeuro = Array(4, 8, 8, 1)

num_layers = 3 '

start_valid_pos = 13

end_valid_pos = 23

learning_number_example = 150 '

start_test = 4

end_test = 13

LINE_SIGNAL = False

inp = 4

NEU = 10

OUT = 1

list = "2"

savelist = "save"

Alpha = 0.5

MaxStep = 1000000

Nu1 = 0.05

Nu2 = 0.05

num_error = 10

BINARY = 0 ' / = 0/1

TANGENSOID = 1

If BINARY = 1 Or BINARY = 2 Then

Error = 3 '

Else

Error = 0.03 ' ## !!!!

End If

Worksheets(list).Activate '

ActiveCell.SpecialCells(xlLastCell).Select

MaxSample = ActiveCell.Row

End Function

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

 

Function CreateNet() As Integer

' ( )

ReDim Matrix1(NEU, inp)

ReDim Matrix2(OUT, NEU)

ReDim InpVector(inp)

ReDim OutVector(OUT)

ReDim RealOut(OUT)

ReDim Layer1_out(NEU)

'ReDim GNeurons(num_layers)

'

num_layers = UBound(GNeuro)

Mx = 0

For i = 0 To num_layers Step 1 '

If GNeuro(i) > Mx Then

Mx = GNeuro(i)

End If

Next i

ReDim GMatrix(num_layers - 1, Mx, Mx) '

ReDim GOut(num_layers - 1, Mx) '

ReDim GSum(num_layers - 1, Mx) '

ReDim GDelta(num_layers - 1, Mx) '

ReDim GError(GNeuro(num_layers))

'UBound(GNeuro,1)

CreateNet = 0

End Function

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

 

Function InitNet()

'

Randomize

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

For z = 0 To GNeuro(i) - 1 Step 1

tmp = Rnd

GMatrix(i, j, z) = tmp * 2 - 1

Next z

Next j

Next i

'

If TEST_SIGNAL = True Then

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

For z = 0 To GNeuro(i) - 1 Step 1

GMatrix(i, j, z) = 1

Next z

Next j

Next i

End If

InitNet = 0

End Function

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

 

Function SetIO(num As Integer)

'

tmp = 0

If BINARY = 1 Then ' 0 1

sz = UBound(GInputs)

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

tmp = Cells(num, GInputs(i)).Value - Cells(num - 1, GInputs(i)).Value

Else

tmp = Cells(num, GInputs(i)).Value

End If

If tmp > 0 Then

InpVector(i) = 1

Else

InpVector(i) = 0

End If

Next i

sz = UBound(GOutputs)

'

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

tmp = Cells(num - 1, GOutputs(i)).Value - Cells(num - 2, GOutputs(i)).Value

Else

tmp = Cells(num - 1, GOutputs(i)).Value

End If

If tmp > 0 Then

OutVector(i) = 1

Else

OutVector(i) = 0

End If

Next i

ElseIf BINARY = 0 Then ' \ = float

sz = UBound(GInputs)

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

InpVector(i) = (Cells(num, GInputs(i)).Value - Cells(num - 1, GInputs(i)).Value) / MaxValue

Else

InpVector(i) = Cells(num, GInputs(i)).Value / MaxValue

End If

Next i

sz = UBound(GOutputs)

'

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

OutVector(i) = (Cells(num - 1, GOutputs(i)).Value - Cells(num - 2, GOutputs(i)).Value) / MaxValue

Else

OutVector(i) = Cells(num - 1, GOutputs(i)).Value / MaxValue

End If

Next i

ElseIf BINARY = 2 Then ' = float, = 0/1

sz = UBound(GInputs)

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

InpVector(i) = (Cells(num, GInputs(i)).Value - Cells(num - 1, GInputs(i)).Value) / MaxValue

Else

InpVector(i) = Cells(num, GInputs(i)).Value / MaxValue

End If

Next i

'

sz = UBound(GOutputs)

For i = 0 To sz Step 1

If LINE_SIGNAL = False Then

tmp = Cells(num - 1, GOutputs(i)).Value - Cells(num - 2, GOutputs(i)).Value

Else

tmp = Cells(num - 1, GOutputs(i)).Value

End If

If tmp > 0 Then

OutVector(i) = 1

Else

OutVector(i) = 0

End If

Next i

End If

' TEST SIGNAL

If TEST_SIGNAL = True Then

InpVector(0) = 1

InpVector(1) = 1

InpVector(2) = 1

InpVector(3) = 1

OutVector(0) = 0

End If

End Function

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

 

Function Calc(num As Integer) As Double

' num

SetIO (num)

Dim temp As Double

' GMatrix

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

temp = 0

For z = 0 To GNeuro(i) - 1 Step 1

If i = 0 Then

temp = temp + GMatrix(i, j, z) * InpVector(z)

Else

temp = temp + GMatrix(i, j, z) * GOut(i - 1, j)

End If

Next z

GSum(i, j) = temp '

If TANGENSOID = 0 Then '

GOut(i, j) = Porog(temp)

ElseIf TANGENSOID = 1 Then '

GOut(i, j) = Tang(temp)

Else '

GOut(i, j) = Sigm(temp)

End If

Next j

Next i

Calc = 0

End Function

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

 

Function Backpropagation()

' (BackProp, Back Propogation Algorithm)

If BINARY > 0 Or TANGENSOID = 0 Then

Exit Function

End If

num_error = Mx + 10 ' 0

ttt = 0 ' ,

Randomize

For i = 0 To MaxStep Step 1

num = Rnd * learning_number_example + end_valid_pos

If CountError() < Error Then ' ,

lkl = PlotSuccessResult()

Exit For

End If

Calc (num)

tmp = GDeltaToNull() '

' , GNeuro(num_layers)!!!!

'

For j = 0 To GNeuro(num_layers) - 1 Step 1

GError(j) = GOut(num_layers - 1, j) - OutVector(0)

GDelta(num_layers - 1, j) = GError(j) * Derivative(GSum(num_layers - 1, j)) ' GDelta

Next j

'

For j = 0 To GNeuro(num_layers) - 1 Step 1

For z = 0 To GNeuro(num_layers - 1) - 1 Step 1

GMatrix(num_layers - 1, j, z) = GMatrix(num_layers - 1, j, z) - Nu1 * GDelta(num_layers - 1, j) * GOut(num_layers - 2, z)

If Abs(GMatrix(num_layers - 1, j, z)) > 2 Then

tmp = Rnd

GMatrix(num_layers - 1, j, z) = tmp * 2 - 1

End If

Next z

Next j

'

For j = num_layers - 2 To 0 Step -1 '

For z = 0 To GNeuro(j + 1) - 1 Step 1 '

For k = 0 To GNeuro(j + 2) - 1 Step 1 '

GDelta(j, z) = GDelta(j, z) + GDelta(j + 1, k) * Derivative(GSum(j, z)) ' j-

Next k

Next z

'

For z = 0 To GNeuro(j) - 1 Step 1

For k = 0 To GNeuro(j + 1) - 1 Step 1

If j > 0 Then

GMatrix(j, k, z) = GMatrix(j, k, z) - Nu1 * GDelta(j, k) * GOut(j - 1, z)

Else

GMatrix(j, k, z) = GMatrix(j, k, z) - Nu1 * GDelta(j, k) * InpVector(z)

End If

If Abs(GMatrix(j, k, z)) > 2 Then

tmp = Rnd

GMatrix(j, k, z) = tmp * 2 - 1

End If

Next k

Next z

Next j

num_error = num_error + 1 '

If num_error > 63000 Then

num_error = Mx + 10

ttt = ttt + 5

End If

Worksheets("0").Cells(num_error, ttt + 1).Value = i

Worksheets("0").Cells(num_error, ttt + 2).Value = num

Worksheets("0").Cells(num_error, ttt + 3).Value = CurError

'str1 = "" '

'For w = 0 To UBound(InpVector) - 1 Step 1

' str1 = str1 + CStr(Round(InpVector(w), 4)) + " "

'Next w

'Worksheets("0").Cells(num_error, ttt + 5).Value = str1

tmp = PrintList()

Next i

Backpropagation = 0

End Function

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

 

Function CountError()

'

If BINARY = 1 Or BINARY = 2 Then '

CurError = 10 ' , ,

Else

CurError = 0 ' float

End If

If end_valid_pos > 0 Then

end_point = end_valid_pos ' ,

Else

end_point = learning_number_example

End If

For k = 0 To GNeuro(num_layers) - 1 Step 1 '

For i = start_valid_pos To end_point Step 1 '

Calc (i)

If BINARY = 1 Or BINARY = 2 Then '

If GOut(num_layers - 1, k) > 0 And OutVector(0) > 0 Then

CurError = CurError - 1

ElseIf GOut(num_layers - 1, k) = 0 And OutVector(0) = 0 Then

CurError = CurError - 1

End If

Else

CurError = CurError + Abs(GOut(num_layers - 1, k) - OutVector(0))

End If

Next i

Next k

CurError = CurError / (end_point - start_valid_pos)

CountError = CurError

End Function

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

 

Function Tang(sea As Double) As Double

Tang = (Exp(Alpha * sea) - Exp((-1) * Alpha * sea)) / (Exp(Alpha * sea) + Exp((-1) * Alpha * sea))

End Function

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

 

Function Sigm(sea As Double) As Double

Sigm = 1 / (1 - Exp((-1) * Alpha * sea))

End Function

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

 

Function Porog(sea As Double) As Double

If sea > 0 Then

Porog = 1

Else

Porog = 0

End If

End Function

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

 

Function Derivative(inp As Variant) As Double

If TANGENSOID = 1 Then '

Derivative = (1 - inp * inp)

ElseIf TANGENSOID = 2 Then '

Derivative = inp / (1 - inp)

End If

End Function

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

 

Function PrintList()

Worksheets("0").Activate

'

sm = 0 '

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

For z = 0 To GNeuro(i) - 1 Step 1

Cells(j + 1, z + 1 + sm).Value = GMatrix(i, j, z)

Next z

Next j

sm = sm + GNeuro(i) + 1 ' +1

Next i

sm = sm + 1

' Input

For i = 0 To inp - 1 Step 1

Cells(i + 1, sm).Value = InpVector(i)

Next i

sm = sm + 2

' OUT

For i = 0 To GNeuro(num_layers) - 1 Step 1

Cells(i + 1, sm).Value = OutVector(i)

Cells(i + 1, sm + 1).Value = GOut(num_layers - 1, i)

Cells(i + 1, sm + 2).Value = GError(i)

Next i

' GOut

k = 0

For i = 0 To num_layers - 2 Step 1

For j = 0 To GNeuro(i + 1) Step 1

Cells(j + Mx + 4, 14 + i + k).Value = GSum(i, j) ' ,

Cells(j + Mx + 4, 15 + i + k).Value = GOut(i, j) '

Cells(j + Mx + 4, 16 + i + k).Value = GDelta(i, j) ' GDelta

Next j

k = k + 3

Next i

' GDelta

Worksheets(list).Activate

End Function

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

 

Function ClearList()

'

Worksheets("0").Activate

Cells.Select

Selection.ClearContents

Range("A1").Select

Worksheets(list).Activate

End Function

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

 

Function GDeltaToNull()

Erase GDelta

ReDim GDelta(num_layers - 1, Mx) '

End Function

Function Preprocess()

' ,

MaxValue = 0

Worksheets(list).Activate

For i = start_valid_pos To end_valid_pos + learning_number_example Step 1

sz = UBound(GInputs)

For j = 0 To sz Step 1

If LINE_SIGNAL = False Then

tmp = Abs(Cells(i, GInputs(j)).Value - Cells(i - 1, GInputs(j)).Value)

Else

tmp = Cells(i, GInputs(j)).Value

End If

If MaxValue < tmp Then

MaxValue = tmp

End If

Next j

Next i

End Function

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

 

Function PlotSuccessResult()

'

pos1 = 0

For i = start_valid_pos To end_valid_pos Step 1 '

Calc (i)

ll = GNeuro(num_layers)

For k = 0 To GNeuro(num_layers) - 1 Step 1 '

pos1 = Mx * 2 + i * ll + k

Worksheets("0").Cells(pos1, 19) = i

Worksheets("0").Cells(pos1, 20).Value = OutVector(k)

Worksheets("0").Cells(pos1, 21).Value = GOut(num_layers - 1, k)

Worksheets("0").Cells(pos1, 22).Value = OutVector(k) - GOut(num_layers - 1, k)

Next k

Next i

pos1 = pos1 + 2

' ,

z = 0

For i = start_test To end_test Step 1 '

Calc (i)

ll = GNeuro(num_layers)

For k = 0 To GNeuro(num_layers) - 1 Step 1 '

Worksheets("0").Cells(pos1 + k, 19) = i

Worksheets("0").Cells(pos1 + k, 20).Value = OutVector(k)

Worksheets("0").Cells(pos1 + k, 21).Value = GOut(num_layers - 1, k)

Worksheets("0").Cells(pos1 + k, 22).Value = OutVector(k) - GOut(num_layers - 1, k)

Next k

z = z + 1

pos1 = pos1 + GNeuro(num_layers)

Next i

End Function

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

 

Function SaveNet()

k = 1 ' savelist

Worksheets(savelist).Activate

Cells(k, 1).Value = "Sheet"

Cells(k, 2).Value = list '

k = k + 1

Cells(k, 1).Value = "Alpha"

Cells(k, 2).Value = Alpha '

k = k + 1

Cells(k, 1).Value = "Type_fa" '

Cells(k, 2).Value = TANGENSOID

k = k + 1

Cells(k, 1).Value = "IO type"

Cells(k, 2).Value = BINARY

k = k + 1

'

s = UBound(GInputs)

Cells(k, 1).Value = "Inputs"

Cells(k, 2).Value = s + 1 ' , 0-

k = k + 1

For i = 0 To s Step 1

Cells(k, 2).Value = GInputs(i)

k = k + 1

Next i

'

s = UBound(GOutputs)

Cells(k, 1).Value = "Outputs"

Cells(k, 2).Value = s + 1

k = k + 1

For i = 0 To s Step 1

Cells(k, 2).Value = GOutputs(i)

k = k + 1

Next i

'

s = UBound(GNeuro)

Cells(k, 1).Value = "Layers"

Cells(k, 2).Value = s + 1

k = k + 1

For i = 0 To s Step 1

Cells(k, 2).Value = GNeuro(i)

k = k + 1

Next i

'

sm = 0 '

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

For z = 0 To GNeuro(i) - 1 Step 1

Cells(k + j + 1 + sm, z + 1).Value = GMatrix(i, j, z)

Next z

Next j

sm = sm + GNeuro(i + 1) + 1 ' +1

Next i

End Function

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

 

Function LoadNet()

'

Worksheets(savelist).Activate

k = 0 '

list = Cells(1, 2).Value

Alpha = Cells(2, 2).Value

TANGENSOID = CInt(Cells(3, 2).Value)

BINARY = CInt(Cells(4, 2).Value)

'

s = Cells(5, 2).Value

k = 6

ReDim GInputs(s - 1)

For i = 0 To s - 1 Step 1

GInputs(i) = Cells(6 + i, 2).Value

k = k + 1

Next i

'

s = Cells(k, 2).Value

k = k + 1

ReDim GOutputs(s - 1)

For i = 0 To (s - 1) Step 1

GOutputs(i) = Cells(k, 2).Value

k = k + 1

Next i

'

s = Cells(k, 2).Value

k = k + 1

ReDim GNeuro(s - 1)

For i = 0 To (s - 1) Step 1

GNeuro(i) = Cells(k, 2).Value

k = k + 1

Next i

'

sm = 0 '

num_layers = UBound(GNeuro)

k = k + 1

For i = 0 To num_layers - 1 Step 1 ' , GNeuro

For j = 0 To GNeuro(i + 1) - 1 Step 1

For z = 0 To GNeuro(i) - 1 Step 1

GMatrix(i, j, z) = Cells(k + j + sm, z + 1).Value

Next z

Next j

sm = sm + GNeuro(i + 1) + 1 ' +1

Next i

'

start_valid_pos = 13

end_valid_pos = 23

start_test = 3

end_test = 13

learning_number_example = 150 '

LINE_SIGNAL = False

TEST_SIGNAL = False

savelist = "save"

MaxStep = 1000000

Nu1 = 0.05

Nu2 = 0.05

num_error = 10

If BINARY = 1 Or BINARY = 2 Then

Error = 3 '

Else

Error = 0.006

End If

Mx = 0

For i = 0 To num_layers Step 1 '

If GNeuro(i) > Mx Then

Mx = GNeuro(i)

End If

Next i

ReDim GOut(num_layers - 1, Mx) '

ReDim GSum(num_layers - 1, Mx) '

ReDim GDelta(num_layers - 1, Mx) '

ReDim GError(GNeuro(num_layers))

Worksheets(list).Activate

End Function

 

 

( ).


forex, .
( )


@Mail.ru

 
 
VBA -2014
, E-mail: apsheronka@mail.ru
,


- !