graphviz Cluster with the same rank as other nodes - graphviz

I am trying to create a graph I explicitly specify the ranks of many of the nodes and specify clusters. The following code produces the type of graph I want:
digraph {
rankdir=LR
subgraph cluster0 {
"MATH 208"
"MATH 211"
graph [rankdir=LR, style="rounded,filled", color=gray]
}
subgraph year1 {
subgraph {
"MATH 100"
"MATH 110"
graph [rankdir=LR, rank=same]
}
subgraph {
"MATH 101"
"MATH 211"
"MATH 208"
graph [rankdir=LR, rank=same]
}
graph [rankdir=LR]
}
subgraph year2 {
subgraph {
"MATH 205"
"PHIL 203"
graph [rankdir=LR, rank=same]
}
graph [rankdir=LR]
}
subgraph year3 {
subgraph {
"MATH 311"
"MATH 312"
"MATH 375"
graph [rankdir=LR, rank=same]
}
graph [rankdir=LR]
}
subgraph year4 {
subgraph {
"MATH 447"
"MATH 412"
graph [rankdir=LR, rank=same]
}
graph [rankdir=LR]
}
"MATH 100" -> "MATH 101"
"MATH 100" -> "MATH 208"
"MATH 101" -> "MATH 205"
"MATH 110" -> "MATH 311"
"MATH 211" -> "MATH 311"
"MATH 110" -> "MATH 312"
"MATH 211" -> "MATH 312"
"PHIL 203" -> "MATH 375"
"MATH 110" -> "MATH 447"
"MATH 211" -> "MATH 447"
"MATH 311" -> "MATH 412"
"MATH 312" -> "MATH 412"
}
This produces a correct graph with "MATH 211" at the same rank as "MATH 101", however graphviz issues the warnings
Warning: MATH 208 was already in a rankset, ignored in cluster pruned
Warning: MATH 211 was already in a rankset, ignored in cluster pruned
If I remove "MATH 211" and "MATH 208" from the year1 subgraph, graphviz no longer complains but the resulting graph no longer has the cluster in the same rank as "MATH 101" (why would it...):
Is there any way to rearrange/reorder my dot file to produce the first graph but without any warnings? Or to specify that a certain cluster should be positioned at the same rank as another node?
I should note that this graph successfully compiles with graphviz 2.26, but fails with graphviz 2.28...

A couple thoughts
I think subgraphs need to have a name that starts with 'cluster' in
order to get any styling. Actually, without the cluster prefix, they might not do anything at all
and this could be the source of many of your problems.
You shouldn't need to repeat rankdir=LR. Specifying it once at the top should be enough.
If none of nodes in a subgraph have dependencies on each other, then
there is a good chance they should already be in the same rank and rank=same shouldn't be
needed.
Here is one version that works for me:
digraph {
rankdir=LR
subgraph cluster0 {
"MATH 208"
"MATH 211"
graph [style="rounded,filled", color=gray]
}
subgraph clusteryear1 {
subgraph cluster100{
"MATH 100"
"MATH 110"
graph [rank=same]
}
subgraph cluster101{
"MATH 101"
"MATH 211"
"MATH 208"
graph [rank=same]
}
}
subgraph clusteryear2 {
subgraph cluster205{
"MATH 205"
"PHIL 203"
graph [rank=same]
}
}
subgraph clusteryear3 {
subgraph cluster311{
"MATH 311"
"MATH 312"
"MATH 375"
graph [rank=same]
}
}
subgraph clusteryear4 {
subgraph cluster447 {
"MATH 447"
"MATH 412"
graph [rank=same]
}
}
"MATH 100" -> "MATH 101"
"MATH 100" -> "MATH 208"
"MATH 101" -> "MATH 205"
"MATH 110" -> "MATH 311"
"MATH 211" -> "MATH 311"
"MATH 110" -> "MATH 312"
"MATH 211" -> "MATH 312"
"PHIL 203" -> "MATH 375"
"MATH 110" -> "MATH 447"
"MATH 211" -> "MATH 447"
"MATH 311" -> "MATH 412"
"MATH 312" -> "MATH 412"
}

Related

Finding intersection of two function using Mathematica

I used the following to graph my two functions:
p1 = Plot[100 t^2*Sin[Sqrt[t]], {t, 0, 7}, AxesOrigin -> {0, 5000}]
p2 = Plot[Piecewise[{{250, 0 <= t < 3}, {2000, 3 < t <= 7}}], {t, 0, 7},
AxesOrigin -> {0, 5000}]
I can not figure out how to find the intersection of the graph, please help.
Using FindRoot with initial guesses observed from the plots.
sol = FindRoot[100 t^2*Sin[Sqrt[t]] == 250, {t, 2}];
t1 = t /. sol
1.61743
sol = FindRoot[100 t^2*Sin[Sqrt[t]] == 2000, {t, 5}];
t2 = t /. sol
5.07622
y = With[{t = 3}, 100 t^2*Sin[Sqrt[t]]];
p1 = Plot[100 t^2*Sin[Sqrt[t]], {t, 0, 7}, AxesOrigin -> {0, 5000}];
p2 = Plot[Piecewise[{{250, 0 <= t < 3}, {2000, 3 < t <= 7}}], {t, 0, 7},
AxesOrigin -> {0, 5000}, Exclusions -> None];
Show[p1, p2, ListPlot[{{t1, 250}, {t2, 2000}, {3, y}},
PlotStyle -> PointSize[0.03]]]

Ordering nodes in Graphviz

I'm trying to get Graphviz to order nodes that share a common node, but not entirely the same path. In my example I have 5 leaf nodes, all connected to the same parent.
Not only are they out of order though, they also do not share the same pathways. Three leafs arrive via one route, the other two via a different one(I'm not sure whether that even matters)
I tried setting 'ordering=in/out' and similar but so far couldn't figure out how to do it. Help would be very much appreciated.
My example tree:
strict digraph "so example" {
rankdir=LR;
"0" -> "3" -> "4" -> "5" -> "C";
"0" -> "3" -> "4" -> "5" -> "A";
"0" -> "6" -> "7" -> "5" -> "E";
"0" -> "6" -> "7" -> "5" -> "D";
"0" -> "6" -> "7" -> "5" -> "B";
}
What I'm looking for is a way to show A, B, C, D and E in order, top to bottom.
Ordering the nodes in the desired order should do the trick:
strict digraph "so example" {
rankdir=LR;
"0" -> "3" -> "4" -> "5" -> "A";
"0" -> "3" -> "4" -> "5" -> "B";
"0" -> "6" -> "7" -> "5" -> "C";
"0" -> "6" -> "7" -> "5" -> "D";
"0" -> "6" -> "7" -> "5" -> "E";
}
Or even shorter:
strict digraph "so example" {
rankdir=LR;
"0" -> "3" -> "4" -> "5" -> {A; B; C; D; E;}
"0" -> "6" -> "7" -> "5";
}

How to change a property attached to the whole graph

Does anyone know how to change graph property "Norm". A command;
G = SetProperty[G, "GraphProperties" -> {"Norm" -> 1}]
doesn't work as I expected. Here is the graph constructor;
G = Graph[{Property[1, "Potential" -> 11],2,3,4},
{Property[2 -> 1, "PreferenceIntensity" -> 5], 3 -> 1, 3 -> 2, 1 -> 4},
EdgeWeight -> {5, 3, 4, 2},
Properties -> {"GraphProperties" -> {"Norm" -> 5}},
VertexLabels -> "Name", ImagePadding -> 10] ;
Thanks.
In[1]:= g = Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 1},
Properties -> {"GraphProperties" -> {"Norm" -> 1}}];
g2 = SetProperty[g, Properties -> {"GraphProperties" -> {"Norm" -> 5}}];
PropertyValue[#, "Norm"] & /# {g, g2}
Out[1]= {1, 5}
This may work:
Graph[G, Properties -> {"GraphProperties" -> {"Norm" -> 1}}]
Generally you should avoid creating symbol names that start with a capital letter, so use g in the future.

Filling Styles using a single Plot in Mathematica

Could I specify different filling colors for within a single plot like the bellow or would I need to "Show" several Plots ? Let`s say I would like the filling style to be the same as the PlotStyle.
priorMean = 50;
priorVar = 100;
llhMean = 30;
llhVar = 40;
postMean=35.71;
postVar=28.57;
Plot[
Evaluate#MapThread[
Function[{\[Mu], \[Sigma]},
PDF[NormalDistribution[\[Mu], Sqrt[\[Sigma]]], x]],
{{priorMean, llhMean, postMean}, {priorVar, llhVar, postVar}}],
{x, 0, 100}, Filling -> Axis, PlotStyle -> {Red, Green, Blue}]
You'll need to use FillingStyle to fill in. I think you got stuck in the syntax for FillingStyle, which is not the same as that for PlotStyle, although you'd expect it to be. You'll have to assign a color for each curve as FillingStyle -> {1 -> color1, 2 -> color2}, etc. Here's an example:
colors = {Red, Green, Blue};
Plot[Evaluate#
MapThread[
Function[{\[Mu], \[Sigma]},
PDF[NormalDistribution[\[Mu], Sqrt[\[Sigma]]], x]], {{priorMean,
llhMean, postMean}, {priorVar, llhVar, postVar}}], {x, 0, 100},
Filling -> Axis, PlotStyle -> colors,
FillingStyle ->
MapIndexed[#2 -> Directive[Opacity[0.3], #] &, colors]]
I propose making an extension to the definition of Plot. I have done this before.
toDirective[{ps__} | ps__] := Flatten[Directive ## Flatten[{#}]] & /# {ps}
makefills = MapIndexed[#2 -> Join ## toDirective#{Opacity[0.3], #} &, #] &;
Unprotect[Plot];
Plot[a__, b : OptionsPattern[]] :=
Block[{$FSmatch = True},
With[{fills = makefills#OptionValue[PlotStyle]},
Plot[a, FillingStyle -> fills, b]
]] /; ! TrueQ[$FSmatch] /; OptionValue[FillingStyle] === "Match"
With this in place, you can use FillingStyle -> "Match" to auto-style the fills to match the main styles.
Plot[{Sin[x], Cos[x], Log[x]}, {x, 0, 2 Pi},
PlotRange -> {-2, 2},
PlotStyle -> {{Blue, Dashing[{0.04, 0.01}]},
{Thick, Dashed, Orange},
{Darker#Green, Thick}},
Filling -> Axis,
FillingStyle -> "Match"
]
You could do something like
With[{colours = {Red, Green, Blue}},
Plot[Evaluate#
MapThread[
Function[{\[Mu], \[Sigma]},
PDF[NormalDistribution[\[Mu], Sqrt[\[Sigma]]], x]],
{{priorMean, llhMean, postMean}, {priorVar, llhVar, postVar}}],
{x, 0, 100},
Filling ->
MapIndexed[#2[[1]] -> {Axis, Directive[Opacity[.3, #1]]} &, colours],
PlotStyle -> colours]]
This gets a result:
Plot[Evaluate#
MapThread[
Function[{\[Mu], \[Sigma]},
PDF[NormalDistribution[\[Mu], Sqrt[\[Sigma]]], x]], {{priorMean,
llhMean, postMean}, {priorVar, llhVar, postVar}}], {x, 0, 100},
Filling -> {1 -> {Axis, Red}, 2 -> {Axis, Green}, 3 -> {Axis, Blue}},
PlotStyle -> {Red, Green, Blue}]
Found in the help under FillingStyle, Scope, Filling Style.
And alternatively:
f = MapThread[
Function[{\[Mu], \[Sigma]},
PDF[NormalDistribution[\[Mu], Sqrt[\[Sigma]]], x]],
{{priorMean, llhMean, postMean}, {priorVar, llhVar, postVar}}];
c = {Red, Green, Blue};
Show[Array[
Plot[f[[#]], {x, 0, 100}, Filling -> {1 -> {Axis, c[[#]]}},
PlotRange -> {Automatic, 0.08}, PlotStyle -> c[[#]]] &, 3]]

Labeling vertices of a polygon in Mathematica

Given a set of points in the plane T={a1,a2,...,an} then Graphics[Polygon[T]] will plot the polygon generated by the points. How can I add labels to the polygon's vertices? Have merely the index as a label would be better then nothing. Any ideas?
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :> Text[Style[{x, y}, Red], {x, y}]}}
]
To add point also
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :> Text[Style[{x, y}, Red], {x, y}, {0, -1}]},
{pts /. {x_, y_} :> {Blue, PointSize[0.02], Point[{x, y}]}}
}
]
update:
Use the index:
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{{LightGray, Polygon[pts]},
{pts /. {x_, y_} :>
Text[Style[Position[pts, {x, y}], Red], {x, y}, {0, -1}]}
}
]
Nasser's version (update) uses pattern matching. This one uses functional programming. MapIndexed gives you both the coordinates and their index without the need for Position to find it.
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
Graphics[
{
{LightGray, Polygon[pts]},
MapIndexed[Text[Style[#2[[1]], Red], #1, {0, -1}] &, pts]
}
]
or, if you don't like MapIndexed, here's a version with Apply (at level 1, infix notation ###).
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
idx = Range[Length[pts]];
Graphics[
{
{LightGray, Polygon[pts]},
Text[Style[#2, Red], #1, {0, -1}] & ### ({pts, idx}\[Transpose])
}
]
This can be expanded to arbitrary labels as follows:
pts = {{1, 0}, {0, Sqrt[3]}, {-1, 0}};
idx = {"One", "Two", "Three"};
Graphics[
{
{LightGray, Polygon[pts]},
Text[Style[#2, Red], #1, {0, -1}] & ### ({pts, idx}\[Transpose])
}
]
You can leverage the options of GraphPlot for this. Example:
c = RandomReal[1, {3, 2}]
g = GraphPlot[c, VertexLabeling -> True, VertexCoordinateRules -> c];
Graphics[{Polygon#c, g[[1]]}]
This way you can also make use of VertexLabeling -> Tooltip, or VertexRenderingFunction if you want to. If you do not want the edges overlaid, you may add EdgeRenderingFunction -> None to the GraphPlot function. Example:
c = RandomReal[1, {3, 2}]
g = GraphPlot[c, VertexLabeling -> All, VertexCoordinateRules -> c,
EdgeRenderingFunction -> None,
VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02],
Black, Text[#2, #1]} &)];
Graphics[{Brown, Polygon#c, g[[1]]}]

Resources