I'm ultimately trying to create a directed graph with some of the nodes in fixed positions and the other nodes placed around them in "acceptable" positions.
It's better if I ask the question by showing an example of the code. E.g. I have this graph:
node = {11, 12, 13, 14, 15, 16};
edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15, 13 -> 16,
14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15, 16 -> 14};
vertexposition = {{6.51493919050084`, 44.04756585632944`},
{75.59445680043342`, 50.47455242214042`},
{87.32825501506514`, 13.395648943951699`},
{28.795707353492418`, 3.420138063734413`},
{60.729164933330765`, 16.915777496473908`},
{51.85158892659126`, 25.803692768150313`}};
Show[
Graph[node, edges, VertexCoordinates -> vertexposition, Frame -> True,
VertexSize -> {"Scaled", .02}, VertexLabels -> "Name"]
, FrameTicks -> True, ImageSize -> 600]
I have these fixed critical nodes with positions that are important to me, however I have many other nodes that I want to add to the graph and connect to these nodes without having to specifically add their coordinates.
For example, I want to remove the connection between node $11$ and node $14$ but add three arbitrary nodes that link in series to connect nodes $11$ and $14$ without having to define their position, and have mathematica put an "appropriate" default position for them. That is, I don't want to add the nodes and have them all bunch up at the origin; the graph should look more organic.
Here's the kicker, I want to add edgeweights to all the nodes and don't necessarily want them to space out according to the edgeweights.
Answer
The following code is made after OP's response. It fullfils what I think it should. Except that there is no way to manually delete notes, I wanted to do this neatly but I've run out of time. :)
Previous code can be found in edit history.
There is a Checkbox which will enable Locators (for additional node). It seems it can not be done easier without EventHandler and PassEventsUp/Down.
Description:
- Click -> select a node
- Click again -> unselect
- Click no other node -> create new node between
- New node can be dragged since it is a locator. (after switching checkbox)
new:
- If you create new node, the order matters, so if you click on 11 and then 12, then the connection
11->12will be replaced but 12->11 will not, it will create new loop.
DynamicModule[{acc, new, newEdg, newNodes, newPos, newInd},
Grid[{{
LocatorPane[Dynamic@newPos,
Dynamic[
Graph[
Map[f, node~Join~newNodes],
edges,
VertexCoordinates -> (vertexposition~Join~newPos), VertexLabels -> "Name",
VertexSize -> {Sequence @@ Thread[node -> Table[{"Scaled", .05}, {6}]],
{"Scaled", .02}},
ImageSize -> 600, EdgeShapeFunction -> {Arrow[#, 2] &},
VertexLabelStyle -> {Bold, 20}, AspectRatio -> Automatic,
Frame -> True, FrameTicks -> All, PlotRange -> {{0, 100}, {0, 60}}]
], Appearance -> None]
,
Column[{
Checkbox[Dynamic@loc],
If[loc, "Locators on", "Locators off"]
}]
}}]
,
Initialization :> (
new = {}; acc = {}; newNodes = {}; newPos = {}; loc = False;
f := If[loc, #,
Style[Button[#,
Which[
acc == {#}, acc = {}
,
Length@acc == 1, AppendTo[acc, #];
AppendTo[newPos,
Mean[Pick[(vertexposition~Join~newPos), (node~Join~newNodes), #][[1]] & /@ acc]];
newInd = Last[node~Join~newNodes] + 1;
AppendTo[newNodes, newInd];
edges = DeleteCases[edges, Rule @@ acc];
AppendTo[edges, #] & /@ {First@acc -> newInd, newInd -> Last@acc};
acc = {};
,
True, acc = {#}]
], If[MemberQ[acc, #], Red, Blue]]] &;
node = {11, 12, 13, 14, 15, 16};
edges = {11 -> 14, 11 -> 16, 12 -> 16, 12 -> 15, 13 -> 15,
13 -> 16, 14 -> 16, 14 -> 15, 15 -> 16, 15 -> 13, 16 -> 15,
16 -> 14};
vertexposition = {{6.51, 44.04}, {75.59, 50.47}, {87.32, 13.39}, {28.79, 3.42},
{60.72, 16.91}, {51.85, 25.80}};)]

Comments
Post a Comment