How to construct graphs programmatically

Questions
,
1

Hi, I have to admitt I am just starting to work with the language more that just interactively calling one function after another. But now for graph theory I need to investigate a whole series of graphs which represent natural numbers and divisors.

I need to create graphs D_n = (V_n, A_n) with n in N >1 and arcs (directed edges) in V_n times V_n (v,w) with weight 0 if v divides w and 1 if not. So D_3 would be

d03 = Graph[{2 [DirectedEdge] 2, 2 [DirectedEdge] 2, 
    2 [DirectedEdge] 3, 3 [DirectedEdge] 2, 3 [DirectedEdge] 3, 
    3 [DirectedEdge] 3}, EdgeWeight -> {0, 0, 1, 1, 0, 0}, 
   VertexLabels -> "Name", EdgeLabels -> "EdgeWeight"];

the problem is I need to investigate some medium size n for which I hardly can create the graph typing all vertices and edge weights.

Anyone feeling extremly generous throwing in some directions how to tackle this in Mathematica (sadly I am only fluent in Java and C++)? Help would be much appreciated - I’ll spend some time reading the documentation in the meantime. About time to get some grip on functional programming anyways…

edit: just upgraded to V10 so all the pretty graph theory stuff added lately is available - not that I know how to properly apply it yet :expressionless:

2

Here is a small modification of some code that was used for a different project.

In[1]:= n = 8;
verticies = Range[2, n];
edges = Flatten[Outer[DirectedEdge, verticies, verticies]];
labels = VertexLabels -> Map[# -> ToString[#] &, verticies];
weights = EdgeWeight -> Map[If[Divisible[Last[#], First[#]], 0, 1] &, edges];
g = Graph[verticies, edges, labels, weights, ImagePadding -> 12]

Out[6]= ...GraphSnipped...

That works under V9 and I suspect should work under V10.

If you look at the values of verticies, edges and weights it seems to be doing almost everything you want. The only difference appears to be that it has one edge instead of two from each vertex i to vertex i, it uses no EdgeLabels and uses different VertexLabels. If you study the code you might be able to correct this and adapt the result to do what you need. You can look at FullForm[g] to try to verify the construction is correct. Test all this carefully before you depend on it.

3

I post this for illustrative purposes (if I have understood underlying aim correctly).

f[n_] := {DirectedEdge[##], Boole[Divisible[##]]} & @@@ Tuples[Range[2, n], 2]
g[n_] := With[{ds = Transpose@f[n]},
           Graph[##, 
           VertexLabels -> Thread[Range[2, n] -> (Placed[Framed[#, Background -> White], Center] & /@ 
           Range[2, n])],
           VertexLabelStyle -> Red, 
           EdgeLabels -> "EdgeWeight",
           EdgeStyle -> MapThread[Function[{u, v}, u -> {RGBColor[v, 0, 0], Thickness[0.005 + v 0.005]}], {#1, 
           ds[[2]]}]] & @@ ({#1, EdgeWeight -> #2} & @@ ds)]

Using:

Grid[Partition[g /@ Range[2, 10], 3], Frame -> All]

wcgr.png
wcgr.png573×560 46 KB

4

sorry, just realized that I forgot to thank you (both), this solution was pretty much doing the job and easy to make it do the whole way.