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} 

Mathematica graphics

SetProperty[f[{5, 3, 1, 3, 5}] ,
 {VertexLabels -> Placed["Name", Center], VertexSize -> Large, VertexLabelStyle -> 20}]

Mathematica graphics

SetProperty[f[#]  , {VertexLabels -> Placed["Name", Center],
    GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> #},
    VertexSize -> Large, VertexLabelStyle -> 14}] &@ RandomInteger[{1, 5}, 10]

Mathematica graphics


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

enter image description here

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