Drawing the schematic diagram of algorithm
Update: functions to generate the edge list, indices and labels:
ClearAll[layersF, edgesF, subscF, indicesF];
layersF = Module[{k = 1}, Table[k++, {i, #}, {j, i}]] &;
edgesF = Flatten[Thread /@ Thread[# -> Partition[#2, 2, 1]] & @@@
Partition[layersF[#], 2, 1], 2] &;
indicesF = Reverse[Thread /@ Thread[{Reverse@Range[0, Range[0, # - 1]], Range[0, # - 1]}]] &;
subscF = Style[Subscript[N, ## & @@ ##], 16, "Panel", Background -> None] & /@ # &;
labelF = Flatten[subscF /@ indicesF[#]] &;
Examples:
edgesF@4
{1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6, 4 -> 7, 4 -> 8, 5 -> 8, 5 -> 9, 6 -> 9, 6 -> 10}
vlabels = labelF@4
$ \left\{N_{0,3},N_{0,2},N_{1,2},N_{0,1},N_{1,1},N_{2,1},N_{0,0},N_{1,0},N_{2,0},N_{3, 0}\right\}$
el = edgesF@4;
vl = Flatten[layersF@4];
lbls = labelF@4;
vlabels = Thread[vl -> (Placed[#, Center] & /@ lbls)];
options = {VertexShapeFunction -> "Square", VertexSize -> {0.25`, 0.25`}, ImagePadding -> 20,
VertexStyle -> Hue[0.125`, 0.7`, 0.9`], ImageSize -> 400, BaseStyle -> Arrowheads[Large]};
By reversing the VertexList and the setting of "VertexPartition" suboption (credit: @MichaelE2) we can change orientation of the graph without the need for Rotation:
Graph[Reverse@vl, el, options, VertexLabels -> vlabels,
GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> Reverse[Range[4]]}]
Update 2: functions to generate vertex coordinates
Although we can easily get Left and Right orientations easily using "MultipartiteEmbedding", a function to generate similar vertex coordinates may be useful to get all four orientations. Such a function would also be useful for TreePlot and GraphPlot that do not provide similar layouts.
The following two functions both take an integer (representing the number of layers) as input:
vcoordsF = {1, .5} # & /@ SparseArray[
CellularAutomaton[{Unitize[#[[1]] + #[[3]]] &, {}, 1},{{1}, 0}, #-1]]["NonzeroPositions"] &;
or
vcoordsF2 = With[{n = #-1}, Reverse@Flatten[Thread /@
({#, Range[2 n + 1][[# ;; -# ;; 2]]} & /@ Range[n + 1]), 1]] &;
Examples:
gF1 = Graph[edgesF@#, ImageSize -> #2, options,
VertexLabels -> Thread[Range@(# (# + 1)/2) -> (Placed[#, Center] & /@ (labelF@#))],
VertexCoordinates -> (-vcoordsF[#])] &;
Row[gF1 @@ # & /@ {{3, 250}, {5, 400}, {6, 500}}]
gF2 = Graph[edgesF@#, ImageSize -> #2, options,
VertexLabels -> Thread[Range@(# (# + 1)/2) -> (Placed[#, Center] & /@ (labelF@#))],
VertexCoordinates -> (Reverse /@ vcoordsF[#])] &;
Row[gF2 @@ # & /@ {{3, 250}, {5, 400}, {6, 500}}]
Using with TreePlot (without subscripted labels)
TreePlot[edgesF@#, ImageSize -> #2, DirectedEdges -> True, VertexLabeling -> True,
VertexCoordinateRules -> (vcoordsF2[#])] & @@ # & /@
{{3, 250}, {5, 400}, {12, 500}} // Row
Previous version
First, a helper function to get the subscript indices:
indicesF = Reverse[Thread /@ Inner[List, Reverse@Range[0, Range[0, #]], Range[0, #], List]] &;
And another to style and rotate indexed labels:
rssF = Rotate[Style[Subscript[N, #[[1]], #[[2]]], 16, "Panel", Background -> None], -Pi] &;
rlabels = Flatten[rss /@ # & /@ indicesF[3]];
vlabels = Table[i -> Placed[rlabels[[i]], Center], {i, Length@labels}];
Use the "MultipartiteEmbedding" suboption of the option GraphLayout to get the vertex coordinates as desired:
edgelist = {1->2, 1->3, 2->4, 2->5, 3->5, 3->6, 4->7, 4->8, 5->8, 5->9, 6->9, 6->10};
Rotate[Graph[edgelist, VertexShapeFunction -> "Square", VertexStyle -> Hue[0.125, 0.7, 0.9],
VertexSize -> {.25, .25}, VertexLabels -> vlabels, ImagePadding -> 20,
GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {1, 2, 3, 4}}], Pi]
Creating the edge list
The index and edges can be worked out like this:
step[list_, n_] := Block[
{
ln1 = list[[1]]
, ln2 = list[[2]]
},
Join[
If[ln2 < n ,
{{ln1, ln2 + 1} -> {ln1, ln2}}, {}],
If[ln2 < n,
{{ln1, ln2 + 1} -> {ln1 + 1, ln2 }}, {}],
If[ln1 + ln2 + 1 < n,
step[{ln1, ln2 + 1}, n], {}],
If[ln1 + ln2 + 1 < n,
step[{ln1 + 1, ln2}, n], {}]
]]
edgelist = DeleteDuplicates@step[{0, 0}, 3]
{{0, 1} -> {0, 0}, {0, 1} -> {1, 0}, {0, 2} -> {0, 1}, {0, 2} -> {1, 1}, {0, 3} -> {0, 2}, {0, 3} -> {1, 2}, {0, 4} -> {0, 3}, {0, 4} -> {1, 3}, {1, 3} -> {1, 2}, {1, 3} -> {2, 2}, {1, 2} -> {1, 1}, {1, 2} -> {2, 1}, {2, 2} -> {2, 1}, {2, 2} -> {3, 1}, {1, 1} -> {1, 0}, {1, 1} -> {2, 0}, {2, 1} -> {2, 0}, {2, 1} -> {3, 0}, {3, 1} -> {3, 0}, {3, 1} -> {4, 0}}
The main difference is that I'm using both indexes as vertex, and generating the graphs programatically by a recursion, allowing any arbitrary length, but unfortunately with duplicates.
Visualizing the graph
Building up from @kguler i.e copying shamelessly
edgelist = DeleteDuplicates@step[{0, 0}, 4];
vl = VertexList@Graph@edgelist;
{{0, 1}, {0, 0}, {1, 0}, {0, 2}, {1, 1}, {0, 3}, {1, 2}, {0, 4}, {1, 3}, {2, 2}, {2, 1}, {3, 1}, {2, 0}, {3, 0}, {4, 0}}
labels = Style[Subscript[N, #[[1]], #[[2]]], 16, "Title", Background -> None] & /@ vl ;
vlabels = #1 -> Placed[#2, Center] & @@@ Transpose[{vl, labels}];
Graph[
edgelist
, VertexLabels -> vlabels
, VertexSize -> .5
, VertexCoordinates -> ({#2, -#1 - #2/2} & @@@ vl )
]
Another difference is that I'm defining the VertexCoordinates explicitly based on the index.
A function to recursively generate the edges:
n[_, 0] := {};
n[x : 0, y_Integer] /; y > 0 :=
{{x, y} -> {x, y - 1}, {x, y} -> {x + 1, y - 1}, n[x + 1, y - 1], n[x, y - 1]};
n[x_Integer, y_Integer] /; y > 0 :=
{{x, y} -> {x, y - 1}, {x, y} -> {x + 1, y - 1}, n[x + 1, y - 1]};
We have to sort the vertices so that the "MultipartiteEmbedding" method can partition the vertices into groups with the right order.
With[{edges = Flatten@n[0, 3]},
Graph[
SortBy[VertexList@Graph@edges, Last],
edges,
VertexSize -> {0.22, 0.22},
VertexLabels -> (idx_ :> Placed[Subscript[N, Sequence @@ idx], Center]),
EdgeShapeFunction -> GraphElementData["FilledArrow", "ArrowSize" -> 0.04],
EdgeStyle -> Directive[Opacity[1], RGBColor[0.4, 0.4, 0.8]],
GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {4, 3, 2, 1}}]
]
Update for V8
The setting "MultipartiteEmbedding" was introduced in V9. It seems to be simply ignored in V8. Also rendering is different. In V8, one can get the above result by explicitly computing the coordinates and using the default edge rendering. The height and width can be adjusted in the ncoords code by multiplying Range[0, y] by a number or adding a number other than 1 in First[#] + 1, respectively.
ncoords[x_Integer, y_Integer] :=
Flatten[Thread /@
NestList[{First[#] + 1, MovingAverage[Last@#, 2]} &, {0, Range[0, y]}, y],
1];
With[{edges = Flatten@n[0, 3], coords = ncoords[0, 3]},
Graph[SortBy[VertexList@Graph@edges, Last], edges,
VertexSize -> {0.22, 0.22},
VertexLabels -> (idx_ :> Placed[Subscript[N, Sequence @@ idx], Center]),
EdgeStyle -> Directive[Opacity[1], RGBColor[0.4, 0.4, 0.8]],
VertexCoordinates -> coords]]