2
$\begingroup$

One valid way is given at the end.

I thought CompleteGraph[{2, 3, 3, 1}] would create the representation that I wanted but it creates too many edges (from the first layer to the third layer, etc). Instead of that, this works:

q = {2, 3, 3, 1};
qf = MapThread[
   Range[#1, #2] &, {Prepend[Most[Accumulate[q]], 0] + 1, 
    Accumulate[q]}];
qp = Flatten@
   Map[UndirectedEdge @@@ # &][Tuples /@ Partition[qf, 2, 1]];
Graph[qp]

But it only works for very simple layers. For example,

q = {2, 3, 5, 8, 1};
...

creates a graph that is clustered rather than layered. One could give options to Graph, such as

Graph[qp, 
 GraphLayout -> {"LayeredDigraphEmbedding", "Orientation" -> Left}]

but for some reason, one of the nodes from the two of the first layer is arranged so as to be not in the first layer. So I don't know how to specify the method for specific GraphLayouts.

I could also not guide "MultipartiteEmbedding" into the correct behavior

Graph[qp, 
 GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> q}

because the layout confuses the layers due to the given ordering of qp (places a node from the first layer on the second, and a node from the second on the first).

This works:

q = {2, 3, 5, 8, 1};
qf = MapThread[
   Range[#1 + 1, #2] &, {Prepend[Most[Accumulate[q]], 0], 
    Accumulate[q]}];
qp = Flatten@
   Map[UndirectedEdge @@@ # &][Tuples /@ Partition[qf, 2, 1]];
qc = GraphEmbedding[CompleteGraph[q]];
Graph[qp, VertexCoordinates -> Map[# -> qc[[#]] &, Range[Total[q]]]]

I started playing around with neural nets so I wanted a clean representation of one to have as a map on the side.

Is there a function or option specifically for this? Are there other ways of doing this? Thanks for the tips.

$\endgroup$
2

1 Answer 1

1
$\begingroup$

Use the option GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> q} and use the first argument of Graph to provide the list of vertices

Graph[Range[Total@q], qp, 
 GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> q}]

enter image description here

You can also delete unwanted edges from CompleteGraph[q]:

EdgeDelete[#,  a_ <-> b_ /; Abs[Subtract @@ GraphEmbedding[#][[{a, b}, 1]]] > 1] & @
 CompleteGraph[q]

enter image description here

$\endgroup$

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.