# Sequence of binary trees with different source nodes and with the same Strahler hierarchical order

I would like to create a picture which contains a sequence of binary trees with the same Strahler hierarchical order (for example equal to 2) e with a sequence of different source nodes "i" (from 1 to 7 for example). Thank you all for the help!

-
I apologize for my insolence, it was not my intention to offend or benefit so directly. Being a new user, I didn't see how I can appreciate the answers. Regards – user15850 Jun 18 '14 at 14:31
You are not insolent, and your question are interesting. But it's a good habit to try before asking :) And about accepting answer, please see here :) – Öskå Jun 18 '14 at 14:34

strahler[n_, opts : OptionsPattern[]] :=
Graph[Range[2 n],
Flatten[{1 <-> 2, Table[{2 i <-> 2 i + 1, 2 i <-> 2 i + 2}, {i, n - 1}]}],
VertexCoordinates ->
Riffle[Prepend[Table[{(-1)^(i + 1), -(i - 1)}, {i, n - 1}], {-1, 0}],
Table[{0, -i}, {i, n}]], opts]


-
strhlrF =  Block[{i = -1, init = StarGraph[4,
VertexCoordinates -> {4 -> {0, 0}, 1 -> {0, 1}, 2 -> {-1, 2}, 3 -> {1, 2}}]},
Nest[GraphUnion[#, Graph[UndirectedEdge @@@ (VertexCount[#] + {{0, 2}, {0, 1}})],
VertexCoordinates ->
(Join[{VertexCount[#]+2 -> {0, j = i--}, VertexCount[#]+1 -> {(-1)^(Abs@j), j + 2}},
Thread[VertexList[#] -> AbsoluteOptions[#, VertexCoordinates][[1, 2]]]])] &,
init, # - 2]] &;

Row[Labeled[strhlrF[#], "i=" <> ToString@#, Top] & /@ Range[2, 7], Spacer[5]]


An alternative method that gives the same output:

strhlrF2 =  Block[{i = -1,  init = StarGraph[4,
VertexCoordinates -> {4 -> {0, 0}, 1 -> {0, 1}, 2 -> {-1, 2},  3 -> {1, 2}}]},
Nest[SetProperty[EdgeAdd[#, UndirectedEdge @@@ (VertexCount[#] + {{0, 2}, {0, 1}})],
VertexCoordinates -> (Join[{VertexCount[#] + 2 -> {0, j = i--},
VertexCount[#] + 1 -> {(-1)^(Abs@j), j + 2}},
Thread[VertexList[#] -> AbsoluteOptions[#, VertexCoordinates][[1, 2]]]])] &,
init, # - 2]] &;

-
I was expecting you to answer this question, and once again I'm beaten :) +1 – Öskå Jun 18 '14 at 17:12
Thank you @Öskå -- have a feeling that someone will come up with one-liner soon:) – kglr Jun 18 '14 at 17:21

Here is what I propose:

flat = Partition[Flatten@#, 3] &;
createMat[mat_, side_] := flat@Insert[mat, side, Length@mat - 1]
mat = {{1, 0, 1}, {0, 1, 0}, {0, 1, 0}}; lt = {1, 1, 0}; rt = {0, 1, 1};
n = 10 - 2;
matTree =
FoldList[createMat, mat, flat@Thread[{Array[lt &, Floor[n/2]], Array[rt &, Floor[n/2]]}]];

strahler[mat_] :=
Module[
{pos = Position[mat, 1],
list = Flatten@Position[Position[mat, 1], {_, #}] & /@ {1, 2, 3}, start, left, right, mid},

start = UndirectedEdge @@@ Thread[{(First /@ list)[[1 ;; 2]], (First /@ list)[[2 ;;]]}];
left = UndirectedEdge @@@
list[[2, 2 ;; ;; 2]][[;; Ceiling[Length[list[[2]]]/2 - 1]]]}];
right = UndirectedEdge @@@