Graph-like info-graphics
$begingroup$
The Sunday, January 27, 2019 New York Times has a superb info-graphic describing the path from citizen to Member of the House of Representatives for the current members, including steps such as college, ivy-league college, law school, business, and so on.
Each path (red for Republican, blue for Democrat) starts at the starting node and then passes through an appropriate sequence of circular regions ("milestone disks") associated with each of these milestones.
The simplest approximation would be to create a traditional multi-graph (Graph
), but that would miss several key features of this info-graphic:
- Each path must remain continuous and visible through each circular "milestone disk"
- Each path stays separate from the others and none cross needlessly, particularly within each "milestone disk"
Of course this info-graphic structure can be used for many applications, but as an illustration consider the input data of the following form:
{{"Jay Smith", "Democrat", "College", "Law School", "Military", "Congress"},
{"Mary Jones", "Republican", "Ivy-league college", "Graduate school", "Business", Congress"}}
Presumably the designer can place the centers of the "milestone disks" which would be automatically scaled in size (based on the number of paths through it) and the paths would conform appropriately.
Special credit would be to be able to mouseover or click-highlight a single path and have the representative's name, college and so on appear, and to force all blue paths to pass through the top of a milestone disk and red paths to pass through the bottom of a milestone disk (to enable better comparison between Democrats and Republicans.
graphs-and-networks directed
$endgroup$
add a comment |
$begingroup$
The Sunday, January 27, 2019 New York Times has a superb info-graphic describing the path from citizen to Member of the House of Representatives for the current members, including steps such as college, ivy-league college, law school, business, and so on.
Each path (red for Republican, blue for Democrat) starts at the starting node and then passes through an appropriate sequence of circular regions ("milestone disks") associated with each of these milestones.
The simplest approximation would be to create a traditional multi-graph (Graph
), but that would miss several key features of this info-graphic:
- Each path must remain continuous and visible through each circular "milestone disk"
- Each path stays separate from the others and none cross needlessly, particularly within each "milestone disk"
Of course this info-graphic structure can be used for many applications, but as an illustration consider the input data of the following form:
{{"Jay Smith", "Democrat", "College", "Law School", "Military", "Congress"},
{"Mary Jones", "Republican", "Ivy-league college", "Graduate school", "Business", Congress"}}
Presumably the designer can place the centers of the "milestone disks" which would be automatically scaled in size (based on the number of paths through it) and the paths would conform appropriately.
Special credit would be to be able to mouseover or click-highlight a single path and have the representative's name, college and so on appear, and to force all blue paths to pass through the top of a milestone disk and red paths to pass through the bottom of a milestone disk (to enable better comparison between Democrats and Republicans.
graphs-and-networks directed
$endgroup$
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago
add a comment |
$begingroup$
The Sunday, January 27, 2019 New York Times has a superb info-graphic describing the path from citizen to Member of the House of Representatives for the current members, including steps such as college, ivy-league college, law school, business, and so on.
Each path (red for Republican, blue for Democrat) starts at the starting node and then passes through an appropriate sequence of circular regions ("milestone disks") associated with each of these milestones.
The simplest approximation would be to create a traditional multi-graph (Graph
), but that would miss several key features of this info-graphic:
- Each path must remain continuous and visible through each circular "milestone disk"
- Each path stays separate from the others and none cross needlessly, particularly within each "milestone disk"
Of course this info-graphic structure can be used for many applications, but as an illustration consider the input data of the following form:
{{"Jay Smith", "Democrat", "College", "Law School", "Military", "Congress"},
{"Mary Jones", "Republican", "Ivy-league college", "Graduate school", "Business", Congress"}}
Presumably the designer can place the centers of the "milestone disks" which would be automatically scaled in size (based on the number of paths through it) and the paths would conform appropriately.
Special credit would be to be able to mouseover or click-highlight a single path and have the representative's name, college and so on appear, and to force all blue paths to pass through the top of a milestone disk and red paths to pass through the bottom of a milestone disk (to enable better comparison between Democrats and Republicans.
graphs-and-networks directed
$endgroup$
The Sunday, January 27, 2019 New York Times has a superb info-graphic describing the path from citizen to Member of the House of Representatives for the current members, including steps such as college, ivy-league college, law school, business, and so on.
Each path (red for Republican, blue for Democrat) starts at the starting node and then passes through an appropriate sequence of circular regions ("milestone disks") associated with each of these milestones.
The simplest approximation would be to create a traditional multi-graph (Graph
), but that would miss several key features of this info-graphic:
- Each path must remain continuous and visible through each circular "milestone disk"
- Each path stays separate from the others and none cross needlessly, particularly within each "milestone disk"
Of course this info-graphic structure can be used for many applications, but as an illustration consider the input data of the following form:
{{"Jay Smith", "Democrat", "College", "Law School", "Military", "Congress"},
{"Mary Jones", "Republican", "Ivy-league college", "Graduate school", "Business", Congress"}}
Presumably the designer can place the centers of the "milestone disks" which would be automatically scaled in size (based on the number of paths through it) and the paths would conform appropriately.
Special credit would be to be able to mouseover or click-highlight a single path and have the representative's name, college and so on appear, and to force all blue paths to pass through the top of a milestone disk and red paths to pass through the bottom of a milestone disk (to enable better comparison between Democrats and Republicans.
graphs-and-networks directed
graphs-and-networks directed
edited 3 hours ago
David G. Stork
asked 4 hours ago
David G. StorkDavid G. Stork
24.2k22153
24.2k22153
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago
add a comment |
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago
add a comment |
1 Answer
1
active
oldest
votes
$begingroup$
Final result:
Single Function
Here's this whole boondoggle in a single function:
regroupArrows[arrowGroups_, graphPaths_] :=
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
makeStreamGraph[
nodes : {_, _, _, __} ..,
colorFunction :
Except[_?
OptionQ] : (If[EvenQ[#2[[1]]], Hue[.666, .6, .6],
Hue[0, 1, .8]] &),
diskStyles : Except[_?OptionQ] : {White, EdgeForm[Black]},
ops : OptionsPattern
] :=
Module[
{
mainCategory,
mainCategoryColors,
namedNodes,
baseGraphs,
choiceWeights,
coreGraph,
choicePositions,
coreGraphics,
arrows,
disks,
gComplexPositions,
arrowGroups,
graphPaths,
arrowGroupings
},
mainCategory = DeleteDuplicates@nodes[[All, 2]];
mainCategoryColors =
AssociationThread[mainCategory,
MapIndexed[colorFunction, mainCategory]
];
namedNodes = Association@Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
baseGraphs =
KeySortBy[baseGraphs, #[[2]] &];
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
coreGraph =
Graph[
Flatten@Values[baseGraphs],
GraphLayout -> "LayeredDigraphEmbedding",
VertexSize -> choiceWeights,
VertexStyle -> White
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
coreGraphics = Show@coreGraph;
arrows =
Cases[coreGraphics,
a_Arrow :> (Cases[a, _Integer, [Infinity]][[{1, -1}]] ->
a), [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
gComplexPositions =
KeySelect[! MissingQ[#] &]@
AssociationThread[# -> Range[Length[#]]] &@
Lookup[
AssociationMap[Reverse, choicePositions],
Key /@ coreGraphics[[1, 1]]
];
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings = regroupArrows[arrowGroups, graphPaths];
Graphics[
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{mainCategoryColors[#[[2]]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
Sequence @@ Flatten@{diskStyles},
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
],
ops
]
]
Then you call it like:
makeStreamGraph[nodes, ImageSize -> 1000]
Implementation
Here's a place to start, although I don't have time to do the final annoying bits to get it to actually work.
We'll start with some core data of the form you provided:
BlockRandom[
people = RandomEntity["Person", 1000];
names = DeleteMissing@EntityValue[people, "FullName"];
numPeeps = Length@names;
mainCategory = RandomWord[2];
wordChoices = Partition[RandomWord[15], 5];
nodes =
Join[
List /@ names,
List /@ RandomChoice[mainCategory, numPeeps],
Transpose[RandomChoice[#, numPeeps] & /@ wordChoices],
2
]
];
Then we'll extract each subgraph we want to build off of these:
namedNodes =
Association@
Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
Then we sort this so everything looks nice in the end:
baseGraphs = KeySortBy[baseGraphs, #[[2]] &];
Next we assign weights for each node:
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
And we extract the vertex coordinates of the best looking multigraph I could find:
coreGraph =
Graph[
Flatten@Values[baseGraphs]
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
Now here comes the hard part. We can't disambiguate each multigraph edge, so we really need to build this code ourselves. First we extract all the arrows and group them by their coordinates:
coreGraphics = Show@coreGraph;
postProcessArrow[a_Arrow] :=
Cases[a, _Integer, [Infinity]][[{1, -1}]] -> a;
arrows = Cases[coreGraphics,
a_Arrow :> postProcessArrow[a], [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
Then we try to rebuild our arrow paths:
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings =
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
And finally remake our info graphic:
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{If[#[[2]] === mainCategory[[2]], Hue[0, 1, .8],
Hue[.666, .6, .6]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
White, EdgeForm[Black],
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
] // Graphics[#, ImageSize -> 1000] &
Now I haven't made sure all the paths are clean, but for non-random data we might get that more-or-less for free. Oh yeah and I have tooltips on there.
One nice thing about this approach is we can really get everything directly from coreGraph
so we don't need to rebuild all the Graphics
architecture ourselves.
$endgroup$
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort thearrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort yourbaseGraphs
bymainCategory
we should actually be doing just fine.
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
return StackExchange.using("mathjaxEditing", function () {
StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["$", "$"], ["\\(","\\)"]]);
});
});
}, "mathjax-editing");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "387"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f190361%2fgraph-like-info-graphics%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
1 Answer
1
active
oldest
votes
1 Answer
1
active
oldest
votes
active
oldest
votes
active
oldest
votes
$begingroup$
Final result:
Single Function
Here's this whole boondoggle in a single function:
regroupArrows[arrowGroups_, graphPaths_] :=
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
makeStreamGraph[
nodes : {_, _, _, __} ..,
colorFunction :
Except[_?
OptionQ] : (If[EvenQ[#2[[1]]], Hue[.666, .6, .6],
Hue[0, 1, .8]] &),
diskStyles : Except[_?OptionQ] : {White, EdgeForm[Black]},
ops : OptionsPattern
] :=
Module[
{
mainCategory,
mainCategoryColors,
namedNodes,
baseGraphs,
choiceWeights,
coreGraph,
choicePositions,
coreGraphics,
arrows,
disks,
gComplexPositions,
arrowGroups,
graphPaths,
arrowGroupings
},
mainCategory = DeleteDuplicates@nodes[[All, 2]];
mainCategoryColors =
AssociationThread[mainCategory,
MapIndexed[colorFunction, mainCategory]
];
namedNodes = Association@Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
baseGraphs =
KeySortBy[baseGraphs, #[[2]] &];
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
coreGraph =
Graph[
Flatten@Values[baseGraphs],
GraphLayout -> "LayeredDigraphEmbedding",
VertexSize -> choiceWeights,
VertexStyle -> White
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
coreGraphics = Show@coreGraph;
arrows =
Cases[coreGraphics,
a_Arrow :> (Cases[a, _Integer, [Infinity]][[{1, -1}]] ->
a), [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
gComplexPositions =
KeySelect[! MissingQ[#] &]@
AssociationThread[# -> Range[Length[#]]] &@
Lookup[
AssociationMap[Reverse, choicePositions],
Key /@ coreGraphics[[1, 1]]
];
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings = regroupArrows[arrowGroups, graphPaths];
Graphics[
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{mainCategoryColors[#[[2]]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
Sequence @@ Flatten@{diskStyles},
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
],
ops
]
]
Then you call it like:
makeStreamGraph[nodes, ImageSize -> 1000]
Implementation
Here's a place to start, although I don't have time to do the final annoying bits to get it to actually work.
We'll start with some core data of the form you provided:
BlockRandom[
people = RandomEntity["Person", 1000];
names = DeleteMissing@EntityValue[people, "FullName"];
numPeeps = Length@names;
mainCategory = RandomWord[2];
wordChoices = Partition[RandomWord[15], 5];
nodes =
Join[
List /@ names,
List /@ RandomChoice[mainCategory, numPeeps],
Transpose[RandomChoice[#, numPeeps] & /@ wordChoices],
2
]
];
Then we'll extract each subgraph we want to build off of these:
namedNodes =
Association@
Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
Then we sort this so everything looks nice in the end:
baseGraphs = KeySortBy[baseGraphs, #[[2]] &];
Next we assign weights for each node:
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
And we extract the vertex coordinates of the best looking multigraph I could find:
coreGraph =
Graph[
Flatten@Values[baseGraphs]
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
Now here comes the hard part. We can't disambiguate each multigraph edge, so we really need to build this code ourselves. First we extract all the arrows and group them by their coordinates:
coreGraphics = Show@coreGraph;
postProcessArrow[a_Arrow] :=
Cases[a, _Integer, [Infinity]][[{1, -1}]] -> a;
arrows = Cases[coreGraphics,
a_Arrow :> postProcessArrow[a], [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
Then we try to rebuild our arrow paths:
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings =
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
And finally remake our info graphic:
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{If[#[[2]] === mainCategory[[2]], Hue[0, 1, .8],
Hue[.666, .6, .6]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
White, EdgeForm[Black],
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
] // Graphics[#, ImageSize -> 1000] &
Now I haven't made sure all the paths are clean, but for non-random data we might get that more-or-less for free. Oh yeah and I have tooltips on there.
One nice thing about this approach is we can really get everything directly from coreGraph
so we don't need to rebuild all the Graphics
architecture ourselves.
$endgroup$
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort thearrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort yourbaseGraphs
bymainCategory
we should actually be doing just fine.
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
add a comment |
$begingroup$
Final result:
Single Function
Here's this whole boondoggle in a single function:
regroupArrows[arrowGroups_, graphPaths_] :=
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
makeStreamGraph[
nodes : {_, _, _, __} ..,
colorFunction :
Except[_?
OptionQ] : (If[EvenQ[#2[[1]]], Hue[.666, .6, .6],
Hue[0, 1, .8]] &),
diskStyles : Except[_?OptionQ] : {White, EdgeForm[Black]},
ops : OptionsPattern
] :=
Module[
{
mainCategory,
mainCategoryColors,
namedNodes,
baseGraphs,
choiceWeights,
coreGraph,
choicePositions,
coreGraphics,
arrows,
disks,
gComplexPositions,
arrowGroups,
graphPaths,
arrowGroupings
},
mainCategory = DeleteDuplicates@nodes[[All, 2]];
mainCategoryColors =
AssociationThread[mainCategory,
MapIndexed[colorFunction, mainCategory]
];
namedNodes = Association@Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
baseGraphs =
KeySortBy[baseGraphs, #[[2]] &];
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
coreGraph =
Graph[
Flatten@Values[baseGraphs],
GraphLayout -> "LayeredDigraphEmbedding",
VertexSize -> choiceWeights,
VertexStyle -> White
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
coreGraphics = Show@coreGraph;
arrows =
Cases[coreGraphics,
a_Arrow :> (Cases[a, _Integer, [Infinity]][[{1, -1}]] ->
a), [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
gComplexPositions =
KeySelect[! MissingQ[#] &]@
AssociationThread[# -> Range[Length[#]]] &@
Lookup[
AssociationMap[Reverse, choicePositions],
Key /@ coreGraphics[[1, 1]]
];
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings = regroupArrows[arrowGroups, graphPaths];
Graphics[
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{mainCategoryColors[#[[2]]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
Sequence @@ Flatten@{diskStyles},
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
],
ops
]
]
Then you call it like:
makeStreamGraph[nodes, ImageSize -> 1000]
Implementation
Here's a place to start, although I don't have time to do the final annoying bits to get it to actually work.
We'll start with some core data of the form you provided:
BlockRandom[
people = RandomEntity["Person", 1000];
names = DeleteMissing@EntityValue[people, "FullName"];
numPeeps = Length@names;
mainCategory = RandomWord[2];
wordChoices = Partition[RandomWord[15], 5];
nodes =
Join[
List /@ names,
List /@ RandomChoice[mainCategory, numPeeps],
Transpose[RandomChoice[#, numPeeps] & /@ wordChoices],
2
]
];
Then we'll extract each subgraph we want to build off of these:
namedNodes =
Association@
Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
Then we sort this so everything looks nice in the end:
baseGraphs = KeySortBy[baseGraphs, #[[2]] &];
Next we assign weights for each node:
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
And we extract the vertex coordinates of the best looking multigraph I could find:
coreGraph =
Graph[
Flatten@Values[baseGraphs]
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
Now here comes the hard part. We can't disambiguate each multigraph edge, so we really need to build this code ourselves. First we extract all the arrows and group them by their coordinates:
coreGraphics = Show@coreGraph;
postProcessArrow[a_Arrow] :=
Cases[a, _Integer, [Infinity]][[{1, -1}]] -> a;
arrows = Cases[coreGraphics,
a_Arrow :> postProcessArrow[a], [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
Then we try to rebuild our arrow paths:
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings =
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
And finally remake our info graphic:
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{If[#[[2]] === mainCategory[[2]], Hue[0, 1, .8],
Hue[.666, .6, .6]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
White, EdgeForm[Black],
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
] // Graphics[#, ImageSize -> 1000] &
Now I haven't made sure all the paths are clean, but for non-random data we might get that more-or-less for free. Oh yeah and I have tooltips on there.
One nice thing about this approach is we can really get everything directly from coreGraph
so we don't need to rebuild all the Graphics
architecture ourselves.
$endgroup$
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort thearrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort yourbaseGraphs
bymainCategory
we should actually be doing just fine.
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
add a comment |
$begingroup$
Final result:
Single Function
Here's this whole boondoggle in a single function:
regroupArrows[arrowGroups_, graphPaths_] :=
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
makeStreamGraph[
nodes : {_, _, _, __} ..,
colorFunction :
Except[_?
OptionQ] : (If[EvenQ[#2[[1]]], Hue[.666, .6, .6],
Hue[0, 1, .8]] &),
diskStyles : Except[_?OptionQ] : {White, EdgeForm[Black]},
ops : OptionsPattern
] :=
Module[
{
mainCategory,
mainCategoryColors,
namedNodes,
baseGraphs,
choiceWeights,
coreGraph,
choicePositions,
coreGraphics,
arrows,
disks,
gComplexPositions,
arrowGroups,
graphPaths,
arrowGroupings
},
mainCategory = DeleteDuplicates@nodes[[All, 2]];
mainCategoryColors =
AssociationThread[mainCategory,
MapIndexed[colorFunction, mainCategory]
];
namedNodes = Association@Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
baseGraphs =
KeySortBy[baseGraphs, #[[2]] &];
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
coreGraph =
Graph[
Flatten@Values[baseGraphs],
GraphLayout -> "LayeredDigraphEmbedding",
VertexSize -> choiceWeights,
VertexStyle -> White
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
coreGraphics = Show@coreGraph;
arrows =
Cases[coreGraphics,
a_Arrow :> (Cases[a, _Integer, [Infinity]][[{1, -1}]] ->
a), [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
gComplexPositions =
KeySelect[! MissingQ[#] &]@
AssociationThread[# -> Range[Length[#]]] &@
Lookup[
AssociationMap[Reverse, choicePositions],
Key /@ coreGraphics[[1, 1]]
];
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings = regroupArrows[arrowGroups, graphPaths];
Graphics[
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{mainCategoryColors[#[[2]]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
Sequence @@ Flatten@{diskStyles},
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
],
ops
]
]
Then you call it like:
makeStreamGraph[nodes, ImageSize -> 1000]
Implementation
Here's a place to start, although I don't have time to do the final annoying bits to get it to actually work.
We'll start with some core data of the form you provided:
BlockRandom[
people = RandomEntity["Person", 1000];
names = DeleteMissing@EntityValue[people, "FullName"];
numPeeps = Length@names;
mainCategory = RandomWord[2];
wordChoices = Partition[RandomWord[15], 5];
nodes =
Join[
List /@ names,
List /@ RandomChoice[mainCategory, numPeeps],
Transpose[RandomChoice[#, numPeeps] & /@ wordChoices],
2
]
];
Then we'll extract each subgraph we want to build off of these:
namedNodes =
Association@
Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
Then we sort this so everything looks nice in the end:
baseGraphs = KeySortBy[baseGraphs, #[[2]] &];
Next we assign weights for each node:
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
And we extract the vertex coordinates of the best looking multigraph I could find:
coreGraph =
Graph[
Flatten@Values[baseGraphs]
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
Now here comes the hard part. We can't disambiguate each multigraph edge, so we really need to build this code ourselves. First we extract all the arrows and group them by their coordinates:
coreGraphics = Show@coreGraph;
postProcessArrow[a_Arrow] :=
Cases[a, _Integer, [Infinity]][[{1, -1}]] -> a;
arrows = Cases[coreGraphics,
a_Arrow :> postProcessArrow[a], [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
Then we try to rebuild our arrow paths:
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings =
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
And finally remake our info graphic:
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{If[#[[2]] === mainCategory[[2]], Hue[0, 1, .8],
Hue[.666, .6, .6]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
White, EdgeForm[Black],
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
] // Graphics[#, ImageSize -> 1000] &
Now I haven't made sure all the paths are clean, but for non-random data we might get that more-or-less for free. Oh yeah and I have tooltips on there.
One nice thing about this approach is we can really get everything directly from coreGraph
so we don't need to rebuild all the Graphics
architecture ourselves.
$endgroup$
Final result:
Single Function
Here's this whole boondoggle in a single function:
regroupArrows[arrowGroups_, graphPaths_] :=
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
makeStreamGraph[
nodes : {_, _, _, __} ..,
colorFunction :
Except[_?
OptionQ] : (If[EvenQ[#2[[1]]], Hue[.666, .6, .6],
Hue[0, 1, .8]] &),
diskStyles : Except[_?OptionQ] : {White, EdgeForm[Black]},
ops : OptionsPattern
] :=
Module[
{
mainCategory,
mainCategoryColors,
namedNodes,
baseGraphs,
choiceWeights,
coreGraph,
choicePositions,
coreGraphics,
arrows,
disks,
gComplexPositions,
arrowGroups,
graphPaths,
arrowGroupings
},
mainCategory = DeleteDuplicates@nodes[[All, 2]];
mainCategoryColors =
AssociationThread[mainCategory,
MapIndexed[colorFunction, mainCategory]
];
namedNodes = Association@Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
baseGraphs =
KeySortBy[baseGraphs, #[[2]] &];
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
coreGraph =
Graph[
Flatten@Values[baseGraphs],
GraphLayout -> "LayeredDigraphEmbedding",
VertexSize -> choiceWeights,
VertexStyle -> White
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
coreGraphics = Show@coreGraph;
arrows =
Cases[coreGraphics,
a_Arrow :> (Cases[a, _Integer, [Infinity]][[{1, -1}]] ->
a), [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
gComplexPositions =
KeySelect[! MissingQ[#] &]@
AssociationThread[# -> Range[Length[#]]] &@
Lookup[
AssociationMap[Reverse, choicePositions],
Key /@ coreGraphics[[1, 1]]
];
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings = regroupArrows[arrowGroups, graphPaths];
Graphics[
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{mainCategoryColors[#[[2]]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
Sequence @@ Flatten@{diskStyles},
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
],
ops
]
]
Then you call it like:
makeStreamGraph[nodes, ImageSize -> 1000]
Implementation
Here's a place to start, although I don't have time to do the final annoying bits to get it to actually work.
We'll start with some core data of the form you provided:
BlockRandom[
people = RandomEntity["Person", 1000];
names = DeleteMissing@EntityValue[people, "FullName"];
numPeeps = Length@names;
mainCategory = RandomWord[2];
wordChoices = Partition[RandomWord[15], 5];
nodes =
Join[
List /@ names,
List /@ RandomChoice[mainCategory, numPeeps],
Transpose[RandomChoice[#, numPeeps] & /@ wordChoices],
2
]
];
Then we'll extract each subgraph we want to build off of these:
namedNodes =
Association@
Map[#[[1 ;; 2]] -> #[[3 ;;]] &, nodes];
baseGraphs =
MapThread[UndirectedEdge, {Most[#], Rest[#]}] & /@ namedNodes;
Then we sort this so everything looks nice in the end:
baseGraphs = KeySortBy[baseGraphs, #[[2]] &];
Next we assign weights for each node:
choiceWeights =
Join @@
With[
{
base =
Counts /@
Transpose[nodes[[All, 3 ;;]]]
},
N@base/Max[base]
] // Thread[Keys[#] ->
Rescale[Rescale[Values@#], {0, 1}, {.2, 1}]
] &;
And we extract the vertex coordinates of the best looking multigraph I could find:
coreGraph =
Graph[
Flatten@Values[baseGraphs]
];
choicePositions =
AssociationThread[
VertexList[coreGraph],
GraphEmbedding[coreGraph, "LayeredDigraphEmbedding"]
];
Now here comes the hard part. We can't disambiguate each multigraph edge, so we really need to build this code ourselves. First we extract all the arrows and group them by their coordinates:
coreGraphics = Show@coreGraph;
postProcessArrow[a_Arrow] :=
Cases[a, _Integer, [Infinity]][[{1, -1}]] -> a;
arrows = Cases[coreGraphics,
a_Arrow :> postProcessArrow[a], [Infinity]];
disks = Cases[coreGraphics, _Disk, [Infinity]];
Then we try to rebuild our arrow paths:
arrowGroups =
GroupBy[arrows, #[[1, 1]] & -> (#[[1, 2]] -> #[[2]] &),
GroupBy[First -> Last]];
graphPaths =
Lookup[gComplexPositions, List @@ #] & /@ # & /@ baseGraphs;
arrowGroupings =
Module[
{
shrinkingArrows = arrowGroups,
paths = graphPaths,
arrow,
arrows,
arrowGroup
},
arrows =
Table[
Table[
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]];
If[MissingQ[arrowGroup],
pair = Reverse[pair];
arrowGroup = shrinkingArrows[pair[[1]], pair[[2]]]
];
Which[
MissingQ[arrowGroup],
{arrowGroup, pair},
Length@arrowGroup > 0,
arrow = arrowGroup[[1]];
shrinkingArrows[pair[[1]], pair[[2]] ] = Rest[arrowGroup];
arrow,
True,
{$Failed, pair}
],
{pair, path}
],
{path, Values@paths}
];
AssociationThread[
Keys[paths],
arrows
]
];
And finally remake our info graphic:
GraphicsComplex[
coreGraphics[[1, 1]],
{
Arrowheads[0.],
KeyValueMap[
{If[#[[2]] === mainCategory[[2]], Hue[0, 1, .8],
Hue[.666, .6, .6]], Tooltip[#2, #[[1]]]} &,
arrowGroupings
],
{
White, EdgeForm[Black],
MapThread[Tooltip, { disks, VertexList[coreGraph]}]
}
}
] // Graphics[#, ImageSize -> 1000] &
Now I haven't made sure all the paths are clean, but for non-random data we might get that more-or-less for free. Oh yeah and I have tooltips on there.
One nice thing about this approach is we can really get everything directly from coreGraph
so we don't need to rebuild all the Graphics
architecture ourselves.
edited 58 mins ago
answered 2 hours ago
b3m2a1b3m2a1
27.4k257160
27.4k257160
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort thearrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort yourbaseGraphs
bymainCategory
we should actually be doing just fine.
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
add a comment |
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort thearrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort yourbaseGraphs
bymainCategory
we should actually be doing just fine.
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
Wow... thanks for all the work... great start (+1). But as you recognize, the hard part is what is yet to be done.
$endgroup$
– David G. Stork
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort the
arrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort your baseGraphs
by mainCategory
we should actually be doing just fine.$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork Thinking about it more you could pre-sort the
arrowGroups
so that the higher "radius" stuff is always at the bottom of the list. If you also presort your baseGraphs
by mainCategory
we should actually be doing just fine.$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
$begingroup$
@DavidG.Stork how does it look now? All it took was a bit of sorting :)
$endgroup$
– b3m2a1
1 hour ago
add a comment |
Thanks for contributing an answer to Mathematica Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f190361%2fgraph-like-info-graphics%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
$begingroup$
Fundamentally this is made challenging by what Szabolcs' mentions here: community.wolfram.com/groups/-/m/t/1060237 If multigraph styling were supported properly this'd be easy.
$endgroup$
– b3m2a1
2 hours ago