Implementing a Neural Network

Question

TLDR: I am implementing a neural net in Mathematica and need help with back propagation.

This is purely for the joy of implementing a neural network with a functional programming language. If someone is reading this with the serious intention of using a neural net in Mathematica, it's built in to version 11.

I started by implementing a neuron as a list containing a value and the weights of incoming edges, layers as lists of neurons, and networks as lists of layers.

Neuron[i_] := {0}~Join~((2*RandomReal[] - 1) & /@ Range[i]);
Neuron[v_, w_] := Join[{v}, w];
Layer[n_, i_] := Array[Neuron[i] &, n];
Network[i_, h_, o_] := {Layer[i, 0], Layer[h, i], Layer[o, h]};

I then implemented a function to pass an input into the network.

Compute[network_, inputs_] := Fold[#1~Join~{Compute[#2, Last[#1]]} &, {MapThread[Join[{#1}, #2] &, {inputs, Rest /@ First[network]}]}, Rest[network]] /; Depth[network] == 4;

Compute[layer_, values_] := Compute[#, values] & /@ layer /; Depth[layer] == 3;

Compute[neuron_, value_] := {LogisticSigmoid[Total[MapThread[#1*First[value[[#2]]] &, {Rest[neuron], Range[Length[neuron] - 1]}]]]} ~Join~ Rest[neuron] /; Depth[neuron] == 2;

I'm having difficulties with back propagation. I implemented what I believe is correct based on studying other code I've written on this gist and pasted below, but would greatly appreciate either code examples or general pushes in the right direction.

Propagate[network_, output_, learningRate_] :=
  With[{
     outputLayer = MapThread[
       Propagate[#1, network[[2]], #2, learningRate] &,
       {Last[network], output}],
     hiddenLayer = network[[2]],
     inputLayer = First[network]
     },
    {inputLayer, MapIndexed[Propagate[#1, First[#2],
        inputLayer, outputLayer, output, learningRate] &, 
      hiddenLayer], outputLayer}
    ] /; Depth[network] == 4;

Propagate[neuron_, hiddenLayer_, target_, learningRate_] :=

  Join[{NeuronValue[neuron]},
   MapThread[
    #1 - learningRate*
       -NeuronValue[neuron]*(1 - NeuronValue[neuron])*
       (target - NeuronValue[neuron])*#2 &,
    {NeuronWeights[neuron], LayerValues[hiddenLayer]}]
   ];

Propagate[neuron_, index_, inputLayer_, outputLayer_, target_, 
  learningRate_] :=
 Join[{NeuronValue[neuron]},
  MapIndexed[
   #1 - learningRate*
      NeuronValue[neuron]*(1 - NeuronValue[neuron])*
      NeuronValue[inputLayer[[First[#2]]]]*
      Total[MapThread[(#3 - #1)*-1*#1*(1 - #1)*#2 &, {
         LayerValues[outputLayer],
         LayerWeights[outputLayer, index],
         target}]] &,
   NeuronWeights[neuron]]]

Answer 1

All those API's are way too complicated. Modern Neural Networks are essentially a chain of matmuls or convolutions interleaved with pointwise non-linearity function like sigmoid or ReLU. Such simple architectures rival the super-complicated ones (see this paper)

You can define a loss of a simple feed forward neural network as follows:

vars = (* list of symbolic matrices *)
relu[A_] := 
 MapThread[Max, {Array[0 &, Dimensions@A], A}, Length[Dimensions[A]]]
reluDot[A_, B_] := relu[A.B];
errEq := Y - Fold[reluDot, Reverse[vars]];
lossEq := take1[1/(2 dsize) errEq.errEq\[Transpose]];

You can then use Mathematica's differentiation to minimize lossEq which is your neural network training. There needs to be some extra book-keeping for dealing with symbolic matrices, one approach is to define them using Array[] construct and then use ./ to substitute actual values, a full example is here: https://www.wolframcloud.com/objects/e8cc8432-d38e-4d38-ab79-57d778a97997

Answer 2

After dissecting the code I noted that the functions NeuronValue, NeuronWeights, LayerWeights, and LayerValues are not defined in $Version 11.0.1, so I could not replicate your problem. If you are using the additional Neural Network Package that is not included with Mathematica you could contact the creator of the package Jonas Sjöberg directly using the product's home page. Using the following function definition format could make the code easier to follow.

context`functionName[param_?HeadQ:defaultValue /; param_[comparison]paramThresholdValue ]:= BuiltInFunction[param];(* Comment *)  context`functionName::usage="Description of input and output types.";