13
$\begingroup$

(Since this post was met with a certain reluctance to be given answers, a version of it is also posted in Community.)

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.

Update

Addressing the concerns in the comments... 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 for a few presentations about deep learning (with Mathematica.) 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

$\endgroup$
  • 4
    $\begingroup$ "Share examples" is not a question. why don't you simply replace the node numbers in your own code? $\endgroup$ – David G. Stork Jun 20 '18 at 22:10
  • 1
    $\begingroup$ @DavidG.Stork " 'Share examples' is not a question. why don't you simply replace the node numbers in your own code?" -- Please take a look at Vitaliy Kaurov's answer. Its submission addresses the first part of your comment; its content the second part. $\endgroup$ – Anton Antonov Jun 21 '18 at 1:49
  • 2
    $\begingroup$ To the "close" voters: 1. How come if this question is "too broad" there are two specific answers already? 2. If this question is "primarily opinion based", how come we recognize an image of a neural network when we see it? Did you look at the images in the provided link? $\endgroup$ – Anton Antonov Jun 21 '18 at 1:53
  • $\begingroup$ I didn't vote to close, but this question is FAR too broad. What if an artist "asked": "please make a drawing"? Your question gives us no hint at WHY you want "examples." Is it to highlight links? To enable massively large networks to be easily understood? Is it to show the nonlinearities in each node? Is it to show the weight values? A question should be able to be accepted but with your vague and broad "question," no matter what "answer" you "accept," there will be an infinity of other "answers," many even "better." This is no way to ask a question. (Now I'm voting to close.) $\endgroup$ – David G. Stork Jun 21 '18 at 4:09
  • $\begingroup$ I do not want to continue arguing with David G. Stork but his previous comment is too prominently "featured" in this question and I find it only mostly right. 1. "[...] this question is FAR too broad[...]" -- It is not that broad; images of neural networks are easily recognized (and apparently some people can relatively easily do them.) I did not want to influence the answers with more specific question formulations. (cont.) $\endgroup$ – Anton Antonov Jun 29 '18 at 13:12
10
$\begingroup$

The key is GraphLayout -> "MultipartiteEmbedding".

layerCounts = {5, 3, 3, 8, 2};

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]
    ]
  ]

Mathematica graphics

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

Mathematica graphics

This won't work for only two layers because GraphUnion is being unreasonable when given a single argument. You can complain to WRI support about that, or implement a workaround.

$\endgroup$
  • 5
    $\begingroup$ Brilliant. "You can complain to WRI support about that, or implement a workaround." I might do both! By the way, at EWTC-2018 last week, during the "Quiz the Experts: Q&A", somebody did ask about graph functionalities development and support with more-or-less similar concerns as those you voiced in Community. $\endgroup$ – Anton Antonov Jun 21 '18 at 16:32
9
$\begingroup$

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

$\endgroup$
  • $\begingroup$ The LayersGraph function you provided is great! Thank you! $\endgroup$ – Anton Antonov Jun 21 '18 at 2:56
9
$\begingroup$

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 be 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.)

$\endgroup$
  • $\begingroup$ Very cool! like the graph in text book $\endgroup$ – partida Aug 14 '18 at 6:15
  • $\begingroup$ @partida Thanks, good to hear! $\endgroup$ – Anton Antonov Aug 14 '18 at 7:35
6
$\begingroup$

Using CompleteGraph with a list of layer sizes as input and deleting edges that connect non-consecutive layers:

ClearAll[layeredNW]
layeredNW[layers : {__}, opts : OptionsPattern[Graph]] := Module[{cg = 
    CompleteGraph[layers, DirectedEdges -> True]}, 
  SetProperty[EdgeDelete[cg, DirectedEdge[a_, b_] /; 
     (Subtract @@ (PropertyValue[{cg, #} , VertexCoordinates][[1]] & /@ {b, a}) > 1)], 
   {PerformanceGoal -> "Quality", VertexSize -> .5, VertexStyle -> White, 
    EdgeStyle -> Black, VertexCoordinates -> GraphEmbedding[cg], opts}]]

Example:

layers = {2, 5, 2, 3, 1, 3, 4, 1};
colors = Flatten[MapThread[ConstantArray,
      {ColorData[63, "ColorList"][[;; Length@layers]], layers}]];

layeredNW[layers, VertexStyle -> {i_ :> colors[[i]]}, ImageSize -> Large, VertexSize -> .3]

enter image description here

Stress-test

layers = {2, 5, 2, 3, 1, 3, 4, 1}*5;
colors = Flatten[
   MapThread[
    ConstantArray, {ColorData[63, "ColorList"][[;; Length@layers]], 
     layers}]];

layeredNW[layers, VertexStyle -> {i_ :> colors[[i]]}, 
 ImageSize -> Large, VertexSize -> .7, ImageSize -> 1600]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for posting your answer! Please consider coming up with other stress-tests than the one I posted. I tried with three-four times larger number of nodes than the image I posted. I think your and Szabolcs approaches handle larger specs of neural networks nodes better than the other posts. $\endgroup$ – Anton Antonov May 25 at 21:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.