Message Boards Message Boards

Please share neural network illustrations

Posted 6 years ago

(A version of the same/similar MSE post, which was met with a certain reluctance to be given answers.)

Please share neural networks diagrams you have made in Mathematica / WL. Here is an example:

ClearAll[a];
ns = {3, 4, 6, 4, 1};
nodes = MapIndexed[Function[{n, i}, Prepend[#, i[[1]]] & /@ Array[a, {n}]], ns];
edges = Map[Outer[Rule, #[[1]], #[[2]]] &, Partition[nodes, 2, 1]];
colors = Map[# -> ColorData[11, "ColorList"][[#[[1]]]] &, Flatten[nodes]];
Graph[Flatten[edges], VertexSize -> 0.3, VertexStyle -> colors]

enter image description here

But, here are some more examples.

The question is intentionally given with a short explanation and a link to examples. I wanted to gather some pictures of neural networks made with Mathematica/WL for a few presentations about deep learning. (Using Mathematica/WL's neural networks framework; like this one.) I was somewhat surprised that such images were not easy to find.

What I am interested are images like these:

enter image description here

enter image description here

enter image description here

POSTED BY: Anton Antonov
7 Replies

Thank you for your permission and reply. I will follow the accepted method of citation.

Cheers, Dona

POSTED BY: Dona Leonard

Yes, please do.

I think there is an "accepted" style to cite posts here. For example:

CITE THIS POST: "Please share neural network illustrations" by Anton Antonov. Wolfram Community June 20 2018.

POSTED BY: Anton Antonov

Good day!

Is is appropriate to request permission to use this illustration if appropriately cited? If so, would you please provide appropriate citation?

The illustration came through as a search for 'neural network' this date and it matches a conceptual framework for the work I do. The illustration would be backgrounded and modified to highlight certain nodes as representations of various people elements in my business.

Thank you in advance for your time and consideration.

Cheers!

Attachment

Attachments:
POSTED BY: Dona Leonard

Below is given a function definition that can be used to make a neural network plot with formulae and activation functions graphics. The code/plot can garnished some more, but at this point I find it good enough...

Clear[FormulaNeuralNetworkGraph]
FormulaNeuralNetworkGraph[layerCounts : {_Integer, _Integer, _Integer}] :=      
  Block[{gr1, gr2, gr3, gr4, gr, bc},
   gr1 = IndexGraph[CompleteGraph[Take[layerCounts, 2]]];
   gr2 = Graph[Map[(layerCounts[[1]] + #) \[UndirectedEdge] (layerCounts[[1]] + layerCounts[[2]] + #) &, Range[layerCounts[[2]]]]];
   gr3 = IndexGraph[CompleteGraph[Take[layerCounts, -2]], layerCounts[[1]] + layerCounts[[2]] + 1];
   bc = layerCounts[[1]] + 2*layerCounts[[2]];
   gr4 = Graph[Map[(bc + #) \[UndirectedEdge] (bc + layerCounts[[3]] + #) &, Range[layerCounts[[3]]]], VertexLabels -> "Name"];
   gr = GraphUnion[gr1, gr2, gr3, gr4];
   Graph[gr, 
    GraphLayout -> {"MultipartiteEmbedding", 
      "VertexPartition" -> {layerCounts[[1]], layerCounts[[2]], 
        layerCounts[[2]], layerCounts[[3]], layerCounts[[3]]}}]
   ];

Clear[FormulaNeuralNetworkGraphPlot]
Options[FormulaNeuralNetworkGraphPlot] = Options[Graphics];

FormulaNeuralNetworkGraphPlot[layerCounts : {_Integer, _Integer, _Integer}, func1_, opts : OptionsPattern[]] :=      
  FormulaNeuralNetworkGraphPlot[layerCounts, func1, # &, opts];

FormulaNeuralNetworkGraphPlot[
   layerCounts : {_Integer, _Integer, _Integer}, func1_, func2_, 
   opts : OptionsPattern[]] :=      
  Block[{plOpts, grFunc1, grFunc2, gr, vNames, vCoords, vNameToCoordsRules, edgeLines},
   plOpts = {PlotTheme -> "Default", Axes -> True, Ticks -> False, Frame -> True, FrameTicks -> False, ImageSize -> Small};
   grFunc1 = Plot[func1[x], {x, -2, 2}, Evaluate[plOpts]];
   grFunc2 = Plot[func2[x], {x, -2, 2}, Evaluate[plOpts]];

   gr = FormulaNeuralNetworkGraph[layerCounts];
   vNames = VertexList[gr];
   vCoords = VertexCoordinates /. AbsoluteOptions[gr, VertexCoordinates];
   vNameToCoordsRules = Thread[vNames -> vCoords]; 
   edgeLines = Arrow@ReplaceAll[List @@@ EdgeList[gr], vNameToCoordsRules]; 

   Graphics[{
     Arrowheads[0.02], GrayLevel[0.2], edgeLines,

     EdgeForm[Black], FaceForm[Gray], 
     Map[Disk[#, 0.04] &, vCoords[[1 ;; -layerCounts[[-1]] - 1]]],

     Black,
     Map[{EdgeForm[Gray], FaceForm[White], Disk[#, 0.14], 
        Text[Style["\[Sum]", 16, Bold], #]} &,
      Join[
       vCoords[[layerCounts[[1]] + 1 ;; layerCounts[[1]] + layerCounts[[2]]]],
       vCoords[[-2 layerCounts[[-1]] ;; -layerCounts[[-1]] - 1]]
       ]],

     Map[{EdgeForm[None], FaceForm[White], 
        Rectangle[# - {0.2, 0.15}, # + {0.2, 0.15}], 
        Inset[grFunc1, #1, Center, 0.4]} &, 
      vCoords[[ Total[layerCounts[[1 ;; 2]]] + 1 ;; Total[layerCounts[[1 ;; 2]]] + layerCounts[[2]]] ]],

     Map[{EdgeForm[None], FaceForm[White], 
        Rectangle[# - {0.2, 0.15}, # + {0.2, 0.15}], 
        Inset[grFunc2, #1, Center, 0.4]} &, 
      MapThread[Mean@*List, {vCoords[[-2 layerCounts[[-1]] ;; -layerCounts[[-1]] - 1]], vCoords[[-layerCounts[[-1]] ;; -1]]}]]}, 
    opts]
   ];

Note that the function FormulaNeuralNetworkGraphPlot takes the potions of Graphics.

 FormulaNeuralNetworkGraphPlot[{5, 9, 6}, Tanh, #^3 &,  ImageSize -> 500]

enter image description here

(I tried to reuse as much as I can the code from the answer of Szabolcs. I had to move to using Graphics because I had hard time insetting the activation functions plots using the multi-partite graph options.)

POSTED BY: Anton Antonov

Thank you for your post! I made a function based on your code.

ClearAll[NeuralNetworkGraph]

NeuralNetworkGraph[layerCounts : {_Integer ..}] :=    
  NeuralNetworkGraph[
   AssociationThread[Row[{"layer ", #}] & /@ Range@Length[layerCounts], layerCounts]];

NeuralNetworkGraph[namedLayerCounts_Association] :=      
  Block[{graphUnion, graph, vstyle, 
    layerCounts = Values[namedLayerCounts], 
    layerCountsNames = Keys[namedLayerCounts]},
   graphUnion[g_?GraphQ] := g;
   graphUnion[g__?GraphQ] := GraphUnion[g];
   graph = 
    graphUnion @@ 
     MapThread[
      IndexGraph, {CompleteGraph /@ Partition[layerCounts, 2, 1], 
       FoldList[Plus, 0, layerCounts[[;; -3]]]}];
   vstyle = 
    Catenate[
     Thread /@ 
      Thread[TakeList[VertexList[graph], layerCounts] -> 
        ColorData[97] /@ Range@Length[layerCounts]]];
   graph = 
    Graph[graph, 
     GraphLayout -> {"MultipartiteEmbedding", 
       "VertexPartition" -> layerCounts}, GraphStyle -> "BasicBlack", 
     VertexSize -> 0.5, VertexStyle -> vstyle];
   Legended[graph, 
    Placed[PointLegend[ColorData[97] /@ Range@Length[layerCounts], 
      layerCountsNames, LegendMarkerSize -> 30, LegendLayout -> "Row"], Below]]
  ];

Here is an example:

NeuralNetworkGraph[<|"Input" -> 4, "Hidden 1" -> 5, "Hidden 2" -> 6, 
  "Hidden 3" -> 6, "Hidden 4" -> 4, "Hidden 5" -> 3, "Hidden 6" -> 5, 
  "Hidden 7" -> 8, "Hidden 8" -> 3, "Hidden 9" -> 2, "Output" -> 1|>]

enter image description here

POSTED BY: Anton Antonov

Here's a possible implementation based on the following features:

  • GraphLayout -> "MultipartiteEmbedding". Note that in practice the partitions must be specified using the syntax GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {2,3,4}}. This takes the first two vertices as the first partition, the next 3 as the second, etc.

  • CompleteGraph[{m,n}], which creates a complete bipartite graph. This is the typical connectivity pattern between two successive layers of a NN.

We start with the number of nodes in each layer of the network:

layerCounts = {5, 3, 4, 6};

We are going to construct a complete bipartite graph for each successive pair and merge them appropriately. We will need GraphUnion, which unfortunately does not take a single argument. It wants at least two. Here's a trivial generalization so that we can also plot an NN with only two layers (i.e. made of a single bipartite complete graph):

graphUnion[g_?GraphQ] := g
graphUnion[g__?GraphQ] := GraphUnion[g]

Make the graph:

graph = GraphUnion @@ MapThread[
    IndexGraph,
    {CompleteGraph /@ Partition[layerCounts, 2, 1], 
     FoldList[Plus, 0, layerCounts[[;; -3]]]}
    ];

If you want arrowheads, change CompleteGraph to CompleteGraph[#, DirectedEdges -> True]&. Should the behaviour of this function change in the future, DirectedGraph[CompleteGraph[#], "Acyclic"] would also work.

Compute styles for each layer:

vstyle = Catenate[
  Thread /@ Thread[
    TakeList[VertexList[graph], layerCounts] -> ColorData[97] /@ Range@Length[layerCounts]
    ]
  ]

Mathematica graphics

Style the graph, and apply the multipartite layout:

graph = Graph[graph, 
  GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> layerCounts}, 
  GraphStyle -> "BasicBlack", 
  VertexSize -> 0.5,
  VertexStyle -> vstyle
]

Mathematica graphics

The same method was posted here:

For completeness, we can also add a legend:

Legended[graph,
 Placed[
  PointLegend[
   ColorData[97] /@ Range@Length[layerCounts], 
   Row[{"layer ", #}] & /@ Range@Length[layerCounts],
   LegendMarkerSize -> 30, LegendLayout -> "Row"
   ],
  Below]
 ]

Mathematica graphics

POSTED BY: Szabolcs Horvát

enter image description here

A bit different function that always places vertices symmetrically:

LayersGraph[layers_]:=
Module[{
    uni=Table[Unique[],#]&/@layers,
    coor=Flatten[Table[{k,#}&/@(Range[#]-Mean[Range[#]]&/@layers)[[k]],{k,Length[layers]}],1]},
Graph[
    Flatten[uni],
    Flatten[Outer[Rule,#1,#2]&@@@Partition[uni,2,1]],
VertexCoordinates->coor,
EdgeShapeFunction->"Line",VertexSize->.3]
]

Usage that gives the image above:

LayersGraph[{2, 2, 3, 7, 2, 5, 3, 4, 1}]

A bit different version would go like:

LayersGraph[layers_]:=
Module[{
    vert=TakeList[Range[Total[layers]],layers],
    coor=Flatten[Table[{k,#}&/@(Range[#]-Mean[Range[#]]&/@layers)[[k]],{k,Length[layers]}],1]},
Graph[
    Flatten[vert],
    Flatten[Outer[Rule,#1,#2]&@@@Partition[vert,2,1]],
VertexCoordinates->coor,
EdgeShapeFunction->"Line",GraphStyle->"SmallNetwork"]
]

LayersGraph[{2, 2, 3, 7, 2, 5, 3, 4, 1}]

enter image description here

POSTED BY: Vitaliy Kaurov
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract