PureBasic Forums - English

Posted: **Fri Jun 19, 2009 11:55 am**

well.. guess there are already some examples around but maybe
someone likes this implementation more :P

CDoublyLinkedList.pbi
http://www.purebasic.fr/english/viewtopic.php?t=36278

CNeuralNetwork.pbi

Code: Select all

XIncludeFile "CDoublyLinkedList.pbi"

Interface INeuralNetwork
;- public
 ;network construction
  addHiddenLayer(number.i = 1)
  addNeuron(layer.i, number.i = 1)
  removeNeuron(layer.i)
  removeHiddenLayer(layer.i)
  clearLayer(layer.i)
  buildSynapses()
  ;for rebuilding, must be called prior
  ;to network manipulation if the synapses were already built
  clearSynapses()
 ;data manipulation
  getNeuronInput.f(layer.i, neuron.i)
  getNeuronOutput.f(layer.i, neuron.i)
  getNeuronBias.f(layer.i, neuron.i)
  setNeuronInput(layer.i, neuron.i, value.f)
  setNeuronOutput(layer.i, neuron.i, value.f)
  setNeuronBias(layer.i, neuron.i, value.f)
  getNeuronSynapseWeight.f(srcLayer.i, srcNeuron.i, destNeuron.i)
  setNeuronSynapseWeight(srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
  getLearningRate.f()
  setLearningRate(value.f)
 ;information
  getLayerCount()
  getNeuronCount(layer.i)
 ;feed-forward
  update()
 ;propagation of error
  teach.f()
 ;file operations
  load(FileID.i)
  save(FileID.i)
 ;network destruction
  clear()
 ;free object
  delete()
;- private
 ;getter
  getNeuron(layer.i, neuron.i)
EndInterface

;layer index:
; input: -2
; output: -1
; hidden layer: 0 <= i < hidden layers

#INN_InputLayer = -2
#INN_OutputLayer = -1

Structure ENeuralNetworkNeuronList
 *layer.IDoublyLinkedList
EndStructure

Structure ENeuralNetworkNeuron
 synapses.IDoublyLinkedList
 bias.f
 delta.f
 input.f
 output.f
EndStructure

Structure ENeuralNetworkSynapse
 *srcNeuron.ENeuralNetworkNeuron
 weight.f
EndStructure

Structure ONeuralNetwork
 ;Address to the methods array
 methodAddress.i
 ;Class Attributes
 input.ENeuralNetworkNeuronList
 layers.IDoublyLinkedList
 learningRate.f
 networkBuilt.i
EndStructure


Declare.i newNeuralNetwork(learningRate.f = 0.5)
Declare.i NeuralNetwork_addHiddenLayer(*this.INeuralNetwork, number.i = 1)
Declare.i NeuralNetwork_addNeuron(*this.INeuralNetwork, layer.i, number.i = 1)
Declare.i NeuralNetwork_removeNeuron(*this.INeuralNetwork, layer.i)
Declare.i NeuralNetwork_removeHiddenLayer(*this.INeuralNetwork, layer.i)
Declare.i NeuralNetwork_clearLayer(*this.INeuralNetwork, layer.i)
Declare.i NeuralNetwork_buildSynapses(*this.INeuralNetwork)
Declare.i NeuralNetwork_clearSynapses(*this.INeuralNetwork)
Declare.f NeuralNetwork_getNeuronInput(*this.INeuralNetwork, layer.i, neuron.i)
Declare.f NeuralNetwork_getNeuronOutput(*this.INeuralNetwork, layer.i, neuron.i)
Declare.f NeuralNetwork_getNeuronBias(*this.INeuralNetwork, layer.i, neuron.i)
Declare.i NeuralNetwork_setNeuronInput(*this.INeuralNetwork, layer.i, neuron.i, value.f)
Declare.i NeuralNetwork_setNeuronOutput(*this.INeuralNetwork, layer.i, neuron.i, value.f)
Declare.i NeuralNetwork_setNeuronBias(*this.INeuralNetwork, layer.i, neuron.i, value.f)
Declare.f NeuralNetwork_getNeuronSynapseWeight(*this.INeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i)
Declare.i NeuralNetwork_setNeuronSynapseWeight(*this.INeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
Declare.f NeuralNetwork_getLearningRate(*this.INeuralNetwork)
Declare.i NeuralNetwork_setLearningRate(*this.INeuralNetwork, value.f)
Declare.i NeuralNetwork_getLayerCount(*this.INeuralNetwork)
Declare.i NeuralNetwork_getNeuronCount(*this.INeuralNetwork, layer.i)
Declare.i NeuralNetwork_update(*this.INeuralNetwork)
Declare.f NeuralNetwork_teach(*this.INeuralNetwork)
Declare.i NeuralNetwork_load(*this.INeuralNetwork, FileID.i)
Declare.i NeuralNetwork_save(*this.INeuralNetwork, FileID.i)
Declare.i NeuralNetwork_clear(*this.INeuralNetwork)
Declare   NeuralNetwork_delete(*this.INeuralNetwork)
Declare.i NeuralNetwork_getNeuron(*this.INeuralNetwork, layer.i, neuron.i)


DataSection
 ONeuralNetwork_methods:
  Data.i @NeuralNetwork_addHiddenLayer()
  Data.i @NeuralNetwork_addNeuron()
  Data.i @NeuralNetwork_removeNeuron()
  Data.i @NeuralNetwork_removeHiddenLayer()
  Data.i @NeuralNetwork_clearLayer()
  Data.i @NeuralNetwork_buildSynapses()
  Data.i @NeuralNetwork_clearSynapses()
  Data.i @NeuralNetwork_getNeuronInput()
  Data.i @NeuralNetwork_getNeuronOutput()
  Data.i @NeuralNetwork_getNeuronBias()
  Data.i @NeuralNetwork_setNeuronInput()
  Data.i @NeuralNetwork_setNeuronOutput()
  Data.i @NeuralNetwork_setNeuronBias()
  Data.i @NeuralNetwork_getNeuronSynapseWeight()
  Data.i @NeuralNetwork_setNeuronSynapseWeight()
  Data.i @NeuralNetwork_getLearningRate()
  Data.i @NeuralNetwork_setLearningRate()
  Data.i @NeuralNetwork_getLayerCount()
  Data.i @NeuralNetwork_getNeuronCount()
  Data.i @NeuralNetwork_update()
  Data.i @NeuralNetwork_teach()
  Data.i @NeuralNetwork_load()
  Data.i @NeuralNetwork_save()
  Data.i @NeuralNetwork_clear()
  Data.i @NeuralNetwork_delete()
  Data.i @NeuralNetwork_getNeuron()
EndDataSection


Procedure.i newNeuralNetwork(learningRate.f = 0.5)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList
 *object = AllocateMemory(SizeOf(ONeuralNetwork))
 If *object = #Null
  ProcedureReturn #Null
 EndIf
 *object\methodAddress = ?ONeuralNetwork_methods
 *object\input\layer = newDoublyLinkedList(SizeOf(ENeuralNetworkNeuron))
 If *object\input = #Null
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *object\layers = newDoublyLinkedList(SizeOf(INTEGER))
 If *object\layers = #Null
  *object\input\layer\delete()
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 ;add output layer
 *aLayer = *object\layers\addE()
 If *aLayer = #Null
  *object\layers\delete()
  *object\input\layer\delete()
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *aLayer\layer = newDoublyLinkedList(SizeOf(ENeuralNetworkNeuron))
 If *aLayer\layer = #Null
  *object\layers\delete()
  *object\input\layer\delete()
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *object\learningRate = learningRate
 *object\networkBuilt = #False
 ProcedureReturn *object
EndProcedure


Procedure.i NeuralNetwork_addHiddenLayer(*this.INeuralNetwork, number.i = 1)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null Or number < 1
  ProcedureReturn #False
 EndIf
 *object = *this
 For i = 1 To number
  *object\layers\firstE()
  *aLayer = *object\layers\insertE()
  If *aLayer = #Null
   ProcedureReturn #False
  EndIf
  *aLayer\layer = newDoublyLinkedList(SizeOf(ENeuralNetworkNeuron))
  If *aLayer\layer = #Null
   *object\layers\deleteE()
   ProcedureReturn #False
  EndIf
 Next i
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_addNeuron(*this.INeuralNetwork, layer.i, number.i = 1)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null Or number < 1
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt
  ProcedureReturn #False
 EndIf
 If layer = #INN_InputLayer
  *aLayer = *object\input
 ElseIf layer = #INN_OutputLayer
  *aLayer = *object\layers\lastE()
 Else
  If layer >= *object\layers\size()
   ProcedureReturn #False
  EndIf
  *aLayer = *object\layers\selectE(layer)
 EndIf
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn #False
 EndIf
 For i = 1 To number
  *aLayer\layer\firstE()
  *neuron = *aLayer\layer\addE()
  If *neuron = #Null
   ProcedureReturn #False
  EndIf
  *neuron\synapses = newDoublyLinkedList(SizeOf(ENeuralNetworkSynapse))
  If *neuron\synapses = #Null
   *aLayer\layer\deleteE()
   ProcedureReturn #False
  EndIf
 Next i
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_removeNeuron(*this.INeuralNetwork, layer.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt
  ProcedureReturn #False
 EndIf
 If layer = #INN_InputLayer
  *aLayer = *object\input
 ElseIf layer = #INN_OutputLayer
  *aLayer = *object\layers\lastE()
 Else
  If layer >= *object\layers\size()
   ProcedureReturn #False
  EndIf
  *aLayer = *object\layers\selectE(layer)
 EndIf
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn #False
 EndIf
 *neuron = *aLayer\layer\lastE()
 If *neuron = #Null
  ProcedureReturn #False
 EndIf
 *neuron\synapses\delete()
 If *aLayer\layer\deleteE() = #Null
  ProcedureReturn #False
 EndIf
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_removeHiddenLayer(*this.INeuralNetwork, layer.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt
  ProcedureReturn #False
 EndIf
 If layer >= *object\layers\size()
  ProcedureReturn #False
 EndIf
 *aLayer = *object\layers\selectE(layer)
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn #False
 EndIf
 *aLayer\layer\reset()
 While *aLayer\layer\nextE()
  *neuron = *aLayer\layer\currentE()
  If *neuron\synapses
   *neuron\synapses\delete()
  EndIf
 Wend
 If *aLayer\layer\deleteE() = #Null
  ProcedureReturn #False
 EndIf
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_clearLayer(*this.INeuralNetwork, layer.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt
  ProcedureReturn #False
 EndIf
 If layer = #INN_InputLayer
  *aLayer = *object\input
 ElseIf layer = #INN_OutputLayer
  *aLayer = *object\layers\lastE()
 Else
  If layer >= *object\layers\size()
   ProcedureReturn #False
  EndIf
  *aLayer = *object\layers\selectE(layer)
 EndIf
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn #False
 EndIf
 *aLayer\layer\reset()
 While *aLayer\layer\nextE()
  *neuron = *aLayer\layer\currentE()
  If *neuron\synapses
   *neuron\synapses\clear()
  EndIf
 Wend
 *aLayer\layer\clear()
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_buildSynapses(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *synapse.ENeuralNetworkSynapse
 Protected *srcNeuron.ENeuralNetworkNeuron, *destNeuron.ENeuralNetworkNeuron
 Protected *srcLayer.ENeuralNetworkNeuronList, *destLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\layers\size() < 1
  ProcedureReturn #False
 EndIf
 If *object\networkBuilt
  ProcedureReturn #True
 EndIf
 *destLayer = *object\input
 *object\layers\reset()
 While *object\layers\nextE()
  *srcLayer = *destLayer
  *destLayer = *object\layers\currentE()
  *destLayer\layer\reset()
  While *destLayer\layer\nextE()
   *destNeuron = *destLayer\layer\currentE()
   If *destNeuron\synapses
    *destNeuron\synapses\clear()
   Else
    ProcedureReturn #False
   EndIf
   *destNeuron\bias = Random($FFFFFF) / $FFFFFF
   *srcLayer\layer\reset()
   While *srcLayer\layer\nextE()
    *srcNeuron = *srcLayer\layer\currentE()
    *destNeuron\synapses\lastE()
    *synapse = *destNeuron\synapses\addE()
    If *synapse = #Null
     ProcedureReturn #False
    EndIf
    *synapse\srcNeuron = *srcNeuron
    *synapse\weight = Random($FFFFFF) / $FFFFFF
   Wend
  Wend
 Wend
 *object\networkBuilt = #True
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_clearSynapses(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 *aLayer = *object\input
 *aLayer\layer\reset()
 While *aLayer\layer\nextE()
  *neuron = *aLayer\layer\currentE()
  If *neuron\synapses
   *neuron\synapses\clear()
  EndIf
 Wend
 *object\layers\reset()
 While *object\layers\nextE()
  *aLayer = *object\layers\currentE()
  If *aLayer\layer
   *aLayer\layer\reset()
   While *aLayer\layer\nextE()
    *neuron = *aLayer\layer\currentE()
    If *neuron\synapses
     *neuron\synapses\clear()
    EndIf
   Wend
  EndIf
 Wend
 *object\networkBuilt = #False
 ProcedureReturn #True
EndProcedure


Procedure.f NeuralNetwork_getNeuronInput(*this.INeuralNetwork, layer.i, neuron.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn 0
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn 0
 EndIf
 ProcedureReturn *neuron\input
EndProcedure


Procedure.f NeuralNetwork_getNeuronOutput(*this.INeuralNetwork, layer.i, neuron.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn 0
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn 0
 EndIf
 ProcedureReturn *neuron\output
EndProcedure


Procedure.f NeuralNetwork_getNeuronBias(*this.INeuralNetwork, layer.i, neuron.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn 0
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn 0
 EndIf
 ProcedureReturn *neuron\bias
EndProcedure


Procedure.i NeuralNetwork_setNeuronInput(*this.INeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn #False
 EndIf
 *neuron\input = value
 If layer = #INN_InputLayer
  *neuron\output = value
 EndIf
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_setNeuronOutput(*this.INeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null Or layer = #INN_InputLayer
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn #False
 EndIf
 *neuron\output = value
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_setNeuronBias(*this.INeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron
 If *this = #Null Or layer = #INN_InputLayer
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 *neuron = *this\getNeuron(layer, neuron)
 If *neuron = #Null
  ProcedureReturn #False
 EndIf
 *neuron\bias = value
 ProcedureReturn #True
EndProcedure


Procedure.f NeuralNetwork_getNeuronSynapseWeight(*this.INeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *synapse.ENeuralNetworkSynapse, destLayer.i
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn 0
 EndIf
 Select srcLayer
  Case #INN_InputLayer
   destLayer = 0
  Case #INN_OutputLayer
   ProcedureReturn 0
  Default
   destLayer = srcLayer + 1
 EndSelect
 *neuron = *this\getNeuron(destLayer, destNeuron)
 If *neuron = #Null
  ProcedureReturn 0
 EndIf
 If *neuron\synapses = #Null
  ProcedureReturn 0
 EndIf
 *synapse = *neuron\synapses\selectE(srcNeuron)
 If *synapse = #Null
  ProcedureReturn 0
 EndIf
 ProcedureReturn *synapse\weight
EndProcedure


Procedure.i NeuralNetwork_setNeuronSynapseWeight(*this.INeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *synapse.ENeuralNetworkSynapse, destLayer.i
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 Select srcLayer
  Case #INN_InputLayer
   destLayer = 0
  Case #INN_OutputLayer
   ProcedureReturn 0
  Default
   destLayer = srcLayer + 1
 EndSelect
 *neuron = *this\getNeuron(destLayer, destNeuron)
 If *neuron = #Null
  ProcedureReturn #False
 EndIf
 If *neuron\synapses = #Null
  ProcedureReturn #False
 EndIf
 *synapse = *neuron\synapses\selectE(srcNeuron)
 If *synapse = #Null
  ProcedureReturn #False
 EndIf
 *synapse\weight = value
 ProcedureReturn #True
EndProcedure


Procedure.f NeuralNetwork_getLearningRate(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 ProcedureReturn *object\learningRate
EndProcedure


Procedure.i NeuralNetwork_setLearningRate(*this.INeuralNetwork, value.f)
 Protected *object.ONeuralNetwork
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 *object\learningRate = value
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_getLayerCount(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 ProcedureReturn *object\layers\size() + 1
EndProcedure


Procedure.i NeuralNetwork_getNeuronCount(*this.INeuralNetwork, layer.i)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 If layer = #INN_InputLayer
  *aLayer = *object\input
 ElseIf layer = #INN_OutputLayer
  *aLayer = *object\layers\lastE()
 Else
  If layer >= *object\layers\size()
   ProcedureReturn 0
  EndIf
  *aLayer = *object\layers\selectE(layer)
 EndIf
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn 0
 EndIf
 ProcedureReturn *aLayer\layer\size()
EndProcedure


Procedure.i NeuralNetwork_update(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList, *neuron.ENeuralNetworkNeuron
 Protected *synapse.ENeuralNetworkSynapse
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 *object\layers\reset()
 While *object\layers\nextE()
  *aLayer = *object\layers\currentE()
  *aLayer\layer\reset()
  While *aLayer\layer\nextE()
   *neuron = *aLayer\layer\currentE()
   If *neuron\synapses
    *neuron\synapses\reset()
    *neuron\input = *neuron\bias
    While *neuron\synapses\nextE()
     *synapse = *neuron\synapses\currentE()
     *neuron\input + (*synapse\srcNeuron\output * *synapse\weight)
    Wend
   EndIf
   *neuron\output = 1 / (1 + Pow(2.718281828459045235, - *neuron\input))
   *neuron\delta = *neuron\output
  Wend
 Wend
 ProcedureReturn #True
EndProcedure


Procedure.f NeuralNetwork_teach(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList, *lastLayer.ENeuralNetworkNeuronList
 Protected layerIndex.i, *neuron.ENeuralNetworkNeuron, error.f
 Protected *synapse.ENeuralNetworkSynapse, *srcNeuron.ENeuralNetworkNeuron
 If *this = #Null
  ProcedureReturn -1
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn -1
 EndIf
 *aLayer = *object\layers\lastE()
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn -1
 EndIf
 error = 0
 *aLayer\layer\reset()
 While *aLayer\layer\nextE()
  *neuron = *aLayer\layer\currentE()
  error + Abs(*neuron\output - *neuron\delta)
  *neuron\delta = *neuron\output - *neuron\delta ;old output was saved in delta
 Wend
 *lastLayer = *aLayer
 While *aLayer And *aLayer\layer
  *aLayer = *object\layers\currentE()
  *aLayer\layer\reset()
  While *aLayer\layer\nextE()
   *neuron = *aLayer\layer\currentE()
   If *aLayer <> *lastLayer
    *neuron\delta = *neuron\output * (1 - *neuron\output) * *neuron\delta
   EndIf
   *neuron\bias + (*object\learningRate * *neuron\delta)
   If *neuron\synapses
    *neuron\synapses\reset()
    layerIndex = *aLayer\layer\index()
    While *neuron\synapses\nextE()
     *synapse = *neuron\synapses\currentE()
     *srcNeuron = *synapse\srcNeuron
     If layerIndex = 0
      *srcNeuron\delta = (*synapse\weight * *neuron\delta)
     Else
      *srcNeuron\delta + (*synapse\weight * *neuron\delta)
     EndIf
     *synapse\weight + (*object\learningRate * *srcNeuron\output * *neuron\delta)
    Wend
   EndIf
  Wend
  *aLayer = *object\layers\priorE()
 Wend
 ProcedureReturn error
EndProcedure


Procedure.i NeuralNetwork_load(*this.INeuralNetwork, FileID.i)
 Protected *object.ONeuralNetwork, result.i, layerCount.i, neurons.i, priorLayer.i
 If *this = #Null Or IsFile(FileID) = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 result = #True
 If *object\networkBuilt = #True
  result & *this\clear()
 EndIf
 layerCount = ReadLong(FileID)
 result & *this\addHiddenLayer(layerCount - 2)
 neurons = ReadLong(FileID)
 result & *this\addNeuron(#INN_InputLayer, neurons)
 For i = 0 To layerCount - 2
  neurons = ReadLong(FileID)
  result & *this\addNeuron(i, neurons)
 Next i
 result & *this\buildSynapses()
 If result = #False
  ProcedureReturn #False
 EndIf
 For i = 0 To layerCount - 2
  priorLayer = i - 1
  If priorLayer < 0 : priorLayer = #INN_InputLayer : EndIf
  For j = 0 To *this\getNeuronCount(i) - 1
   result & *this\setNeuronBias(i, j, ReadFloat(FileID))
   For k = 0 To *this\getNeuronCount(priorLayer) - 1
    result & *this\setNeuronSynapseWeight(priorLayer, k, j, ReadFloat(FileID))
   Next k
  Next j
 Next i
 ProcedureReturn result
EndProcedure


Procedure.i NeuralNetwork_save(*this.INeuralNetwork, FileID.i)
 Protected *object.ONeuralNetwork, layerCount.i, priorLayer.i
 If *this = #Null Or IsFile(FileID) = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 If *object\networkBuilt = #False
  ProcedureReturn #False
 EndIf
 layerCount = *this\getLayerCount()
 WriteLong(FileID, layerCount)
 WriteLong(FileID, *this\getNeuronCount(#INN_InputLayer))
 For i = 0 To layerCount - 2
  WriteLong(FileID, *this\getNeuronCount(i))
 Next i
 For i = 0 To layerCount - 2
  priorLayer = i - 1
  If priorLayer < 0 : priorLayer = #INN_InputLayer : EndIf
  For j = 0 To *this\getNeuronCount(i) - 1
   WriteFloat(FileID, *this\getNeuronBias(i, j))
   For k = 0 To *this\getNeuronCount(priorLayer) - 1
    WriteFloat(FileID, *this\getNeuronSynapseWeight(priorLayer, k, j))
   Next k
  Next j
 Next i
 ProcedureReturn #True
EndProcedure


Procedure.i NeuralNetwork_clear(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList, index.i
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 *this\clearSynapses()
 index = #INN_InputLayer
 While *this\clearLayer(index)
  index + 1
 Wend
 While *object\layers\size() > 1
  *aLayer = *object\layers\firstE()
  If *aLayer\layer
   *aLayer\layer\delete()
  EndIf
  *object\layers\deleteE()
 Wend
 ProcedureReturn #True
EndProcedure


Procedure NeuralNetwork_delete(*this.INeuralNetwork)
 Protected *object.ONeuralNetwork, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn
 EndIf
 *object = *this
 *this\clear()
 *object\input\layer\delete()
 *object\layers\reset()
 If *object\layers\firstE()
  *aLayer = *object\layers\currentE()
  If *aLayer\layer
   *aLayer\layer\delete()
  EndIf
 EndIf
 *object\layers\delete()
 FreeMemory(*object)
EndProcedure


Procedure.i NeuralNetwork_getNeuron(*this.INeuralNetwork, layer.i, neuron.i)
 Protected *object.ONeuralNetwork, *neuron.ENeuralNetworkNeuron, *aLayer.ENeuralNetworkNeuronList
 If *this = #Null
  ProcedureReturn #Null
 EndIf
 *object = *this
 If layer = #INN_InputLayer
  *aLayer = *object\input
 ElseIf layer = #INN_OutputLayer
  *aLayer = *object\layers\lastE()
 Else
  If layer >= *object\layers\size()
   ProcedureReturn #Null
  EndIf
  *aLayer = *object\layers\selectE(layer)
 EndIf
 If *aLayer = #Null Or *aLayer\layer = #Null
  ProcedureReturn #Null
 EndIf
 *neuron = *aLayer\layer\selectE(neuron)
 ProcedureReturn *neuron
EndProcedure




;##################################################################################################
Debug "##########"
Macro dbgBool(value)
 If value = #True
  Debug "#True"
 Else
  Debug "#False"
 EndIf
EndMacro

o.INeuralNetwork = newNeuralNetwork()

dbgBool(o\addHiddenLayer())

Debug "--"
Debug o\getLayerCount()

dbgBool(o\addNeuron(#INN_InputLayer, 2))
dbgBool(o\addNeuron(0, 3))
dbgBool(o\addNeuron(#INN_OutputLayer, 1))

Debug "--"
Debug "neurons per layer"
Debug o\getNeuronCount(#INN_InputLayer)
Debug o\getNeuronCount(0)
Debug o\getNeuronCount(#INN_OutputLayer)

Debug "--"
dbgBool(o\buildSynapses())

Debug "--"
Debug "debug current network outputs"
dbgBool(o\setNeuronInput(#INN_InputLayer, 0, 0))
dbgBool(o\setNeuronInput(#INN_InputLayer, 1, 0))
dbgBool(o\update())
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#INN_InputLayer, 0, 0))
dbgBool(o\setNeuronInput(#INN_InputLayer, 1, 1))
dbgBool(o\update())
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#INN_InputLayer, 0, 1))
dbgBool(o\setNeuronInput(#INN_InputLayer, 1, 0))
dbgBool(o\update())
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#INN_InputLayer, 0, 1))
dbgBool(o\setNeuronInput(#INN_InputLayer, 1, 1))
dbgBool(o\update())
Debug o\getNeuronOutput(#INN_OutputLayer, 0)

Debug "--"
Debug "teaching XOR operator..."

For i = 1 To 1000
 ;init input
 o\setNeuronInput(#INN_InputLayer, 0, 0)
 o\setNeuronInput(#INN_InputLayer, 1, 0)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#INN_OutputLayer, 0, 0)
 ;teach wanted output to the network
 o\teach()
 ;init input
 o\setNeuronInput(#INN_InputLayer, 0, 0)
 o\setNeuronInput(#INN_InputLayer, 1, 1)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#INN_OutputLayer, 0, 1)
 ;teach wanted output to the network
 o\teach()
 ;init input
 o\setNeuronInput(#INN_InputLayer, 0, 1)
 o\setNeuronInput(#INN_InputLayer, 1, 0)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#INN_OutputLayer, 0, 1)
 ;teach wanted output to the network
 o\teach()
 ;init input
 o\setNeuronInput(#INN_InputLayer, 0, 1)
 o\setNeuronInput(#INN_InputLayer, 1, 1)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#INN_OutputLayer, 0, 0)
 ;teach wanted output to the network
 o\teach()
Next

Debug "--"
Debug "debug current network outputs"
o\setNeuronInput(#INN_InputLayer, 0, 0)
o\setNeuronInput(#INN_InputLayer, 1, 0)
o\update()
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
o\setNeuronInput(#INN_InputLayer, 0, 0)
o\setNeuronInput(#INN_InputLayer, 1, 1)
o\update()
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
o\setNeuronInput(#INN_InputLayer, 0, 1)
o\setNeuronInput(#INN_InputLayer, 1, 0)
o\update()
Debug o\getNeuronOutput(#INN_OutputLayer, 0)
o\setNeuronInput(#INN_InputLayer, 0, 1)
o\setNeuronInput(#INN_InputLayer, 1, 1)
o\update()
Debug o\getNeuronOutput(#INN_OutputLayer, 0)

o\delete()

Edit: some bugs fixed and load/save from file command added
Edit: added number parameter for addHiddenLayer and addNeuron
Edit: added error function to teach() to get a better idea how good the network is trained
Edit: added methods to manipulate the learning rate

Posted: **Fri Jun 19, 2009 4:11 pm**

here is another example

Code: Select all

XIncludeFile "CNeuralNetwork.pbi"

OpenConsole()

PrintN("init network")
o.INeuralNetwork = newNeuralNetwork()

o\addHiddenLayer()

For p = 0 To 9
 o\addNeuron(#INN_InputLayer)
Next p

For h = 1 To Round(Log(10) / Log(2), #PB_Round_Up)
 o\addNeuron(0)
Next h

For l = 0 To 9
 o\addNeuron(#INN_OutputLayer)
Next l

o\buildSynapses()

PrintN("train network")
For i = 1 To 2000
 For p = 0 To 9
  For s = 0 To 9
   If s = p
    o\setNeuronInput(#INN_InputLayer, s, 1)
   Else
    o\setNeuronInput(#INN_InputLayer, s, 0)
   EndIf
  Next s
  o\update()
  For s = 0 To 9
   If s = p
    o\setNeuronOutput(#INN_OutputLayer, s, 1)
   Else
    o\setNeuronOutput(#INN_OutputLayer, s, 0)
   EndIf
  Next s
  o\teach()
 Next p
Next i

PrintN("test results")
errors.i = 0
possible.i = 0
For p = 0 To 9
 For s = 0 To 9
  If s = p
   o\setNeuronInput(#INN_InputLayer, s, 1)
  Else
   o\setNeuronInput(#INN_InputLayer, s, 0)
  EndIf
 Next s
 o\update()
 maxValue.f = 0
 maxIndex.i = -1
 buf$ = ""
 For s = 0 To 9
  thisValue.f = o\getNeuronOutput(#INN_OutputLayer, s)
  buf$ + " " + StrF(thisValue, 2)
  If thisValue > maxValue
   maxValue = thisValue
   maxIndex = s
  EndIf
 Next s
 PrintN(buf$)
 If maxIndex <> p
  errors + 1
 EndIf
 possible + 1
Next p

PrintN("failed to detect " + Str(errors) + " sets out of " + Str(possible))
Input()

Posted: **Fri Jun 19, 2009 8:05 pm**

this example shows how to train a neural network
to detect pattern like characters (simple OCR)

Code: Select all

XIncludeFile "CNeuralNetwork.pbi"

#Pixels = 9 * 9
#CharacterArray = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"

;pixel, character
Dim char.f(#Pixels - 1, Len(#CharacterArray) - 1)

OpenConsole()

font = LoadFont(#PB_Any, "Arial", 7)
image = CreateImage(#PB_Any, 10, 10)
If StartDrawing(ImageOutput(image))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(font))
  For c = 0 To Len(#CharacterArray) - 1
   Box(0, 0, 10, 10, $000000)
   DrawText(4 - (TextWidth(Mid(#CharacterArray, c + 1, 1)) / 2), -2, Mid(#CharacterArray, c + 1, 1), $FFFFFF)
   p.i = 0
;    buf$ = ""
   For y = 0 To 8
    For x = 0 To 8
     rgb.i = Point(x, y)
     char(p, c) =  Int((Red(rgb) * 0.299) + (Green(rgb) * 0.587) + (Blue(rgb) * 0.114)) / 255
;      buf$ + " "
;      If char(p, c)
;       buf$ + "#"
;      Else
;       buf$ + " "
;      EndIf
     p + 1
    Next x
;     buf$ + Chr(13) + Chr(10)
   Next y
;    Print(buf$ + "######################")
;    Input()
  Next c
 StopDrawing()
 FreeImage(image)
EndIf

PrintN("init network")
o.INeuralNetwork = newNeuralNetwork(0.2)

o\addHiddenLayer()

o\addNeuron(#INN_InputLayer, #Pixels)
o\addNeuron(0, Round(Log(#Pixels) / Log(2), #PB_Round_Up))
o\addNeuron(#INN_OutputLayer, Len(#CharacterArray))

o\buildSynapses()

PrintN("train network")
i = 0
Repeat
 error.f = 0
 For c = 0 To Len(#CharacterArray) - 1
  For p = 0 To #Pixels - 1
   o\setNeuronInput(#INN_InputLayer, p, char(p, c))
  Next p
  o\update()
  For s = 0 To 25
   If s = c % 26
    o\setNeuronOutput(#INN_OutputLayer, s, 1)
   Else
    o\setNeuronOutput(#INN_OutputLayer, s, 0)
   EndIf
  Next s
  error + o\teach()
 Next c
 If i % 100 = 0
  PrintN("Step " + Str(i) + "  (Error = " + StrF(error, 1) + ")")
 EndIf
 i + 1
Until error < 1

PrintN("test results")
errors.i = 0
possible.i = 0
For c = 0 To Len(#CharacterArray) - 1
 For p = 0 To #Pixels - 1
  o\setNeuronInput(#INN_InputLayer, p, char(p, c))
 Next p
 o\update()
 maxValue.f = 0
 maxIndex.i = -1
 buf$ = ""
 For s = 0 To 25
  thisValue.f = o\getNeuronOutput(#INN_OutputLayer, s)
  If Str(thisValue * 10) = "0"
   buf$ + "   "
  Else
   buf$ + " " + RSet(Str(thisValue * 10), 2, " ")
  EndIf
  If thisValue > maxValue
   maxValue = thisValue
   maxIndex = s
  EndIf
 Next s
 PrintN(buf$)
 If maxIndex <> c % 26
  errors + 1
 EndIf
 possible + 1
Next c

PrintN("failed to detect " + Str(errors) + " sets out of " + Str(possible))
Input()

PS: turn debugger off to run this
PPS: decomment the commented code to see how the input characters look like

Edit: changed teaching part to end by reaching an error limit

Posted: **Fri Jun 19, 2009 9:48 pm**

thanks may be very useful.

Posted: **Fri Jun 19, 2009 10:16 pm**

Wow! I have to take a look!

Posted: **Wed Jul 08, 2009 10:40 am**

here is another version of it for simple networks i.e. only networks with
one hidden layer. but because of that it uses less memory and gives
twice the speed for the XOR example.

CSinglyNeuralNetwork.pbi

Code: Select all

Interface ISinglyNeuralNetwork
;- public
 ;data manipulation
  getNeuronInput.f(layer.i, neuron.i)
  getNeuronOutput.f(layer.i, neuron.i)
  getNeuronBias.f(layer.i, neuron.i)
  setNeuronInput(layer.i, neuron.i, value.f)
  setNeuronOutput(layer.i, neuron.i, value.f)
  setNeuronBias(layer.i, neuron.i, value.f)
  getNeuronSynapseWeight.f(srcLayer.i, srcNeuron.i, destNeuron.i)
  setNeuronSynapseWeight(srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
  getLearningRate.f()
  setLearningRate(value.f)
 ;information
  getNeuronCount(layer.i)
 ;feed-forward
  update()
 ;propagation of error
  teach.f()
 ;file operations
  load(FileID.i)
  save(FileID.i)
 ;network destruction
  clear()
 ;free object
  delete()
EndInterface

Enumeration 0
 #ISNN_InputLayer
 #ISNN_HiddenLayer
 #ISNN_OutputLayer
EndEnumeration

Structure ESinglyNeuralNetworkNeuron
 bias.f
 delta.f
 input.f
 output.f
EndStructure

Structure ESinglyNeuralNetworkSynapse
 weight.f
EndStructure

Structure OSinglyNeuralNetwork
 ;Address to the methods array
 methodAddress.i
 ;Class Attributes
 input.i
 hidden.i
 output.i
 inputNeurons.i
 hiddenNeurons.i
 outputNeurons.i
 learningRate.f
 inputElementSize.i
 hiddenElementSize.i
 outputElementSize.i
EndStructure


Declare.i newSinglyNeuralNetwork(inputNeurons.i, hiddenNeurons.i, outputNeurons.i, learningRate.f = 0.5)
Declare.f SinglyNeuralNetwork_getNeuronInput(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
Declare.f SinglyNeuralNetwork_getNeuronOutput(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
Declare.f SinglyNeuralNetwork_getNeuronBias(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
Declare.i SinglyNeuralNetwork_setNeuronInput(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
Declare.i SinglyNeuralNetwork_setNeuronOutput(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
Declare.i SinglyNeuralNetwork_setNeuronBias(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
Declare.f SinglyNeuralNetwork_getNeuronSynapseWeight(*this.ISinglyNeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i)
Declare.i SinglyNeuralNetwork_setNeuronSynapseWeight(*this.ISinglyNeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
Declare.f SinglyNeuralNetwork_getLearningRate(*this.ISinglyNeuralNetwork)
Declare.i SinglyNeuralNetwork_setLearningRate(*this.ISinglyNeuralNetwork, value.f)
Declare.i SinglyNeuralNetwork_getNeuronCount(*this.ISinglyNeuralNetwork, layer.i)
Declare.i SinglyNeuralNetwork_update(*this.ISinglyNeuralNetwork)
Declare.f SinglyNeuralNetwork_teach(*this.ISinglyNeuralNetwork)
Declare.i SinglyNeuralNetwork_load(*this.ISinglyNeuralNetwork, FileID.i)
Declare.i SinglyNeuralNetwork_save(*this.ISinglyNeuralNetwork, FileID.i)
Declare.i SinglyNeuralNetwork_clear(*this.ISinglyNeuralNetwork)
Declare   SinglyNeuralNetwork_delete(*this.ISinglyNeuralNetwork)


DataSection
 OSinglyNeuralNetwork_methods:
  Data.i @SinglyNeuralNetwork_getNeuronInput()
  Data.i @SinglyNeuralNetwork_getNeuronOutput()
  Data.i @SinglyNeuralNetwork_getNeuronBias()
  Data.i @SinglyNeuralNetwork_setNeuronInput()
  Data.i @SinglyNeuralNetwork_setNeuronOutput()
  Data.i @SinglyNeuralNetwork_setNeuronBias()
  Data.i @SinglyNeuralNetwork_getNeuronSynapseWeight()
  Data.i @SinglyNeuralNetwork_setNeuronSynapseWeight()
  Data.i @SinglyNeuralNetwork_getLearningRate()
  Data.i @SinglyNeuralNetwork_setLearningRate()
  Data.i @SinglyNeuralNetwork_getNeuronCount()
  Data.i @SinglyNeuralNetwork_update()
  Data.i @SinglyNeuralNetwork_teach()
  Data.i @SinglyNeuralNetwork_load()
  Data.i @SinglyNeuralNetwork_save()
  Data.i @SinglyNeuralNetwork_clear()
  Data.i @SinglyNeuralNetwork_delete()
EndDataSection


Procedure.i newSinglyNeuralNetwork(inputNeurons.i, hiddenNeurons.i, outputNeurons.i, learningRate.f = 0.5)
 Protected *this.ISinglyNeuralNetwork, *object.OSinglyNeuralNetwork
 *object = AllocateMemory(SizeOf(OSinglyNeuralNetwork))
 If *object = #Null Or inputNeurons < 1 Or hiddenNeurons < 1 Or outputNeurons < 1
  ProcedureReturn #Null
 EndIf
 *object\methodAddress = ?OSinglyNeuralNetwork_methods
 *object\input = AllocateMemory(SizeOf(FLOAT) * inputNeurons)
 If *object\input = #Null
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *object\hidden = AllocateMemory((SizeOf(ESinglyNeuralNetworkSynapse) * inputNeurons * hiddenNeurons) + (SizeOf(ESinglyNeuralNetworkNeuron) * hiddenNeurons))
 If *object\hidden = #Null
  FreeMemory(*object\input)
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *object\output = AllocateMemory((SizeOf(ESinglyNeuralNetworkSynapse) * hiddenNeurons * outputNeurons) + (SizeOf(ESinglyNeuralNetworkNeuron) * outputNeurons))
 If *object\output = #Null
  FreeMemory(*object\hidden)
  FreeMemory(*object\input)
  FreeMemory(*object)
  ProcedureReturn #Null
 EndIf
 *object\inputNeurons = inputNeurons
 *object\hiddenNeurons = hiddenNeurons
 *object\outputNeurons = outputNeurons
 *object\learningRate = learningRate
 ;- TODO: make use of these 3:
 *object\inputElementSize = SizeOf(FLOAT)
 *object\hiddenElementSize = SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * inputNeurons)
 *object\outputElementSize = SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * hiddenNeurons)
 ;structure input layer:
 ; output value array
 ;structure hidden and output layer:
 ; [neuron, synapse array] array
 *this = *object
 *this\clear()
 ProcedureReturn *object
EndProcedure


Procedure.f SinglyNeuralNetwork_getNeuronInput(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
 Protected *object.OSinglyNeuralNetwork, *input.FLOAT, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn 0
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   If neuron < *object\inputNeurons
    *input = *object\input + (SizeOf(FLOAT) * neuron)
    ProcedureReturn *input\f
   EndIf
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    ProcedureReturn *neuron\input
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    ProcedureReturn *neuron\input
   EndIf
 EndSelect
 ProcedureReturn 0
EndProcedure


Procedure.f SinglyNeuralNetwork_getNeuronOutput(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
 Protected *object.OSinglyNeuralNetwork, *input.FLOAT, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn 0
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   If neuron < *object\inputNeurons
    *input = *object\input + (SizeOf(FLOAT) * neuron)
    ProcedureReturn *input\f
   EndIf
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    ProcedureReturn *neuron\output
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    ProcedureReturn *neuron\output
   EndIf
 EndSelect
 ProcedureReturn 0
EndProcedure


Procedure.f SinglyNeuralNetwork_getNeuronBias(*this.ISinglyNeuralNetwork, layer.i, neuron.i)
 Protected *object.OSinglyNeuralNetwork, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn 0
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   ProcedureReturn 0
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    ProcedureReturn *neuron\bias
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    ProcedureReturn *neuron\bias
   EndIf
 EndSelect
 ProcedureReturn 0
EndProcedure


Procedure.i SinglyNeuralNetwork_setNeuronInput(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.OSinglyNeuralNetwork, *input.FLOAT, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn #False
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   If neuron < *object\inputNeurons
    *input = *object\input + (SizeOf(FLOAT) * neuron)
    *input\f = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    *neuron\input = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    *neuron\input = value
    ProcedureReturn #True
   EndIf
 EndSelect
 ProcedureReturn #False
EndProcedure


Procedure.i SinglyNeuralNetwork_setNeuronOutput(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.OSinglyNeuralNetwork, *input.FLOAT, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn #False
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   If neuron < *object\inputNeurons
    *input = *object\input + (SizeOf(FLOAT) * neuron)
    *input\f = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    *neuron\output = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    *neuron\output = value
    ProcedureReturn #True
   EndIf
 EndSelect
 ProcedureReturn #False
EndProcedure


Procedure.i SinglyNeuralNetwork_setNeuronBias(*this.ISinglyNeuralNetwork, layer.i, neuron.i, value.f)
 Protected *object.OSinglyNeuralNetwork, *neuron.ESinglyNeuralNetworkNeuron
 If *this = #Null Or neuron < 0
  ProcedureReturn #False
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
    ProcedureReturn #False
  Case #ISNN_HiddenLayer
   If neuron < *object\hiddenNeurons
    *neuron = *object\hidden + (*object\hiddenElementSize * neuron)
    *neuron\bias = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_OutputLayer
   If neuron < *object\outputNeurons
    *neuron = *object\output + (*object\outputElementSize * neuron)
    *neuron\bias = value
    ProcedureReturn #True
   EndIf
 EndSelect
 ProcedureReturn #False
EndProcedure


Procedure.f SinglyNeuralNetwork_getNeuronSynapseWeight(*this.ISinglyNeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i)
 Protected *object.OSinglyNeuralNetwork, *synapse.ESinglyNeuralNetworkSynapse
 If *this = #Null Or srcNeuron < 0 Or destNeuron < 0
  ProcedureReturn 0
 EndIf
 *object = *this
 Select srcLayer
  Case #ISNN_InputLayer
   If srcNeuron < *object\inputNeurons And destNeuron < *object\hiddenNeurons
    *synapse = *object\hidden + (*object\hiddenElementSize * destNeuron) + SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * srcNeuron)
    ProcedureReturn *synapse\weight
   EndIf
  Case #ISNN_HiddenLayer
   If srcNeuron < *object\hiddenNeurons And destNeuron < *object\outputNeurons
    *synapse = *object\output + (*object\outputElementSize * destNeuron) + SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * srcNeuron)
    ProcedureReturn *synapse\weight
   EndIf
 EndSelect
 ProcedureReturn 0
EndProcedure


Procedure.i SinglyNeuralNetwork_setNeuronSynapseWeight(*this.ISinglyNeuralNetwork, srcLayer.i, srcNeuron.i, destNeuron.i, value.f)
 Protected *object.OSinglyNeuralNetwork, *synapse.ESinglyNeuralNetworkSynapse
 If *this = #Null Or srcNeuron < 0 Or destNeuron < 0
  ProcedureReturn #False
 EndIf
 *object = *this
 Select srcLayer
  Case #ISNN_InputLayer
   If srcNeuron < *object\inputNeurons And destNeuron < *object\hiddenNeurons
    *synapse = *object\hidden + (*object\hiddenElementSize * destNeuron) + SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * srcNeuron)
    *synapse\weight = value
    ProcedureReturn #True
   EndIf
  Case #ISNN_HiddenLayer
   If srcNeuron < *object\hiddenNeurons And destNeuron < *object\outputNeurons
    *synapse = *object\output + (*object\outputElementSize * destNeuron) + SizeOf(ESinglyNeuralNetworkNeuron) + (SizeOf(ESinglyNeuralNetworkSynapse) * srcNeuron)
    *synapse\weight = value
    ProcedureReturn #True
   EndIf
 EndSelect
 ProcedureReturn #False
EndProcedure


Procedure.f SinglyNeuralNetwork_getLearningRate(*this.ISinglyNeuralNetwork)
 Protected *object.OSinglyNeuralNetwork
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 ProcedureReturn *object\learningRate
EndProcedure


Procedure.i SinglyNeuralNetwork_setLearningRate(*this.ISinglyNeuralNetwork, value.f)
 Protected *object.OSinglyNeuralNetwork
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 *object\learningRate = value
 ProcedureReturn #True
EndProcedure


Procedure.i SinglyNeuralNetwork_getNeuronCount(*this.ISinglyNeuralNetwork, layer.i)
 Protected *object.OSinglyNeuralNetwork
 If *this = #Null
  ProcedureReturn 0
 EndIf
 *object = *this
 Select layer
  Case #ISNN_InputLayer
   ProcedureReturn *object\inputNeurons
  Case #ISNN_HiddenLayer
   ProcedureReturn *object\hiddenNeurons
  Case #ISNN_OutputLayer
   ProcedureReturn *object\outputNeurons
 EndSelect
 ProcedureReturn 0
EndProcedure


Procedure.i SinglyNeuralNetwork_update(*this.ISinglyNeuralNetwork)
 Protected *object.OSinglyNeuralNetwork
 Protected *thisNeuron.ESinglyNeuralNetworkNeuron, *otherNeuron.ESinglyNeuralNetworkNeuron
 Protected *synapse.ESinglyNeuralNetworkSynapse
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 *thisNeuron = *object\hidden
 For i = 1 To *object\hiddenNeurons
  *thisNeuron\input = *thisNeuron\bias
  *synapse = *thisNeuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 0 To *object\inputNeurons - 1
   *thisNeuron\input + (PeekF(*object\input + (j * *object\inputElementSize)) * *synapse\weight)
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *thisNeuron\output = 1 / (1 + Pow(2.718281828459045235, - *thisNeuron\input))
  *thisNeuron\delta = *thisNeuron\output
  *thisNeuron = *synapse
 Next i
 *thisNeuron = *object\output
 For i = 1 To *object\outputNeurons
  *thisNeuron\input = *thisNeuron\bias
  *synapse = *thisNeuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 0 To *object\hiddenNeurons - 1
   *otherNeuron = *object\hidden + (*object\hiddenElementSize * j)
   *thisNeuron\input + (*otherNeuron\output * *synapse\weight)
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *thisNeuron\output = 1 / (1 + Pow(2.718281828459045235, - *thisNeuron\input))
  *thisNeuron\delta = *thisNeuron\output
  *thisNeuron = *synapse
 Next i
 ProcedureReturn #True
EndProcedure


Procedure.f SinglyNeuralNetwork_teach(*this.ISinglyNeuralNetwork)
 Protected *object.OSinglyNeuralNetwork, error.f
 Protected *thisNeuron.ESinglyNeuralNetworkNeuron, *otherNeuron.ESinglyNeuralNetworkNeuron
 Protected *synapse.ESinglyNeuralNetworkSynapse, *input.FLOAT
 If *this = #Null
  ProcedureReturn -1
 EndIf
 *object = *this
 error = 0
 *thisNeuron = *object\output
 For i = 1 To *object\outputNeurons
  error + Abs(*thisNeuron\output - *thisNeuron\delta)
  *thisNeuron\delta = *thisNeuron\output - *thisNeuron\delta ;old output was saved in delta
  *thisNeuron + *object\outputElementSize
 Next i
 *thisNeuron = *object\output
 For i = 1 To *object\outputNeurons  
  *thisNeuron\bias + (*object\learningRate * *thisNeuron\delta)
  *synapse = *thisNeuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 0 To *object\hiddenNeurons - 1
   *otherNeuron = *object\hidden + (*object\hiddenElementSize * j)
   If i = 1
    *otherNeuron\delta = (*synapse\weight * *thisNeuron\delta)
   Else
    *otherNeuron\delta + (*synapse\weight * *thisNeuron\delta)
   EndIf
   *synapse\weight + (*object\learningRate * *otherNeuron\output * *thisNeuron\delta)
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *thisNeuron = *synapse
 Next i
 *thisNeuron = *object\hidden
 For i = 1 To *object\hiddenNeurons
  *thisNeuron\delta = *thisNeuron\output * (1 - *thisNeuron\output) * *thisNeuron\delta
  *thisNeuron\bias + (*object\learningRate * *thisNeuron\delta)
  *synapse = *thisNeuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 0 To *object\inputNeurons - 1
   *input = *object\input + (j * *object\inputElementSize)
   *synapse\weight + (*object\learningRate * *input\f * *thisNeuron\delta)
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *thisNeuron = *synapse
 Next i
 ProcedureReturn error
EndProcedure


Procedure.i SinglyNeuralNetwork_load(*this.ISinglyNeuralNetwork, FileID.i)
 Protected *object.OSinglyNeuralNetwork
 Protected input.i, hidden.i, output.i
 Protected inSize.i, hidSize.i, outSize.i
 Protected inMem.i, hidMem.i, outMem.i
 If *this = #Null Or IsFile(FileID) = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 input = ReadLong(FileID)
 hidden = ReadLong(FileID)
 output = ReadLong(FileID)
 inSize = SizeOf(FLOAT) * input
 hidSize = (SizeOf(ESinglyNeuralNetworkSynapse) * input * hidden) + (SizeOf(ESinglyNeuralNetworkNeuron) * hidden)
 outSize = (SizeOf(ESinglyNeuralNetworkSynapse) * hidden * output) + (SizeOf(ESinglyNeuralNetworkNeuron) * output)
 If input < 1 Or hidden < 1 Or output < 1
  ProcedureReturn #False
 EndIf
 inMem = AllocateMemory(inSize)
 If inMem = #Null
  ProcedureReturn #False
 EndIf
 hidMem = AllocateMemory(hidSize)
 If hidMem = #Null
  FreeMemory(inMem)
  ProcedureReturn #False
 EndIf
 outMem = AllocateMemory(outSize)
 If outMem = #Null
  FreeMemory(hidMem)
  FreeMemory(inMem)
  ProcedureReturn #False
 EndIf
 ReadData(FileID, inMem, inSize)
 ReadData(FileID, hidMem, hidSize)
 ReadData(FileID, outMem, outSize)
 FreeMemory(*object\input)
 FreeMemory(*object\hidden)
 FreeMemory(*object\output)
 *object\input = inMem
 *object\hidden = hidMem
 *object\output = outMem
 *object\inputNeurons = inputNeurons
 *object\hiddenNeurons = hiddenNeurons
 *object\outputNeurons = outputNeurons
 ProcedureReturn #True
EndProcedure


Procedure.i SinglyNeuralNetwork_save(*this.ISinglyNeuralNetwork, FileID.i)
 Protected *object.OSinglyNeuralNetwork
 Protected inSize.i, hidSize.i, outSize.i
 If *this = #Null Or IsFile(FileID) = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 inSize = *object\inputElementSize * *object\inputNeurons
 hidSize = *object\hiddenElementSize * *object\hiddenNeurons
 outSize = *object\outputElementSize * *object\outputNeurons
 WriteLong(FileID, *object\inputNeurons)
 WriteLong(FileID, *object\hiddenNeurons)
 WriteLong(FileID, *object\outputNeurons)
 WriteData(FileID, *object\input, inSize)
 WriteData(FileID, *object\hidden, hidSize)
 WriteData(FileID, *object\output, outSize)
 ProcedureReturn #True
EndProcedure


Procedure.i SinglyNeuralNetwork_clear(*this.ISinglyNeuralNetwork)
 Protected *object.OSinglyNeuralNetwork, *input.FLOAT, *neuron.ESinglyNeuralNetworkNeuron, *synapse.ESinglyNeuralNetworkSynapse
 If *this = #Null
  ProcedureReturn #False
 EndIf
 *object = *this
 *input = *object\input
 For i = 1 To *object\inputNeurons
  *input\f = 0
  *input + SizeOf(FLOAT)
 Next i
 *neuron = *object\hidden
 For i = 1 To *object\hiddenNeurons
  *neuron\bias = Random($FFFFFF) / $FFFFFF
  *neuron\delta = 0
  *neuron\input = 0
  *neuron\output = 0
  *synapse = *neuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 1 To *object\inputNeurons
   *synapse\weight = Random($FFFFFF) / $FFFFFF
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *neuron = *synapse
 Next i
 *neuron = *object\output
 For i = 1 To *object\outputNeurons
  *neuron\bias = Random($FFFFFF) / $FFFFFF
  *neuron\delta = 0
  *neuron\input = 0
  *neuron\output = 0
  *synapse = *neuron + SizeOf(ESinglyNeuralNetworkNeuron)
  For j = 1 To *object\hiddenNeurons
   *synapse\weight = Random($FFFFFF) / $FFFFFF
   *synapse + SizeOf(ESinglyNeuralNetworkSynapse)
  Next j
  *neuron = *synapse
 Next i
 ProcedureReturn #True
EndProcedure


Procedure SinglyNeuralNetwork_delete(*this.ISinglyNeuralNetwork)
 Protected *object.OSinglyNeuralNetwork
 If *this = #Null
  ProcedureReturn
 EndIf
 *object = *this
 FreeMemory(*object\input)
 FreeMemory(*object\hidden)
 FreeMemory(*object\output)
 FreeMemory(*object)
EndProcedure




;##################################################################################################
Debug "##########"
Macro dbgBool(value)
 If value = #True
  Debug "#True"
 Else
  Debug "#False"
 EndIf
EndMacro

o.ISinglyNeuralNetwork = newSinglyNeuralNetwork(2, 3, 1)

Debug "--"
Debug "neurons per layer"
Debug o\getNeuronCount(#ISNN_InputLayer)
Debug o\getNeuronCount(#ISNN_HiddenLayer)
Debug o\getNeuronCount(#ISNN_OutputLayer)

Debug "--"
Debug "debug current network outputs"
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 0, 0))
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 1, 0))
dbgBool(o\update())
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 0, 0))
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 1, 1))
dbgBool(o\update())
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 0, 1))
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 1, 0))
dbgBool(o\update())
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 0, 1))
dbgBool(o\setNeuronInput(#ISNN_InputLayer, 1, 1))
dbgBool(o\update())
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)

Debug "--"
Debug "teaching XOR operator..."

For i = 1 To 1000
 error.f = 0
 ;init input
 o\setNeuronInput(#ISNN_InputLayer, 0, 0)
 o\setNeuronInput(#ISNN_InputLayer, 1, 0)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#ISNN_OutputLayer, 0, 0)
 ;teach wanted output to the network
 error + o\teach()
 ;init input
 o\setNeuronInput(#ISNN_InputLayer, 0, 0)
 o\setNeuronInput(#ISNN_InputLayer, 1, 1)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#ISNN_OutputLayer, 0, 1)
 ;teach wanted output to the network
 error + o\teach()
 ;init input
 o\setNeuronInput(#ISNN_InputLayer, 0, 1)
 o\setNeuronInput(#ISNN_InputLayer, 1, 0)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#ISNN_OutputLayer, 0, 1)
 ;teach wanted output to the network
 error + o\teach()
 ;init input
 o\setNeuronInput(#ISNN_InputLayer, 0, 1)
 o\setNeuronInput(#ISNN_InputLayer, 1, 1)
 ;calculate output
 o\update()
 ;set wanted output
 o\setNeuronOutput(#ISNN_OutputLayer, 0, 0)
 ;teach wanted output to the network
 error + o\teach()
;  Debug error
Next

Debug "--"
Debug "debug current network outputs"
o\setNeuronInput(#ISNN_InputLayer, 0, 0)
o\setNeuronInput(#ISNN_InputLayer, 1, 0)
o\update()
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
o\setNeuronInput(#ISNN_InputLayer, 0, 0)
o\setNeuronInput(#ISNN_InputLayer, 1, 1)
o\update()
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
o\setNeuronInput(#ISNN_InputLayer, 0, 1)
o\setNeuronInput(#ISNN_InputLayer, 1, 0)
o\update()
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)
o\setNeuronInput(#ISNN_InputLayer, 0, 1)
o\setNeuronInput(#ISNN_InputLayer, 1, 1)
o\update()
Debug o\getNeuronOutput(#ISNN_OutputLayer, 0)

o\delete()

PureBasic Forums - English

neural network with backpropagation (OOP)

neural network with backpropagation (OOP)