Function to draw densely interconnected layers in graph (e.g., neural net)
This one constructs an AdjacencyMatrix
that can be input to AdjacencyGraph
:
f = Module[{index = {1, 1 + First@#}},
AdjacencyGraph @ SparseArray[Band[# &[index, index += #]] ->
ConstantArray[1, #] & /@ Partition[#, 2, 1], {1, 1} Total@#]] &;
where the function # &[index, index += #]
is from this post by Mr.Wizard.
Examples:
f@{4, 3, 3, 2, 1}
SetProperty[f[{5, 3, 1, 3, 5}] ,
{VertexLabels -> Placed["Name", Center], VertexSize -> Large, VertexLabelStyle -> 20}]
SetProperty[f[#] , {VertexLabels -> Placed["Name", Center],
GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> #},
VertexSize -> Large, VertexLabelStyle -> 14}] &@ RandomInteger[{1, 5}, 10]
There might be a built-in that would simplify this, but if not this should get the job done:
fn[lc : {__Integer?Positive}] :=
Join @@ Tuples /@
Rule @@@ Partition[Internal`PartitionRagged[Range@Tr@lc, lc], 2, 1] // Graph
fn[{2, 3, 1}]
A bit shorter of node names may be arbitrary:
fn[lc : {__Integer?Positive}] :=
Join @@ Tuples /@ Rule @@@ Partition[MapIndexed[#2 &, Range@lc, {2}], 2, 1] // Graph