Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Graphs and Networks sorted by activeLines of 4 points and 3 degrees above zero
http://community.wolfram.com/groups/-/m/t/1190377
At [Extreme Orchards for Gardner](http://community.wolfram.com/groups/-/m/t/947771) I mentioned barycentric coordinates. I found an interesting connection between the terms of degree 0 1 2 3 and barycentrics for record-setting lines in 3D space. The power set has the *ab* terms of degree 0 to 3. I calculate points of permutations of this power set. By appending 1 to each, the points can be gathered into lines with RowReduce. And then the graphic, showing how 64 points can be arranged in 66 lines of 4 points.
powerset ={{0, 0, 0, 1}, {0, 0, a, b}, {0, a^2, a b, b^2}, {a^3, a^2 b, a b^2, b^3}};
tetra = {{-1, -1, -1}, {-1, 1, 1}, {1, -1, 1}, {1, 1, -1}};
FromBarycentrics[{m_, n_, o_, p_}, {{x1_, y1_, z1_}, {x2_, y2_, z2_}, {x3_, y3_, z3_}, {x4_, y4_, z4_}}] := {m x1 + n x2 + o x3 + (1 - m - n - o) x4, m y1 + n y2 + o y3 + (1 - m - n - o) y4, m z1 + n z2 + o z3 + (1 - m - n - o) z4};
pts = Sort[FromBarycentrics[#/Total[#], tetra] & /@ Flatten[Permutations[#] & /@ (powerset /. {a -> 5, b -> 9}), 1]];
lines = Select[Union[Flatten[#, 1]] & /@ SplitBy[SortBy[Subsets[Append[#, 1] & /@ pts, {2}], RowReduce], RowReduce], Length[#] == 4 &];
lindex = Flatten[Position[pts, Drop[#, -1]] & /@ #] & /@ lines;
Graphics3D[{Sphere[#, .092] & /@ pts, Tube[pts[[#]], .02] & /@ lindex}, SphericalRegion -> True, Boxed -> False, ImageSize -> 800]
![lines of 4][1]
In above, I use $a=5, b=9$, but any reasonable values work. 0001 0011 0111 1111 1122 1112 1222 0012 0112 0122 1123 1223 1233 0123 2345 can be used instead to produce 241 lines of 5, a sporadic 3D extension of my previous graphic.
![lines of 5][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=linesof4.jpg&userId=21530
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trees25-18-5.gif&userId=21530Ed Pegg2017-09-23T01:21:42ZCalculate mean graph distance in a citation network?
http://community.wolfram.com/groups/-/m/t/1204062
Hi,
I'm a PhD student. For my research, I'm trying to find the shortest path length of a citation network. As I understand, I can use the MeanGraphDistance function for this purpose in mathematica. However, for a citation graph similar to the following, the mean graph distance shows as infinity. Moreover, the number of connected components in this graph show up as 10 though it is a connected graph.
g = Graph[{1 -> 2, 1 -> 3, 1 -> 4, 2 -> 5, 2 -> 6, 2 -> 3, 3 -> 7,
3 -> 8, 4 -> 9, 4 -> 7, 4 -> 8, 4 -> 10}];
ConnectedComponents[g]
MeanGraphDistance[g]
This is the output I get
{{7}, {8}, {3}, {5}, {6}, {2}, {9}, {10}, {4}, {1}}
\[Infinity]
I'm not able to understand why. Any help would be greatly appreciated.Praveena Chandra2017-10-17T01:56:12Z