classtrainingset.cls

采用vb编写的利用循环神经网络来预测股票走势的源程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassTrainingSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public NoOfInstances As Integer
Public instances As New Collection

Dim MinValue() As Single
Dim MaxValue() As Single


Public Function getMinValue(index As Integer) As Single
  getMinValue = MinValue(index)
End Function

Public Function getMaxValue(index As Integer) As Single
  getMaxValue = MaxValue(index)
End Function



Public Sub addInstance(newInstance As classTrainingInstance)
  Call instances.Add(newInstance)
  NoOfInstances = NoOfInstances + 1
End Sub


Public Function getInstance(index As Integer) As classTrainingInstance
  If (index < NoOfInstances) Then
    Set getInstance = instances.Item(index + 1)
  End If
End Function


Public Sub Clear()
'deletes all instances
  Dim i As Integer
  
  For i = instances.Count To 1 Step -1
    Call instances.Remove(i)
  Next
  NoOfInstances = 0
End Sub


Public Sub Save(filename As String)
  Dim i As Integer
  Dim inst As classTrainingInstance
  Dim FileNumber As Integer

  FileNumber = FreeFile
  Open filename For Output As #FileNumber
    Print #FileNumber, "[Training Set]"
    Print #FileNumber, instances.Count
    For i = 0 To instances.Count - 1
      Set inst = getInstance(i)
      Call inst.Save(FileNumber)
    Next
  Close #FileNumber
End Sub


Public Sub Load(filename As String)
  Dim i As Integer
  Dim inst As classTrainingInstance
  Dim dummy As String
  Dim NoOfInstances As Integer
  Dim FileNumber As Integer

  Call Clear
  FileNumber = FreeFile
  Open filename For Input As #FileNumber
    Input #FileNumber, dummy
    Print #FileNumber, NoOfInstances
    For i = 0 To NoOfInstances - 1
      Set inst = New classTrainingInstance
      Call inst.Load(FileNumber)
    Next
  Close #FileNumber
End Sub



Public Sub Train(bp As ClassBackprop)
'performs a single training pass using the given network
  Dim i As Integer
  Dim inst As classTrainingInstance
  
  For i = 1 To instances.Count
    Set inst = instances.Item(i)
    Call bp.loadTrainingInstance(inst)
    Call bp.update
  Next
End Sub



Public Sub ImportTimeSeries(filename As String, Dimensions As Integer, TimeDelay As Integer)
  Dim FileNumber As Integer
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim n As Integer
  Dim dataStr As String
  Dim inst As classTrainingInstance
  Dim prevHistory() As Single
  Dim dataVal As Single
  Dim dv As Single
  Dim currentData() As Single
  
  If (filename <> "") Then
  
  ReDim MinValue(Dimensions)
  ReDim MaxValue(Dimensions)
  For i = 0 To Dimensions - 1
    MinValue(i) = 9999
    MaxValue(i) = -9999
  Next
  
  Call Clear
  ReDim currentData(Dimensions)
  ReDim prevHistory(Dimensions, TimeDelay + 1)
  i = 0
  FileNumber = FreeFile
  Open filename For Input As #FileNumber
  While (Not EOF(FileNumber))
    dataVal = getNextValue(FileNumber)
    
    If (dataVal <> -9999) Then
      If (dataVal < MinValue(i)) Then
        MinValue(i) = dataVal
      End If
      If (dataVal > MaxValue(i)) Then
        MaxValue(i) = dataVal
      End If
    
      i = i + 1
      If (i >= Dimensions) Then
        i = 0
      End If
    End If
  Wend
  Close #FileNumber
  
  i = 0
  FileNumber = FreeFile
  Open filename For Input As #FileNumber
  While (Not EOF(FileNumber))
    dataVal = getNextValue(FileNumber)
    
    If (dataVal <> -9999) Then
    
      dv = MaxValue(i) - MinValue(i)
      If (dv > 0) Then
        dataVal = Abs(((dataVal - MinValue(i)) * 0.6) / dv) + 0.2
        Else
        dataVal = 0
      End If
      
      currentData(i) = dataVal
    
      i = i + 1
      If (i >= Dimensions) Then
        i = 0
        
        Set inst = New classTrainingInstance
        Call inst.init(Dimensions * TimeDelay, Dimensions)
        
        n = 0
        For k = 0 To TimeDelay - 1
          For j = 0 To Dimensions - 1
            Call inst.setInput(n, prevHistory(j, k))
            n = n + 1
          Next
        Next
                
        For j = 0 To Dimensions - 1
          Call inst.setOutput(j, currentData(j))
        Next
        Call addInstance(inst)
        
        'update the historical data
        For j = 0 To Dimensions - 1
          For k = TimeDelay - 1 To 1 Step -1
            prevHistory(j, k) = prevHistory(j, k - 1)
          Next
        Next
        For j = 0 To Dimensions - 1
          prevHistory(j, 0) = currentData(j)
        Next
        
      End If
    End If
  Wend
  Close #FileNumber
  
  End If
  
End Sub

Private Function getNextValue(FileNumber As Integer) As Single
  Dim i As Integer
  Dim c As String
  Dim dataStr As String
  
  c = Input(1, #FileNumber)
  While ((Asc(c) < 48) Or (Asc(c) > 58)) And (Not EOF(FileNumber))
    c = Input(1, #FileNumber)
  Wend
  
  If (Asc(c) > 48) And (Asc(c) < 58) Then
    dataStr = c
  End If
  While (c <> " ") And (c <> ",") And (Asc(c) <> 13) And (Not EOF(FileNumber))
    c = Input(1, #FileNumber)
    dataStr = dataStr & c
  Wend
  If (dataStr <> "") Then
    getNextValue = Val(dataStr)
    Else
    getNextValue = -9999
  End If
End Function