# Please share neural network illustrations

Posted 3 months ago
487 Views
|
4 Replies
|
19 Total Likes
|
 (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] 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:
4 Replies
Sort By:
Posted 3 months ago
 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}] 
Posted 3 months ago
 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] ] ] Style the graph, and apply the multipartite layout: graph = Graph[graph, GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> layerCounts}, GraphStyle -> "BasicBlack", VertexSize -> 0.5, VertexStyle -> vstyle ] 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] ] 
 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|>] 
 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] (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.)