2
$\begingroup$

Suppose we have the given network 'g1', which we get based on the set 'q1':

q1 = {{6545, 1044}, {6546, 1044}, {6536, 1044}, {6537, 1043}, {6529, 1044}, {6530, 1043}, {6528, 1044}, {6529, 1044}, {6528, 1044}, {6529, 1043}, {6527, 1044}, {6528, 1044}, {6522,1044}, {6523, 1043}, {6544, 1045}, {6545, 1044}, {6535,1045}, {6536, 1044}, {6526, 1045}, {6527, 1044}, {6521,1045}, {6522, 1044}, {6543, 1046}, {6544, 1045}, {6534,1046}, {6535, 1045}, {6525, 1046}, {6526, 1045}, {6521, 1046}, {6522, 1045}, {6520, 1046}, {6521, 1045}, {6517, 1046}, {6518, 1047}, {6542, 1047}, {6543, 1048}, {6542, 1047}, {6543, 1046}, {6535, 1047}, {6536, 1046}, {6534,1047}, {6535, 1047}, {6533, 1047}, {6534, 1047}, {6533, 1047}, {6534, 1046}, {6532, 1047}, {6533, 1047}, {6531, 1047}, {6532, 1047}, {6525, 1047}, {6526, 1048}, {6524, 1047}, {6525, 1047}, {6524, 1047}, {6525, 1046}, {6520, 1047}, {6521, 1046}, {6519, 1047}, {6520, 1047}, {6519, 1047}, {6520, 1046}, {6518, 1047}, {6519, 1047}, {6518, 1047}, {6518, 1048}, {6549, 1048}, {6550, 1049}, {6543, 1048}, {6544, 1049}, {6532, 1048}, {6533, 1049}, {6532, 1048}, {6533, 1047}, {6530, 1048}, {6531, 1047}, {6526, 1048}, {6527, 1049}, {6523, 1048}, {6524, 1047}, {6518, 1048}, {6518, 1049}, {6550, 1049}, {6551, 1050}, {6548, 1049}, {6549, 1048}, {6547, 1049}, {6548, 1049}, {6545, 1049}, {6546, 1050}, {6544, 1049}, {6545, 1049}, {6543, 1049}, {6544, 1049}, {6542, 1049}, {6543, 1049}, {6539, 1049}, {6540, 1050}, {6538, 1049}, {6539, 1049}, {6537, 1049}, {6538, 1049}, {6536, 1049}, {6537, 1049}, {6533, 1049}, {6534, 1050}, {6529, 1049}, {6530, 1048}, {6529, 1049}, {6529, 1050}, {6527, 1049}, {6528, 1050}, {6522, 1049}, {6523, 1048}, {6518, 1049}, {6519, 1050}, {6518, 1049}, {6518, 1050}, {6551, 1050}, {6551, 1051}, {6546, 1050}, {6547, 1049}, {6543, 1050}, {6544, 1049}, {6541, 1050}, {6542, 1049}, {6540, 1050}, {6541, 1050}, {6535, 1050}, {6536, 1049}, {6534, 1050}, {6535, 1050}, {6529, 1050}, {6529, 1051}, {6528, 1050}, {6529, 1051}, {6521, 1050}, {6522, 1049}, {6519, 1050}, {6520, 1051}, {6551, 1051}, {6551, 1052}, {6542, 1051}, {6543, 1050}, {6529, 1051}, {6529, 1052}, {6520, 1051}, {6521, 1052}, {6520, 1051}, {6521, 1050}, {6517, 1051}, {6518, 1050}, {6551, 1052}, {6552, 1052}, {6541, 1052}, {6542, 1051}, {6529,1052}, {6530, 1053}, {6521, 1052}, {6522, 1053}, {6540, 1053}, {6541, 1052}, {6538, 1053}, {6539, 1054}, {6531,1053}, {6532, 1054}, {6530, 1053}, {6531, 1054}, {6530, 1053}, {6531, 1053}, {6522, 1053}, {6522, 1054}, {6539, 1054}, {6540, 1053}, {6531, 1054}, {6532, 1055}, {6533, 1055}, {6534, 1054}, {6532, 1055}, {6533, 1056}, {6532, 1055}, {6533, 1055}, {6521, 1055}, {6522, 1054}, {6533, 1056}, {6533, 1057}, {6520, 1056}, {6521, 1055}, {6534, 1057}, {6535, 1056}, {6533, 1057}, {6534, 1057}, {6519, 1057}, {6520, 1056}, {6518, 1058}, {6519, 1057}, {6517, 1059}, {6518, 1058}};

linesObjects = Map[Line@# &, Partition[q1, 2]];
g1 = Graphics[linesObjects, ImageSize -> 500]
points = DeleteDuplicates[q1];

Then we build the graph 'graph':

pointIndex = First /@ PositionIndex[points];
vertexCoordinates = AssociationMap[Reverse, pointIndex];
edges = BlockMap[Apply[UndirectedEdge], pointIndex /@ q1, 2];
graph = Graph[edges, VertexCoordinates -> Normal@vertexCoordinates]

enter image description here

Graph 'graph' is the base graph. This is an example graph. Ultimately, graphs with a very large number of nodes will be tested. Question: how to find a hierarchy for this graph as in this example: enter image description here

I would add that I am not interested in hierarchy visualization but only statistics - it means: how many is '1', how many is '2' etc. This is called 'Strahler stream order' hierarchy.

More details can be seen here: enter link description here. I am interested in the hierarchys for the graph 'graph': 'Strahler stream order' (fig. 1), 'Horton stream order' (fig. 2) and 'Horton stream order' (fig. 3). Thanks in advance for your help :)

I think it's worth starting by finding nodes with 1 degree:

highDegree = Keys@Select[degree, EqualTo[1]];
Curry[f_][y_][x_] := f[x, y];
nearest = Nearest[Normal@pointIndex];
within = (Curry[nearest][{All, #}]@*vertexCoordinates) &;
j1 = VertexList[graph];
j2 = Complement[j1, highDegree];
hh = HighlightGraph[graph, highDegree, VertexSize -> 0.7]

enter image description here

Next, nodes with 2 degree:

highDegree = Keys@Select[degree, EqualTo[3]];
Curry[f_][y_][x_] := f[x, y];
nearest = Nearest[Normal@pointIndex];
within = (Curry[nearest][{All, #}]@*vertexCoordinates) &;
j1 = VertexList[graph];
j2 = Complement[j1, highDegree];
hh2 = Show[hh, 
  HighlightGraph[graph, Style[highDegree, Blue], VertexSize -> 0.7]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Sorry for editorial error. Shoud be: points = DeleteDuplicates[q1]; I have made the correction. $\endgroup$ – ralph Jun 10 '20 at 5:14
1
$\begingroup$

IGraph/M has all the tools you need for this:

  • IGStrahlerNumber computes the Strahler number for each vertex
  • IGStrahlerNumber requires a directed out-tree as input, as the directions indicate the identity of the root. If you have an undirected graph, use IGOrientTree[graph, root] to create the out-tree.
  • If you want the Strahler number for each branch of the tree, not for each vertex, you can use IGSmoothen to contract branches consisting of multiple edges into a single edge.
$\endgroup$
0
0
$\begingroup$

@ Szabolcs. To check the method I recreated the graph shown in the colored drawing (with squareds background):

data = {1 <-> 2, 2 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 5 <-> 7, 4 <-> 8,8 <-> 9, 8 <-> 11, 11 <-> 12, 12 <-> 13, 13 <-> 14, 13 <-> 15, 12 <-> 16, 16 <-> 17, 16 <-> 18, 11 <-> 19, 19 <-> 20, 19 <-> 21};
u1 = IGStrahlerNumber@IGOrientTree[Graph[data], 9]
y2 = Split[Sort[u1]];
numb = Table[{y2[[i, 1]], Length[y2[[i]]]}, {i, 1, Length[y2]}]

It seems the 'numb' results are different from the manual counting:(

$\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.